有些东西跟VB好像～
程序代码：
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
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
Const MaxLFNPath = 260
Const INVALID_HANDLE_VALUE = -1
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 * MaxLFNPath
cShortFileName As String * 14
End Type
Dim WFD As WIN32_FIND_DATA
Dim bgndir$, curpath$, schpattern$, aa$, fname$, progdisk$
Dim hItem&, hFile&, rtn&, i%, j%, k%, tfiles&, tfsize#, stopyn As Boolean 'Boolean 数据类型 (Visual Basic)存放只可能为 True 或 False 的值
Dim X1&, buff$ 'Dim x1& 是Dim x1 As Long“长整型”& 是 As Long的缩写,! 是 as single 的缩写,例如:dim x0!,x1!,t!(或：dim x0 as single,x1 as single,t as single)
Private Sub cmdBower_Click()
Dim Path As String
Path = BrowseForFolder(Me.hwnd, "Select Project's Location :", , NEWFOLDER)
If (Trim(Path) <> "") Then
txtTargetPath.Text = IIf(Right(Trim(Path), 1) <> "\", Path & "\", Path)
txtTargetPath.ToolTipText = txtTargetPath.Text
cmdSearch.Enabled = True
SelectTargetPath = Path
End If
End Sub
Private Sub CmdExit_Click()
Call WriteKTPList
Unload A_frmSearchKTP
A_MainForm.Show
End Sub
Private Sub WriteKTPList()
Dim FileName As String, TempString As String
Dim i As Integer, j As Integer, FileNum As Integer
FileName = App.Path & "\" & "CSV"
If IsFolderExist(FileName) = False Then MkDir FileName
FileName = FileName & "\KTPList.ini"
FileNum = FreeFile
If List1.List(0) <> "" Then
j = 1
Open FileName For Output As #FileNum
For i = 0 To List1.ListCount
If List1.List(i) <> "" Then
Print #FileNum, j & "=" & List1.List(i)
j = j + 1
End If
Next i
Close #FileNum
End If
End Sub
Private Sub cmdSearch_Click()
Dim s As String
On Error Resume Next
List1.Clear '清空list1里面的内容
tfiles = 0: tfsize = 0 '初始化统计文件数为0,文件大小为0,其中冒号是将两个语句分隔开
stopyn = False 'stopyn估计是按钮的停止属性跟cancel差不多吧
CmdExit.Enabled = Not CmdExit.Enabled
cmdBower.Enabled = Not cmdBower.Enabled
cmdSearch.Enabled = Not cmdSearch.Enabled
cmdSTOP.Enabled = Not cmdSTOP.Enabled
Text1.Locked = Not Text1.Locked
Text2.Locked = Not Text2.Locked
If InStr(Text1.Text, ".") = 0 Then Text1.Text = Trim(Text1.Text) & "*.*" '在text1中查找"."如果"."是第一个则....
s = Trim(txtTargetPath.Text)
bgndir = s '开始搜的文件夹
If InStr(bgndir, ":") = 0 And Len(bgndir) = 1 Then bgndir = bgndir & ":"
If Right(bgndir, 1) <> "\" Then bgndir = bgndir & "\"
schpattern = Trim(Text1.Text) '模糊搜索条件,例如 *.* 或 *.mp3 或 sc*.*
Call SearchDirs(bgndir)
If tfiles > 0 Then
MsgBox "搜索完成,共查找到" & str(tfiles) & " 个文件" & vbCrLf & Chr(10) & "总占空间: " & Format(str(tfsize), "#,###") & " Bytes"
Else
MsgBox "搜索完成,未找到符合的文件"
End If
cmdBower.Enabled = Not cmdBower.Enabled
cmdSearch.Enabled = Not cmdSearch.Enabled
cmdSTOP.Enabled = Not cmdSTOP.Enabled
CmdExit.Enabled = Not CmdExit.Enabled
Text1.Locked = Not Text1.Locked
Text2.Locked = Not Text2.Locked
Me.Caption = "快速搜索文件"
End Sub
Private Sub cmdSTOP_Click()
stopyn = True
End Sub
Private Sub Form_Load()
Call init '窗体加载时,首先调用init配置过程
End Sub
Private Sub SearchDirs(curpath)
Dim dirs%, dircount%, dirbuf$()
Dim FilterName As String
On Error Resume Next
Me.Caption = "正在查找 " & curpath
DoEvents
hItem = FindFirstFile(curpath & "*", WFD)
If hItem <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If stopyn Then Exit Do
FilterName = IIf(Trim(Text2.Text) <> "", Trim(Text2.Text), "")
If FilterName <> "" Then
If InStr(WFD.cFileName, FilterName) = 0 Then
If (WFD.dwFileAttributes And vbDirectory) And Asc(WFD.cFileName) <> 46 Then
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
End If
Else
If (WFD.dwFileAttributes And vbDirectory) And Asc(WFD.cFileName) <> 46 Then
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
End If
Loop While FindNextFile(hItem, WFD)
Call FindClose(hItem)
Call mohusearch(curpath)
End If
For dircount = 1 To dirs
DoEvents
If stopyn Then Exit For
SearchDirs curpath & dirbuf$(dircount) & "\"
Next dircount
End Sub
Private Sub mohusearch(curpath)
On Error Resume Next
hFile = FindFirstFile(curpath & schpattern, WFD)
If hFile <> INVALID_HANDLE_VALUE Then
Do
DoEvents
If stopyn Then Exit Do
aa = Trim(Trim(curpath) & Trim(WFD.cFileName))
If (WFD.dwFileAttributes And vbDirectory) Or Asc(WFD.cFileName) = 46 Then
Else
k = InStr(aa, Chr(0))
If k > 0 Then
fname = Mid(aa, 1, k - 1)
aa = fname '& " ----- " & Format(str(FileLen(fname)), "#,###") & " Bytes"
tfiles = tfiles + 1
tfsize = tfsize + FileLen(fname)
List1.AddItem aa
List1.Selected(List1.ListCount - 1) = True
End If
End If
Loop While FindNextFile(hFile, WFD)
Call FindClose(hFile)
End If
End Sub
Private Sub List1_dblClick()
If List1.ListCount > 0 Then
j = List1.ListIndex
fname = Trim(List1.List(j))
j = InStr(fname, "-----")
If j > 0 Then
fname = Trim(Mid(fname, 1, j - 1))
Shell "explorer " & fname, vbNormalNoFocus
End If
End If
End Sub
Private Sub init() '配置窗体加载
Text1.Text = "*.KTP"
'cmdSearch.Enabled = False
cmdSTOP.Enabled = False
End Sub
2012-02-16 19:46
