module2.bas

这是用Vb编写的虚拟驱动程序,希望对大家有帮助.

Attribute VB_Name = "Module2"
'Module for Quicj Searching For Files Using Windows API
'Desgined For Technosoft Virtual Drive 2003
Option Compare Text
'//*********************************//'
Public Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private 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

Private Declare Function FindFirstFile Lib "Kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "Kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "Kernel32" (ByVal hFindFile As Long) As Long

Public Sub FindFiles(strRootFolder As String, strFolder As String, strFile As String, colFilesFound As Collection)
    Dim lngSearchHandle As Long
    Dim udtFindData As WIN32_FIND_DATA
    Dim strTemp As String, lngRet As Long
        
    'Check that folder name ends with "\"
    If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
    
    'Find first file/folder in current folder
    lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
    
    'Check that we received a valid handle
    If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub
    
    lngRet = 1
    
    Do While lngRet <> 0
        
        'Trim nulls from filename
        strTemp = TrimNulls(udtFindData.cFileName)
        
        If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            'It's a dir - make sure it isn't . or .. dirs
            If strTemp <> "." And strTemp <> ".." Then
                'It's a normal dir: let's dive straight
                'into it...
                Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
            End If
        Else
            'It's a file. First check if the current folder matches
            'the folder path in strFolder
            If (strRootFolder Like strFolder) Then
                'Folder matches, what about file?
                If (strTemp Like strFile) Then
                    'Found one!
                    colFilesFound.Add strRootFolder & strTemp
                End If
            End If
        End If
        
        'Get next file/folder
        lngRet = FindNextFile(lngSearchHandle, udtFindData)
        
    Loop
    
    'Close find handle
    Call FindClose(lngSearchHandle)
    
End Sub

Public Function TrimNulls(strString As String) As String
   
   Dim l As Long
   
   l = InStr(1, strString, Chr(0))
   
   If l = 1 Then
      TrimNulls = ""
   ElseIf l > 0 Then
      TrimNulls = Left$(strString, l - 1)
   Else
      TrimNulls = strString
   End If
   
End Function