Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
kode kode diatas tidak jadi komentarnya public declarasi not found
Arief Wibowo <[EMAIL PROTECTED]> wrote:
--- In [email protected], matrixsoke waluyooke
<[EMAIL PROTECTED]> wrote:
>
> Kalau dalam DOS ada perintah DIR & DEL untuk VB perintah dir udah
bisa cuma untuk menghapus file-file sampah dari VB misalnya : Del *.tmp
> saya dah utak atik dengan perintah dibawah ini belum jadi:
>
> dfol = "c:\windows\temp\*.tmp"
> Set fso = CreateObject("Scripting.FileSystemObject")
> If fso.FileExists(dfol) Then
> fso.DeleteFile dfol, True
> 'MsgBox "Delete Sukses"
> Else
> MsgBox dfol & "File Tidak Ditemukan!", vbExclamation, "File
Not Exists"
> End If
>
> apakah perintah dos bisa jalan di VB caranya gimana supaya bisa
Del *.tmp
> Terima Kasih
>
>
> Send instant messages to your online friends
http://uk.messenger.yahoo.com
>
Mas, kalau saya boleh menyarankan, FileSystemObject (a.k.a FSO) krg
bgt bgs/powerful dibandingkan dengan Windows API.
Ini kode APInya
Option Explicit
'API Declaration Part
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA"
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As
Long
Declare Function GetFileAttributes Lib "kernel32" Alias
"GetFileAttributesA" (ByVal lpFileName As String) As Long
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
'Constant Declaration Part
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
'Enumeration Structure Declaration Part
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'Functions Part
Function GetFileName(FileName As String) As String
Dim i As Double
For i = Len(FileName) To 1 Step -1
If Mid(FileName, i, 1) = "\" Then
Exit For
End If
Next i
GetFileName = Mid(FileName, i + 1)
End Function
Function StripNulls(Str As String) As String
On Error Resume Next
If InStr(Str, Chr(0)) > 0 Then Str = Left(Str, InStr(Str, Chr(0)) - 1)
StripNulls = Str
End Function
Function FindFilesAPI(Path As String, SearchStr As String, FileCount
As Double, DirCount As Double, RetLst As Collection)
On Error Resume Next
Dim FileName As String
Dim DirName As String
Dim DirNames() As String
Dim nDir As Double
Dim i As Double
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim Char As Byte
If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim DirNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DoEvents
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(Path & DirName) And
FILE_ATTRIBUTE_DIRECTORY Then
DirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve DirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
DoEvents
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
If GetFileAttributes(Path & FileName) And
FILE_ATTRIBUTE_DIRECTORY Then
'
Else
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh *
MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
RetLst.Add Path & FileName
lstFile.AddItem Path & FileName
lstFile.ListIndex = lstFile.ListCount - 1
End If
End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(Path &
DirNames(i) & "\", SearchStr, FileCount, DirCount, RetLst)
Next i
End If
Exit Function
End Function
Keterangan:
* Fungsi yg prl diakses cuma FindFilesAPI() saja. Sisanya cuma sbg
pendukung aja kok
* Berikut ini keterangan paramnya:
- Path As String --> Masukkan path yang mau dicari berkas2nya
- SearchStr As String --> Masukkan apa yang mau dicari, wildcard
seperti *.tmp boleh
- FileCount As Double --> Nantinya akan mengembalikan jumlah berkas
yang ketemu
- DirCount As Double --> Nantinya akan mengembalikan jumlah map yang
ketemu
- RetLst As Collection --> Nantinya akan mengembalikan path berkas
yang ketemu
* Kode ini adlh bagian dari program File Capturer (buatan AS-Lab). Hak
cipta dibawah lisensi GNU GPL!
--
PS: Semoga informasi ini dapat bermanfaat secara positif bagi kita
semua...
Kalau ada pertanyaan, silahkan hubungi saya ([EMAIL PROTECTED]) :-)
Salam,
('ariefwt' of as-lab)
powered by Arief Softwares Lab ([EMAIL PROTECTED])
Send instant messages to your online friends http://uk.messenger.yahoo.com
