Membuat Search Files Sederhana dengan Visual Basic 6.0 ~ Nant's Light. . .

Assalamu’alaikum Wr.Wb

Nantslight – Pernah tidak anda suatu ketika lupa menaruh file yang akan anda buka, biasanya langsung ngublek-ngublek explorer atau Klik Start>Search.. Nah Kali ini saya mau share tentang tutorial Cara Membuat Search Files Sederhana dengan Visual Basic 6.0. Sebenernya udah lama mau saya share tetapi karena lupa naruhnya itu tadi jadinya saya share sekarang aja..(^_^) .

Ok Langsung aja..

Pertama Buka IDE Visual Basic 6.0-Pilih Standard.Exe

Kemudian tambahkan 2 CommandButton, 4 TextBox, 1 ListBox, 4 Label, 1 module.

Untuk TextBox-nya bagian Text-nya di kosongin aja.. Atur Caption Label seperti pada gambar..

Untuk CommandButton1 ubah Captionnya Menjadi Search..

Untuk CommandButton2 ubah Captionnya menjadi Browse..

Kemudian untuk form masukkan kode di bawah ini..

----------------------------------------------------------------------

Function FindFiles(path As String, SearchStr As String, _

FileCount As Integer, _

DirCount As Integer)

Dim FileName As String

Dim DirName As String

Dim dirNames() As String

Dim nDir As Integer

Dim i As Integer

On Error GoTo sysFileERR

If Right(path, 1) <> "\" Then path = path & "\"

nDir = 0

ReDim dirNames(nDir)

DirName = Dir(path, vbDirectory Or vbHidden)

Do While Len(DirName) > 0

If (DirName <> ".") And (DirName <> "..") Then

If GetAttr(path & DirName) And vbDirectory Then

dirNames(nDir) = DirName

DirCount = DirCount + 1

nDir = nDir + 1

ReDim Preserve dirNames(nDir)

End If

sysFileERRCont:

End If

DirName = Dir()

Loop

FileName = Dir(path & SearchStr, vbNormal _

Or vbHidden Or vbSystem _

Or vbReadOnly)

While Len(FileName) <> 0

FindFiles = FindFiles + FileLen(path & FileName)

FileCount = FileCount + 1

List1.AddItem path & FileName

FileName = Dir()

Wend

If nDir > 0 Then

For i = 0 To nDir - 1

FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _

SearchStr, FileCount, DirCount)

Next i

End If

AbortFunction:

Exit Function

sysFileERR:

If Right(DirName, 4) = ".sys" Then

Resume sysFileERRCont

Else

MsgBox "Error: " & Err.Number & " - " & Err.Description, , _

"Unexpected Error"

Resume AbortFunction

End If

End Function

Private Sub Command1_Click()

Dim SearchPath As String, FindStr As String

Dim FileSize As Long

Dim NumFiles As Integer, NumDirs As Integer

Screen.MousePointer = vbHourglass

List1.Clear

SearchPath = Text1.Text

FindStr = Text2.Text

FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)

Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _

" Directories"

Text4.Text = "Size of files found under " & SearchPath & " = " & _

Format(FileSize, "#,###,###,##0") & " Bytes"

Screen.MousePointer = vbDefault

End Sub

Private Sub Command2_Click()

Dim lpIDList As Long

Dim sBuffer As String

Dim szTitle As String

Dim tBrowseInfo As BrowseInfo

szTitle = "This Is My Title"

With tBrowseInfo

.hWndOwner = Me.hWnd

.lpszTitle = lstrcat(szTitle, "")

.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN

End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then

sBuffer = Space(MAX_PATH)

SHGetPathFromIDList lpIDList, sBuffer

sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)

Text1.Text = sBuffer

End If

End Sub

----------------------------------------------------------------------

Dan untuk module-nya masukkan kode di bawah ini..

----------------------------------------------------------------------

Public Const BIF_RETURNONLYFSDIRS = 1

Public Const BIF_DONTGOBELOWDOMAIN = 2

Public Const MAX_PATH = 260

Declare Function SHBrowseForFolder Lib _

"shell32" (lpbi As BrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList _

As Long, ByVal lpBuffer As String) As Long

Declare Function lstrcat Lib "kernel32" _

Alias "lstrcatA" (ByVal lpString1 As String, ByVal _

lpString2 As String) As Long

Public Type BrowseInfo

hWndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As Long

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

----------------------------------------------------------------------

Setelah itu jadi deh.. Tekan F5 di Keyboard dansilahkan anda coba.. o ya agar tidak terjadi error, ubah properties Text1, Text3, Text4 yang bagian Locked menjadi True.. Kalau anda gak kepingin susah-susah bikin silahkan download di sini. Sekian dulu ya..

Selamat Mencoba..

Semoga Bermanfaat..

Wassalamu’alaikum Wr.Wb

These icons link to social bookmarking sites where readers can share and discover new web pages.