Senin, 28 Juni 2010

Code Scan File pada driver

COPY CODE INI PADA MODULE
‘***********************************************************
‘ Nama : I Gede Eka Wardana *
‘ Alamat : Ds Bengkala, Kec Kubutambahan, Kab buleleng – Bali *
‘ Email : ekawardana98@yahoo.co .id *
‘ Status : sedang menempuh pendidikan S1 di STIKI Denpasar *
‘***********************************************************
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const MAX_BUF As Long = 512
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 'folder
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DEVICE = &H40
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_SPARSE_FILE = &H200
Private Const FILE_ATTRIBUTE_REPARSE_POINT = &H400
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800 'terkompres ntfs.
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000 'tidak masuk dalam index
pencarian file
Private Const FILE_ATTRIBUTE_ENCRYPTED = &H4000 'enkripsi ntfs
Private Const FILE_ATTRIBUTE_VIRTUAL = &H10000 'device virtual
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long 'FILE_ATTRIBUTES
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 '<>MAX_BUF
cAlternate As String * 14
End Type
Private Declare Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal
lpFindFileData As Long) As Long
Private Declare Function FindNextFileW Lib "kernel32" (ByVal hFindFile As Long, ByVal lpFindFileData
As Long) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Boolean
Public scAn As Boolean
Public total As Long
Public Sub scanN(ByVal PATH As String, Optional ByVal FIRS As Boolean = False, Optional ByVal
sCanALL As Boolean = True)
On Error Resume Next
Dim WFD As WIN32_FIND_DATA
Dim hFind As Long
Dim NextStack As Long
Dim zSlash As String
Dim szFullPath As String
Dim szFileName As String
Dim bIsFolder As Boolean
Dim isHiden As Boolean
Dim ttk1 As String
Dim ttk2 As String
ttk1 = ChrW$(46)
ttk2 = ttk1 & ttk1
zSlash = ChrW$(42)
If FIRS = True Then scAn = True
If scAn = False Then GoTo ErH
PATH = fixP(PATH)
hFind = FindFirstFileW(StrPtr(PATH & zSlash), VarPtr(WFD))
If hFind < 1 Then GoTo ErH
Do
If scAn = False Then Exit Do
szFileName = TrimW(WFD.cFileName)
szFullPath = PATH & szFileName
bIsFolder = ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) =
FILE_ATTRIBUTE_DIRECTORY)
If szFileName <> ttk1 And szFileName <> ttk2 Then
lewaT:
Form1.l1.Text = PATH & vbCrLf & "=>" & szFileName ‘PROGRAM UTAMA
total = total + 1
'pasang ceksum disini
DoEvents
Else
bIsFolder = False
End If
If bIsFolder = True Then
If scAn = False Then Exit Do
If sCanALL = True Then
Call scanN(szFullPath, False)
End If
End If
NextStack = FindNextFileW(hFind, VarPtr(WFD))
Loop While NextStack
Call FindClose(hFind)
ErH:
End Sub
Private Function fixP(ByVal pat As String) As String
On Error Resume Next
If Right$(pat, 1) <> ChrW$(92) Then
fixP = pat & ChrW$(92)
Else
fixP = pat
End If
End Function
Private Function TrimW(ByVal pat As String) As String
On Error Resume Next
Dim ksG As Long
ksG = InStr(pat, ChrW$(0))
If ksG > 0 Then
TrimW = Left$(pat, (ksG - 1))
Else
TrimW = pat
End If
End Function

Tidak ada komentar:

Posting Komentar