你看这样行吗？Private Sub Command1_Click()
Dim x As Long
Dim buff As String
buff = String(MAX_PATH, 0)
x = SearchTreeForFile("c:\", "gg.txt", buff)
If x <> 0 Then
MsgBox "找到这个文件！！！" + Left$(buff, InStr(1, buff, Chr$(0)) - 1)
Else
MsgBox "没有找到这个文件"
End If
End Sub
模块：
Public Const MAX_PATH = 260Public Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal lpRoothPath As String, ByVal lpInputName As String, ByVal lpOutputName As String) As Long
Dim x As Long
Dim buff As String
buff = String(MAX_PATH, 0)
x = SearchTreeForFile("c:\", "gg.txt", buff)
If x <> 0 Then
MsgBox "找到这个文件！！！" + Left$(buff, InStr(1, buff, Chr$(0)) - 1)
Else
MsgBox "没有找到这个文件"
End If
End Sub
模块：
Public Const MAX_PATH = 260Public Declare Function SearchTreeForFile Lib "imagehlp.dll" (ByVal lpRoothPath As String, ByVal lpInputName As String, ByVal lpOutputName As String) As Long
Begin VB.Form MapView
BorderStyle = 1 'Fixed Single
Caption = "MapView"
ClientHeight = 4950
ClientLeft = 45
ClientTop = 330
ClientWidth = 7440
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 330
ScaleMode = 3 'Pixel
ScaleWidth = 496
StartUpPosition = 3 '窗口缺省
Begin VB.ListBox List1
Height = 1260
IntegralHeight = 0 'False
Left = 0
Style = 1 'Checkbox
TabIndex = 4
Top = 3690
Width = 2250
End
Begin VB.DirListBox Dir1
Height = 3240
Left = 0
TabIndex = 3
Top = 300
Width = 2250
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 0
TabIndex = 2
Top = 0
Width = 2250
End
Begin VB.PictureBox PicRect
Height = 4950
Left = 2250
ScaleHeight = 326
ScaleMode = 3 'Pixel
ScaleWidth = 342
TabIndex = 0
Top = 0
Width = 5190
Begin VB.PictureBox PicData
BackColor = &H00C0C0FF&
BorderStyle = 0 'None
Height = 3555
Left = 60
ScaleHeight = 237
ScaleMode = 3 'Pixel
ScaleWidth = 227
TabIndex = 5
Top = 120
Width = 3405
Begin VB.Shape ShpSel
BorderColor = &H0000FFFF&
BorderStyle = 6 'Inside Solid
BorderWidth = 2
Height = 645
Left = 630
Top = 960
Width = 915
End
Begin VB.Image ImgFile
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Height = 585
Index = 0
Left = 0
Stretch = -1 'True
Top = 0
Width = 675
End
Begin VB.Label LblFile
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "File"
Height = 240
Index = 0
Left = 60
TabIndex = 6
Top = 660
Width = 645
End
End
Begin VB.VScrollBar VSol
Height = 4890
Left = 4890
TabIndex = 1
Top = 0
Width = 240
End
End
End
Attribute VB_Name = "MapView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Const MAX_PATH = 260
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 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
Private Const ImgWidth As Long = 80&
Private Const ImgHeight As Long = 64&
Private Const LblHeight As Long = 16&
Private Const AllHeight As Long = ImgHeight + LblHeight
Private Const ItemStep As Long = 2&Private Const WItems As Long = 4&
Private Const HItems As Long = 4&Private ViewCount As Long
Private ViewMapFile() As String
Private RealCount As LongPrivate SelIdx As Long
Private PathStr As String
Private LoadMaping As Boolean
Private Changed As Boolean
Private Sub SolNum()
Dim CurHItems As Long
CurHItems = (ViewCount + WItems - 1) \ WItems
If CurHItems > HItems Then
VSol.Enabled = True
VSol.Min = 0
VSol.Max = CurHItems - HItems
VSol.Value = 0
Else
VSol.Enabled = False
End If
End SubPrivate Sub SetSel()
If SelIdx >= 0 And SelIdx < ViewCount Then
ShpSel.Move ImgFile(SelIdx).Left, ImgFile(SelIdx).Top, ImgWidth, AllHeight
If ShpSel.Visible = False Then ShpSel.Visible = True
Else
ShpSel.Visible = False
End If
PicData.ToolTipText = (SelIdx + 1) & "/" & ViewCount
PicRect.ToolTipText = PicData.ToolTipText
End SubPrivate Sub LoadFile()
LoadMaping = True
Me.MousePointer = vbArrowHourglass
Start:
Dim CurPath As String
Dim CurPathFile As String
CurPath = PathStr
If Right$(CurPath, 1) = "\" Then
CurPathFile = CurPath
Else
CurPathFile = CurPath & "\"
End If
Dim CurFile As String
Dim TempStr As String
Dim I As Long, MaxI As Long
Dim f As Boolean
MaxI = ViewCount - 1
For I = 0 To MaxI
Set ImgFile(I).Picture = Nothing
ImgFile(I).Tag = ""
LblFile(I).Caption = vbNullString
Next I
Dim Idx As Long
Dim FileCount As Long
Dim wfd As WIN32_FIND_DATA
Dim hFind As Long
Dim nFind As Long
FileCount = 0
hFind = FindFirstFile(CurPathFile & "*.*", wfd)
If hFind = 0 Then
LoadMaping = False
Exit Sub
End If
MaxI = UBound(ViewMapFile)
Do
CurFile = Left(wfd.cFileName, InStr(wfd.cFileName, Chr(0)) - 1)
'Debug.Print CurFile
If Left(Right(CurFile, 4), 1) = "." Then
TempStr = LCase(Right(CurFile, 3))
f = False
For I = 0 To MaxI
If TempStr = ViewMapFile(I) Then
f = True
Exit For
End If
Next I
If f Then
FileCount = FileCount + 1
Idx = FileCount - 1
If FileCount > RealCount Then
Load ImgFile(Idx)
Load LblFile(Idx)
RealCount = RealCount + 1
ImgFile(Idx).Move (Idx Mod WItems) * (ImgWidth + ItemStep), (Idx \ WItems) * (AllHeight + ItemStep), ImgWidth, ImgHeight
LblFile(Idx).Move ImgFile(Idx).Left, ImgFile(Idx).Top + ImgHeight, ImgWidth, LblHeight
End If
ImgFile(Idx).Tag = CurPathFile & CurFile
ImgFile(Idx).ToolTipText = ImgFile(Idx).Tag
LblFile(Idx).Caption = CurFile
LblFile(Idx).ToolTipText = CurFile
If FileCount > ViewCount Then
ImgFile(Idx).Visible = True
LblFile(Idx).Visible = True
End If
'Debug.Print CurFile
End If
End If
nFind = FindNextFile(hFind, wfd)
Loop While nFind
FindClose hFind
For I = FileCount + 1 To ViewCount
Idx = I - 1
ImgFile(Idx).Visible = False
LblFile(Idx).Visible = False
Next I
ViewCount = FileCount
Idx = ViewCount - 1
If Idx >= 0 Then
I = LblFile(Idx).Top + LblHeight
If I < PicRect.ScaleHeight Then I = PicRect.ScaleHeight
PicData.Height = I
SelIdx = 0
Else
SelIdx = -1
End If
SolNum
SetSel
'DoEvents
MaxI = FileCount - 1
For I = 0 To MaxI
Set ImgFile(I).Picture = LoadPicture(ImgFile(I).Tag)
DoEvents
If Changed Then
Changed = False
GoTo Start
End If
Next I
Me.MousePointer = vbDefault
LoadMaping = False
End Sub
Private Sub Dir1_Change()
PathStr = Dir1.Path
Changed = True
If LoadMaping Then
Else
LoadFile
End If
End SubPrivate Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End SubPrivate Sub Form_DblClick()
'双击时刷新
Dir1_Change
End SubPrivate Sub Form_Load()
LoadMaping = False
SelIdx = -1
PicData.Move 0, 0, PicRect.ScaleWidth - VSol.Width, PicRect.ScaleHeight
VSol.LargeChange = HItems
RealCount = 1
ViewCount = 0
ImgFile(0).Move 0, 0, ImgWidth, ImgHeight
ImgFile(0).Visible = False
LblFile(0).Move 0, ImgFile(0).Top + ImgFile(0).Height, ImgWidth, LblHeight
LblFile(0).Visible = False
List1.AddItem "bmp"
List1.AddItem "gif"
List1.AddItem "jpg"
List1.AddItem "ico"
List1.AddItem "cur"
List1.AddItem "rle"
List1.AddItem "wmf"
List1.AddItem "emf"
List1.Selected(0) = True
List1.Selected(1) = True
List1.Selected(2) = True
Dir1_Change
End SubPrivate Sub ImgFile_Click(Index As Integer)
SelIdx = Index
SetSel
End SubPrivate Sub ImgFile_DblClick(Index As Integer)
ShellExecute Me.hwnd, "open", ImgFile(Index).Tag, vbNullString, vbNullString, 0
End SubPrivate Sub LblFile_Click(Index As Integer)
SelIdx = Index
SetSel
End SubPrivate Sub LblFile_DblClick(Index As Integer)
ShellExecute Me.hwnd, "open", ImgFile(Index).Tag, vbNullString, vbNullString, 0
End SubPrivate Sub List1_Click()
'Debug.Print "List1_Click"
Dim I As Long
Dim Idx As Long
ReDim ViewMapFile(0 To List1.SelCount - 1)
Idx = 0
For I = 0 To List1.ListCount - 1
If List1.Selected(I) Then
ViewMapFile(Idx) = List1.List(I)
Idx = Idx + 1
End If
Next I
End SubPrivate Sub PicData_DblClick()
'双击时刷新
Dir1_Change
End SubPrivate Sub PicRect_DblClick()
'双击时刷新
Dir1_Change
End SubPrivate Sub VSol_Change()
PicData.Top = -VSol.Value * (AllHeight + ItemStep)
End SubPrivate Sub VSol_Scroll()
VSol_Change
End Sub