Rabu, 27 April 2011

Mengetahui Ukuran File dan Folder

Jika Anda membutuhkan kode untuk mengetahui ukuran / size dari file maupun folder, berikut ini contoh potongan kodenya :

Mengetahui ukuran file
Dim l As Long
l = FileLen("LOKASI FILE")
MsgBox l

Mengetahui ukuran folder
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox fso.GetFolder("LOKASI FOLDER").Size

Nilai output yang dihasilkan merupakan nilai dengan satuan Byte (B). Perbandingannya :
1024 Byte (B) = 1 KiloByte (KB)
1024 KiloByte (KB) = 1 MegaByte (MB)
1024 MegaByte (MB) = 1 GigaByte (GB)
Jadi misalnya Anda ingin mengetahui ukuran file dalam satuan MegaByte (MB) , contohnya sebagai berikut :
Dim l As Long
l = ((FileLen("LOKASI FILE") / 1024) / 1024)
MsgBox l & " MB"

Label: , , ,

Selasa, 26 April 2011

ListBox Dengan ScrollBar Horisontal

Kontrol Listbox di VB 6.0 tidak menyediakan property untuk memunculkan scrollbar horisontal. Scrollbar horisontal berguna agar Listbox dapat menampilkan secara utuh item / teks yang mempunyai panjang melebihi dari panjang ListBox itu sendiri.

Buat Project dengan sebuah Form dan sebuah Module didalamnya.
Di Module ketikkan :
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Sub AddItemLB(ByVal Lst As ListBox, ByVal Item As String)
Dim l As Long
l = IIf(IsNumeric(Lst.Tag), Lst.Tag, 0)
Lst.AddItem Item
  
If l < Lst.Parent.TextWidth(Item & " ") Then
l = Lst.Parent.TextWidth(Item & " ")
SendMessage Lst.hwnd, &H194, IIf(Lst.Parent.ScaleMode = vbTwips, l / Screen.TwipsPerPixelX, l), 0
Lst.Tag = l
End If
End Sub

Di Form buat sebuah kontrol ListBox sebagai contoh. Lalu ketikkan kode berikut di bagian 'Form _Load' :
AddItemLB List1, "Ini adalah text puanjannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnng"
AddItemLB List1, "Ini adalah text pendek"
AddItemLB List1, "Ini adalah text lebiiiiiiiiiiiiiiiiiiiihhhhhhhhhhhh puanjannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnng"
AddItemLB List1, "Ini adalah text pendek"


CATATAN : Pastikan properti Font dari ListBox sama dengan property Font dari Form.

Label: , ,

Minggu, 24 April 2011

Menambahkan Menu Klik Kanan TaskBar

Berikut ini contoh bagaimana menambahkan item ke menu system dari Form (menu yang muncul ketika Title Form di TaskBar di klik kanan).
Download source code-nya disini.

Label: , , ,

Jumat, 22 April 2011

Mencontreng Menu

Berikut ini contoh-contoh bagaimana cara men-contreng / centang / check sebuah Menu.

1. Mencontreng 1 menu.
[ VB 6.0 ]
Buat rangkaian Menu seperti ini :
CaptionNamePosisi
ContohmnuContohContoh
TesmnuTes**** Tes

Di bagian 'mnuTes_Click' ketikkan :
mnuTes.Checked = Not mnuTes.Checked
  
If mnuTes.Checked = True Then
' jika menu tercontreng
Else
' jika tidak
End If


[ VB .NET ]
Tambahkan kontrol MenuStrip, isikan 1 MenuItem (Name=mnuContoh). Kemudian di MenuItem tersebut, tambahkan 1 MenuDropDown (Name = mnuTes). Lalu Di bagian 'mnuTes_Click' ketikkan :
mnuTes.Checked = Not mnuTes.Checked
  
If mnuTes.Checked = True Then
' jika menu tercontreng
Else
' jika tidak
End If




2. Mencontreng 2 menu sebagai pilihan.
[ VB 6.0 ]
Buat rangkaian Menu seperti ini :
CaptionNamePosisi
ContohmnuContohContoh
Pilihan PertamamnuPilihan1**** Pilihan Pertama
Pilihan KeduamnuPilihan2**** Pilihan Kedua

Di bagian 'Form_Load' ketikkan :
 mnuPilihan1_Click 'default menu yang tercontreng

Di bagian 'mnuPilihan1_Click' ketikkan :
mnuPilihan1.Checked = True
mnuPilihan2.Checked = False
'kode jika pilihan 1 tercontreng

Di bagian 'mnuPilihan2_Click' ketikkan :
mnuPilihan1.Checked = False
mnuPilihan2.Checked = True
'kode jika pilihan 2 tercontreng


[ VB .NET ]
Tambahkan kontrol MenuStrip, isikan 1 MenuItem (Name=mnuContoh). Kemudian di MenuItem tersebut, tambahkan 2 MenuDropDown dengan rincian :
TextName
Pilihan PertamamnuPilihan1
Pilihan KeduamnuPilihan2

Di bagian 'Form1_Load' ketikkan :
mnuPilihan1.PerformClick() 'default menu yang tercontreng

Di bagian 'mnuPilihan1_Click' ketikkan :
mnuPilihan1.Checked = True
mnuPilihan2.Checked = False
'kode jika pilihan 1 tercontreng

Di bagian 'mnuPilihan2_Click' ketikkan :
mnuPilihan1.Checked = False
mnuPilihan2.Checked = True
'kode jika pilihan 2 tercontreng




3. Mencontreng banyak menu sebagai pilihan dengan tekhnik array.
[ VB 6.0 ]
Buat rangkaian Menu seperti ini :
CaptionNameIndexPosisi
ContohmnuContoh Contoh
Pilihan ke 1mnuPilihan0**** Pilihan ke 1
Pilihan ke 2mnuPilihan1**** Pilihan ke 2
Pilihan ke 3mnuPilihan2**** Pilihan ke 3
Pilihan ke 4mnuPilihan3**** Pilihan ke 4
Pilihan ke 5mnuPilihan4**** Pilihan ke 5

Di bagian 'Form_Load' ketikkan :
mnuPilihan_Click (0) 'default menu yang tercontreng

Di bagian 'mnuPilihan_Click' ketikkan :
Dim i As Integer
For i = 0 To mnuPilihan.Count - 1
mnuPilihan(i).Checked = (i = Index)
Next

MsgBox mnuPilihan(Index).Caption 'menampilkan teks pilihan


[ VB .NET ]
Tambahkan kontrol MenuStrip, isikan 1 MenuItem (Name=mnuContoh). Kemudian di MenuItem tersebut, tambahkan beberapa MenuDropDown dengan rincian :
TextName
Pilihan ke 1mnuPil1
Pilihan ke 2mnuPil2
Pilihan ke 3mnuPil3
Pilihan ke 4mnuPil4
Pilihan ke 5mnuPil5

Di bagian 'Form1_Load' ketikkan :
mnuPil1.PerformClick() 'default menu yang tercontreng

Tambahkan prosedur berikut sebagai pengganti handle click-nya.
Private Sub Pilihan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPil1.Click, mnuPil2.Click, mnuPil3.Click, mnuPil4.Click, mnuPil5.Click
For Each c As ToolStripMenuItem In mnuContoh.DropDownItems
c.Checked = (c.GetHashCode = sender.GetHashCode)
Next

MsgBox(CType(sender.Text, String)) 'menampilkan teks pilihan
End Sub

Label: , , ,

Kamis, 21 April 2011

Multi Bahasa

Dukungan multi bahasa digunakan agar teks dari menu atau kontrol yang ditampilkan dapat disesuaikan dengan keinginan user, sehingga lebih terkesan user-friendly.
Download source code-nya disini.

Label: , , ,

Minggu, 17 April 2011

Cut, Copy, Delete, dan Rename

Kegiatan seperti Cut, Copy, Delete, dan Rename adalah kegiatan yang rutin dilakukan bila berhadapan dengan File maupun Folder. Kode-kode berikut ini akan menunjukkan bagaimana kegiatan tersebut dijalankan dalam VB. Kode ini menggunakan fungsi API yang lebih baik bila dibandingkan dengan fungsi bawaan / default.

Buat Module baru dan ketikkan :
[ VB 6.0 ]
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Long

Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
[ VB .NET ]
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Integer

Structure SHFILEOPSTRUCT
Dim hWnd As Integer
Dim wFunc As Integer
Dim pFrom As String
Dim pTo As String
Dim fFlags As Integer
Dim fAborted As Boolean
Dim hNameMaps As Integer
Dim sProgress As String
End Structure


Lalu tambahkan kode berikut ini tepat setelah kode diatas.
Enum ffAction
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum

Enum ffFlags
FOF_ALLOWUNDO = &H40 'menghapus ke recycle bin
FOF_NOCONFIRMATION = &H10 'menghilangkan pesan konfirmasi
FOF_NOCONFIRMMKDIR = &H200 'menghilangkan pesan pembuatan folder jika folder tidak ada
FOF_NOERRORUI = &H400 'menghilangkan pesan kesalahan
FOF_RENAMEONCOLLISION = &H8 'otomatis rename file jika ganda
FOF_SILENT = &H4 'menghilangkan dialog proses
End Enum

Public Sub FFOperation(ByVal Source As String, ByVal Destination As String, ByVal Action As ffAction, ByVal Flags As ffFlags)
Dim SO As SHFILEOPSTRUCT
With SO
.wFunc = Action
.pFrom = Source & Chr(0) & Chr(0)
.pTo = Destination
.fFlags = Flags
End With
SHFileOperation SO
End Sub



Berikut ini contoh penggunaannya :

1. CUT
VB 6.0 FFOperation "C:\Sumber.txt", "C:\Tujuan.txt", FO_MOVE, 0
VB .NET FFOperation("C:\Sumber.txt", "C:\Tujuan.txt", ffAction.FO_MOVE, 0)
Jika Anda ingin menghilangkan dialog proses-nya, ketikkan :
VB 6.0 FFOperation "C:\Sumber.txt", "C:\Tujuan.txt", FO_MOVE, FOF_SILENT
VB .NET FFOperation("C:\Sumber.txt", "C:\Tujuan.txt", ffAction.FO_COPY, ffFlags.FOF_SILENT)

2. COPY
VB 6.0 FFOperation "C:\Sumber.txt", "C:\Tujuan.txt", FO_COPY, 0
VB .NET FFOperation("C:\Sumber.txt", "C:\Tujuan.txt", ffAction.FO_MOVE, 0)
Jika Anda ingin menghilangkan dialog proses-nya, ketikkan :
VB 6.0 FFOperation "C:\Sumber.txt", "C:\Tujuan.txt", FO_COPY, FOF_SILENT
VB .NET FFOperation("C:\Sumber.txt", "C:\Tujuan.txt", ffAction.FO_COPY, ffFlags.FOF_SILENT)

3. DELETE
VB 6.0 FFOperation "C:\Sumber.txt", "", FO_DELETE, 0
VB .NET FFOperation("C:\Sumber.txt", "", ffAction.FO_DELETE, 0)
Jika Anda ingin menghilangkan dialog proses-nya, ketikkan :
VB 6.0 FFOperation "C:\Sumber.txt", "", FO_DELETE, FOF_SILENT
VB .NET FFOperation("C:\Sumber.txt", "", ffAction.FO_DELETE, ffFlags.FOF_SILENT)
Jika Anda ingin menghapus ke RecycleBin, ketikkan :
VB 6.0 FFOperation "C:\Sumber.txt", "", FO_DELETE, FOF_SILENT + FOF_ALLOWUNDO
VB .NET FFOperation("C:\Sumber.txt", "", ffAction.FO_DELETE, ffFlags.FOF_SILENT + ffFlags.FOF_ALLOWUNDO)

4. RENAME
VB 6.0 FFOperation "C:\NamaLama.txt", "C:\NamaBaru.txt", FO_RENAME, 0
VB .NET FFOperation("C:\NamaLama.txt", "C:\NamaBaru.txt", ffAction.FO_RENAME, 0)

Label: , , ,

Rabu, 13 April 2011

Form Mengikuti Mouse

Yang dimaksud Form mengikuti mouse, adalah Form yang posisinya mengikuti posisi kursor mouse. Berikut ini cara membuatnya.

[ VB 6.0 ]
Buat Form baru (BorderStyle=None) dengan sebuah Timer (Enabled=True; Interval=10).
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Di bagian 'Form_Load' ketikkan :
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2 'selalu di depan
Di bagian 'Timer1_Timer' ketikkan :
Dim p As POINTAPI
GetCursorPos p
Me.Left = (p.X * Screen.TwipsPerPixelX) + 100
Me.Top = (p.Y * Screen.TwipsPerPixelY) + 100



[ VB .NET ]
Buat Form baru (FormBorderStyle=None; TopMost=True) dengan sebuah Timer (Enabled=True; Interval=10).
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Integer
Private Structure POINTAPI
Dim X As Integer
Dim Y As Integer
End Structure
Di bagian 'Timer1_Tick' ketikkan :
Dim p As POINTAPI
GetCursorPos(p)
Me.Left = p.X + 5
Me.Top = p.Y + 5

Label: , , , ,

Mendapatkan dan Mengubah Posisi Mouse

Kode-kode berikut ini akan menunjukkan bagaimana cara mendapatkan dan mengubah posisi kursor mouse.

[ VB 6.0 ]
Buat Form baru dengan 2 buah TextBox, 2 buah CommandButton, dan 1 buah Timer (Enabled=True; Interval=10) didalamnya.
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type

Berikut ini cara untuk mendapatkan posisi mouse, dimana nilai posisinya akan ditampilkan ke TextBox. Ketikkan kode berikut di bagian 'Timer1_Timer'.
Dim p As POINTAPI
GetCursorPos p
Text1.Text = p.x
Text2.Text = p.y
Jalankan aplikasi.

Untuk megubah posisi mouse gunakan kode :
SetCursorPos x, y
Gantikan x sesuai dengan ukuran panjang layar. Misal panjangnya 1024, Anda bisa gantikan dengan nilai 0 s/d 1023. dan Gantikan y sesuai dengan ukuran lebar layar. Misal lebarnya 768, Anda bisa gantikan dengan nilai 0 s/d 767.

Sedangkan bila Anda ingin mengubah posisi mouse ke kontrol tertentu, ikuti langkah berikut. Sebagai contoh posisi mouse akan diubah ke tengah kontrol Command1, ketikkan kode berikut di bagian 'Command2_Click' :
Dim p As POINTAPI
ClientToScreen Command1.hwnd, p
SetCursorPos p.x + ((Command1.Width \ 2) \ Screen.TwipsPerPixelX), p.y + ((Command1.Height \ 2) \ Screen.TwipsPerPixelY)
Jalankan aplikasi dan klik Command2.



[ VB .NET ]
Buat Form baru dengan 2 buah TextBox, 2 buah Button, dan 1 buah Timer (Enabled=True; Interval=10) didalamnya.
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Integer
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Integer
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hwnd As Integer, ByRef lpPoint As POINTAPI) As Integer
Private Structure POINTAPI
Dim x As Integer
Dim y As Integer
End Structure

Berikut ini cara untuk mendapatkan posisi mouse, dimana nilai posisinya akan ditampilkan ke TextBox. Ketikkan kode berikut di bagian 'Timer1_Tick'.
Dim p As POINTAPI
GetCursorPos(p)
TextBox1.Text = p.x
TextBox2.Text = p.y
Jalankan aplikasi.

Untuk megubah posisi mouse gunakan kode :
SetCursorPos(x, y)
Gantikan x sesuai dengan ukuran panjang layar. Misal panjangnya 1024, Anda bisa gantikan dengan nilai 0 s/d 1023. dan Gantikan y sesuai dengan ukuran lebar layar. Misal lebarnya 768, Anda bisa gantikan dengan nilai 0 s/d 767.

Sedangkan bila Anda ingin mengubah posisi mouse ke kontrol tertentu, ikuti langkah berikut. Sebagai contoh posisi mouse akan diubah ke tengah kontrol Button1, ketikkan kode berikut di bagian 'Button2_Clickk' :
Dim p As POINTAPI
ClientToScreen(Button1.Handle.ToInt32, p)
SetCursorPos(p.x + (Button1.Width \ 2), p.y + (Button1.Height \ 2))
Jalankan aplikasi dan klik Button2.

Label: , , ,

Sabtu, 09 April 2011

Date/Time Label

Berikut ini cara yang digunakan agar kontrol Label menampilkan Date/Time atau tanggal dan waktu sesuai dengan yang ada di komputer.

[ VB 6.0 ]
Buat Form baru dengan sebuah kontrol Label (AutoSize=True; Alignment=Center) dan Timer (Interval=1000). Lalu ketikkan kode berikut di bagian 'Form_Load' dan 'Timer1_Timer'.
Label1.Caption = Format(Now, "dddd" & vbCrLf & "dd MMMM yyyy" & vbCrLf & "hh : mm : ss")

[ VB .NET ]
Buat Form baru dengan sebuah kontrol Label (TextAlign=TopCenter) dan Timer (Enabled=True; Interval=1000). Lalu ketikkan kode berikut di bagian 'Form1_Load' dan 'Timer1_Tick'.
Label1.Text = Format(Now, "dddd" & vbCrLf & "dd MMMM yyyy" & vbCrLf & "HH : mm : ss")

Label: , , ,

Link Label

Link label adalah sebuah kontrol Label apabila di klik mouse akan membuka alamat web melalui browser atau mengirimkan e-mail melalui aplikasi e-mail.

[ VB 6.0 ]
Buat sebuah Form dengan sebuah kontrol Label didalamnya.
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Di bagian 'Form_Load' ketikkan :
Label1.ForeColor = vbBlue
Label1.FontUnderline = True

Di bagian 'Form_MouseMove' ketikkan :
If Label1.ForeColor <> vbBlue Then Label1.ForeColor = vbBlue

Di bagian 'Label1_MouseDown' ketikkan :
SetCursor (LoadCursor(0, 32649))
ShellExecute Me.hwnd, "", "http://www.google.com", "", "", vbMaximizedFocus
Label1.ForeColor = vbBlue

Di bagian 'Label1_MouseMove' ketikkan :
SetCursor (LoadCursor(0, 32649))
If Label1.ForeColor <> vbRed Then Label1.ForeColor = vbRed



[ VB .NET ]
Buat Form baru dengan sebuah kontrol LinkLabel didalamnya.
Di bagian 'LinkLabel1_LinkClicked' ketikkan :
System.Diagnostics.Process.Start("http://www.google.com")



CATATAN : Anda bisa mengganti alamat web-nya dengan mengganti kode yang berwarna merah. Jika ingin digunakan untuk mengirimkan e-mail, gantikan kode berwarna merah dengan "mailto:AlamatEmailAnda@yahoo.com"

Label: , , ,

Rabu, 06 April 2011

Scan File

Proses scan file biasanya digunakan aplikasi antivirus untuk mendapatkan seluruh lokasi file dalam suatu folder atau drive tertentu. Sebenarnya scan file juga bisa digunakan sekedar sebagai pencarian file tertentu. Misalnya Anda mempunyai aplikasi MP3 player, bisa ditambahkan fitur yang dapat mencari seluruh file *.mp3 yang terdapat dalam folder atau drive tertentu. Berikut ini cara membuat scan file yang sederhana.

[ VB 6.0 ]
Tambahkan Reference "Microsoft Scripting Runtime". Buat sebuah Form baru dengan sebuah ListBox dan sebuah CommandButton (Caption=Scan).
Di bagian '(Declarations)' dari Form ketikkan :
Dim Berhenti As Boolean

Sub ScanFile(ByVal Fol As Scripting.Folder)
If Berhenti = True Then Exit Sub
  
On Error Resume Next
Dim fi As Scripting.File
Dim fo As Scripting.Folder
  
For Each fi In Fol.Files
DoEvents
If Berhenti = True Then Exit Sub
List1.AddItem fi.Path 'menambahkan ke daftar
Next
  
For Each fo In Fol.SubFolders
ScanFile fo
Next

End Sub

Dan di bagian 'Command1_Click' ketikkan :
If Command1.Caption = "Scan" Then
List1.Clear
Berhenti = False
Command1.Caption = "Stop"
Dim fso As New FileSystemObject
ScanFile fso.GetFolder("D:\") 'gantikan D:\ dgn lokasi folder atau drive yg lain
Command1.Caption = "Scan"
Else 'stop
Berhenti = True
Command1.Caption = "Scan"
End If

Jika Anda ingin scan file tertentu semisal hanya file *.mp3 saja, tinggal gantikan kode berwarna merah dengan kode berikut :
If LCase(Right(fi.Path, 4)) = ".mp3" Then List1.AddItem fi.Path

Dan jika Anda ingin men-scan file yang ada di folder utamanya saja (tanpa file di folder-folder didalamnya), tinggal menghapus kode-kode yang berwarna biru.





[ VB NET ]
Buat sebuah Form baru dengan sebuah ListBox dan sebuah Button (Text=Scan).
Di bagian '(Declarations)' dari Form ketikkan :
Dim Berhenti As Boolean

Sub ScanFile(ByVal d As IO.DirectoryInfo)
If Berhenti = True Then Exit Sub
On Error Resume Next

Dim fi As IO.FileInfo
Dim di As IO.DirectoryInfo

For Each fi In d.GetFiles
Application.DoEvents()
If Berhenti = True Then Exit Sub
ListBox1.Items.Add(fi.FullName) 'menambahkan ke daftar
Next

For Each di In d.GetDirectories
ScanFile(di)
Next

End Sub

Dan di bagian 'Button1_Click' ketikkan :
If Button1.Text = "Scan" Then
ListBox1.Items.Clear()
Berhenti = False
Button1.Text = "Stop"
Dim di As IO.DirectoryInfo
di = FileIO.FileSystem.GetDirectoryInfo("D:\") 'gantikan D:\ dgn lokasi folder atau drive yg lain
ScanFile(di)
Button1.Text = "Scan"
Else 'stop
Berhenti = True
Button1.Text = "Stop"
End If

Jika Anda ingin scan file tertentu semisal hanya file *.mp3 saja, tinggal gantikan kode berwarna merah dengan kode berikut :
For Each fi In d.GetFiles("*.mp3")

Dan jika Anda ingin men-scan file yang ada di folder utamanya saja (tanpa file di folder-folder didalamnya), tinggal menghapus kode-kode yang berwarna biru.

Label: , , ,

Selasa, 05 April 2011

Atribut File dan Folder

Berikut ini contoh kode-kode yang digunakan untuk mendapatkan dan mengubah informasi atribut (readonly, hidden, archive, dll) dari File maupun Folder.

[ VB 6.0 ]
 Kode untuk mendapatkan atribut
If (GetAttr("Lokasi File atau Folder") And vbReadOnly) <> 0 Then
'kode jika ber-atribut ReadOnly
End If

Kode untuk mengubah atribut
SetAttr "Lokasi File atau Folder", vbReadOnly Or vbHidden 'set atribut ReadOnly + Hidden

Jika Anda ingin mengubah atribut seluruh File dan Folder dalam suatu Folder tertentu, caranya sebagai berikut :
Tambahkan Reference "Microsoft Scripting Runtime"
Lalu tambahkan Module baru dan ketikkan :
Sub SetAllAttribute(ByVal Fol As Folder, ByVal Att As FileAttribute)
On Error Resume Next
Dim fi As File, fo As Folder

Fol.Attributes = Att
For Each fi In Fol.Files
fi.Attributes = Att
Next

For Each fo In Fol.SubFolders
SetAllAttribute fo, Att
Next
End Sub
Kode untuk menggunakannya :
Dim fso As New FileSystemObject
SetAllAttribute fso.GetFolder("Lokasi Folder"), vbReadOnly Or vbHidden




[ VB .NET ]
Kode untuk mendapatkan atribut
If (GetAttr("Lokasi File atau Folder") And FileAttribute.ReadOnly) <> 0 Then
'kode jika ber-atribut ReadOnly
End If

Kode untuk mengubah atribut
SetAttr("Lokasi File atau Folder", FileAttribute.ReadOnly Or FileAttribute.Hidden) 'set atribut ReadOnly + Hidden

Jika Anda ingin mengubah atribut seluruh File dan Folder dalam suatu Folder tertentu, tambahkan Module baru dan ketikkan :
Sub SetAllAttribute(ByVal Fol As IO.DirectoryInfo, ByVal Att As IO.FileAttributes)
On Error Resume Next
Dim fi As IO.FileInfo, di As IO.DirectoryInfo

Fol.Attributes = Att
For Each fi In Fol.GetFiles
fi.Attributes = Att
Next

For Each di In Fol.GetDirectories
SetAllAttribute(di, Att)
Next
End Sub
Kode untuk menggunakannya :
Dim di As IO.DirectoryInfo
di = FileIO.FileSystem.GetDirectoryInfo("Lokasi Folder")
SetAllAttribute(di, IO.FileAttribute.ReadOnly Or IO.FileAttribute.Hidden)

Label: , , ,