Private Sub Command1_Click()
Call FindOnlyFile("qq.exe")
If strResultPath = "" Then
MsgBox "没有"
Else
MsgBox strResultPath
End If
End Sub
Private Sub Form_List1()
End Sub
Private Sub Command2_Click()
Text1.Text = List1.List(0)
End Sub
Option Explicit
'====================================================================================================
'功能:已知文件名,超级全盘快速查找路径
'用法:Call FindOnlyFile("asdegame.exe") MsgBox strResultPath
'注意:必须在窗体上加List1,要别的List需要改变代码标志的地方
'注意:若单个文件超找，可能有多个路径的话，把***************中间的If去掉
'====================================================================================================
'变量定义
Public strResultPath As String '这个是最后的结果
Public PicHeight%, hLB&, FileSpec$, UseFileSpec%
Public TotalDirs%, TotalFiles%, Running%
Public WFD As WIN32_FIND_DATA, hItem&, hFile&
Public Const vbBackslash = "\"
Public Const vbAllFiles = "*.*"
Public Const vbKeyDot = 46
'API声明
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const LB_INITSTORAGE = &H1A8
Public Const LB_ADDSTRING = &H180
Public Const WM_SETREDRAW = &HB
Public Const WM_VSCROLL = &H115
Public Const SB_BOTTOM = 7
Declare Function GetLogicalDrives Lib "kernel32" () As Long
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Const INVALID_HANDLE_VALUE = -1
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
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Const MaxLFNPath = 260
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 * MaxLFNPath
cShortFileName As String * 14
End Type
Private Sub SearchFileSpec(curpath$)
hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
If hFile& <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If Not Running% Then Exit Sub
SendMessage hLB&, LB_ADDSTRING, 0, _
ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
'**************************************************************************
If Form1.List1.ListCount = 1 Then '这里需要修改
Running% = False
UseFileSpec% = False
strResultPath = Form1.List1.List(0) '这里需要修改(这里是真正的找到并退出)
Exit Sub
End If
'***************************************************************************
Loop While FindNextFile(hFile&, WFD)
Call FindClose(hFile&)
End If
End Sub
Private Sub SearchDirs(curpath$)
Dim dirs%, dirbuf$(), i%
DoEvents
If Not Running% Then Exit Sub
hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
If hItem& <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName) <> vbKeyDot Then
TotalDirs% = TotalDirs% + 1
If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
dirs% = dirs% + 1
dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
End If
ElseIf Not UseFileSpec% Then
TotalFiles% = TotalFiles% + 1
End If
Loop While FindNextFile(hItem&, WFD)
Call FindClose(hItem&)
End If
If UseFileSpec% Then
SendMessage hLB&, WM_SETREDRAW, 0, 0
Call SearchFileSpec(curpath$)
End If
For i% = 1 To dirs%: SearchDirs curpath$ & dirbuf$(i%) & vbBackslash: Next i%
End Sub
Public Sub FindOnlyFile(ByVal strFirstFile As String)
hLB& = Form1.List1.hwnd '这里需要修改
SendMessage hLB&, LB_INITSTORAGE, 30000&, ByVal 30000& * 200
If Running% Then: Running% = False: Exit Sub
Dim drvbitmask&, maxpwr%, pwr%
On Error Resume Next
FileSpec$ = strFirstFile
If Len(FileSpec$) = 0 Then Exit Sub
Running% = True
UseFileSpec% = True
Form1.List1.Clear '这里需要修改
drvbitmask& = GetLogicalDrives()
If drvbitmask& Then
maxpwr% = Int(Log(drvbitmask&) / Log(2))
For pwr% = 0 To maxpwr%
If Running% And (2 ^ pwr% And drvbitmask&) Then
Call SearchDirs(Chr$(vbKeyA + pwr%) & ":\")
End If
Next
End If
Running% = False
UseFileSpec% = False
End Sub
发表于 2011-9-8 17:52
