如何遍历系统盘 查找指定文件,然后再删除它?
我在网络上搜索到了这个代码
模块
Public Const MAX_PATH = 260
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
'说明 根据文件名查找文件
'返回值 Long,如执行成功,返回一个搜索句柄。如果出错,返回一个INVALID_HANDLE_VALUE常数,一旦不再需要,应该用FindClose函数关闭这个句柄
'lpFileName String,欲搜索的文件名。可包含通配符,并可包含一个路径或相对路径名
'WIN32_FIND_DATA,这个结构用于装载与找到的文件有关的信息。该结构可用于后续的搜索
'由这个函数返回的句柄可以作为一个参数用于FindNextFile函数。这样一来,就可以方便的枚举出与lpFileName参数指定的文件名相符的所有文件
Public Declare Function FindNextFile Lib "kernel32" Alias _
"FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal _
hFindFile As Long) As Long
Public Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Sub AllSearch(sPath As String, sFile As String)
Dim xf As WIN32_FIND_DATA
Dim ff As WIN32_FIND_DATA
Dim findhandle As Long
Dim lFindFile As Long
Dim astr As String
Dim bstr As String
lFindFile = FindFirstFile(sPath + "\" + sFile, ff)
'Debug.Print sPath + "\" + sFile
If lFindFile > 0 Then
Do
Form1.List1.AddItem ff.cFileName
Loop Until (FindNextFile(lFindFile, ff) = 0)
FindClose lFindFile
End If
'Debug.Print Form1.List1.ListCount
astr = sPath + "\" + "*.*"
findhandle = FindFirstFile(astr, xf)
DoEvents
Do
If xf.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
If Asc(xf.cFileName) <> Asc(".") Then
bstr = sPath + "\" + Left$(xf.cFileName, InStr(xf.cFileName, Chr(0)) - 1)
'Debug.Print bstr
AllSearch bstr, sFile
'lFindFile = FindFirstFile(bstr, ff)
'Debug.Print bstr
'Do
' Form1.List1.AddItem ff.cFileName
'Debug.Print ff.cFileName
' ff.cFileName = ""
'Loop Until (FindNextFile(lFindFile, ff) = 0)
'FindClose lFindFile
End If
End If
xf.cFileName = ""
Loop Until (FindNextFile(findhandle, xf) = 0)
FindClose findfile
End Sub
窗体调用
Private Sub Command1_Click()
Dim SearchedPath As String
Dim SearchedFile As String
SearchedPath = InputBox("输入要搜索的路径" + Chr(13) + Chr(10) + "例如c:\windows")
SearchedFile = InputBox("输入要搜索的文件名" + Chr(13) + Chr(10) + "例如*.exe abc.*")
'FirstSearch = True
AllSearch SearchedPath, SearchedFile
End Sub
基本上实现了效果
但是如何得到程序的绝对路径并且删除掉它呢
我要搜索的文件 可能有若干个并且分布到不同的目录里 我需要指定删除
比如删除掉 除 wins spool 下的其他指定文件
一个朋友告诉我先都全找出来之后在排除掉我要保留的文件
上面代码基本上实现 就是不知道如何得到文件的绝对路径
[解决办法]
下面这段代码 List1列表中已包含路径, 自己再加代码删除
注意:删除时从后面删回来 For i=List1.listcount-1 to 0 step -1
'****************************************************************
Option Explicit
Private 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
Dim i&, Pos&, Rtn&
Dim Con As New Collection
Private Sub Command1_Click()
List1.Clear
DoEvents
Me.Caption = "搜寻中,请稍侯!"
List1.Visible = False
FindFiles "d:\pictures", "*", "*.jpg", Con
For i = 1 To Con.Count
List1.AddItem Con.Item(i)
Next
Set Con = Nothing
List1.Visible = True
Me.Caption = "搜寻完毕!"
MsgBox List1.ListCount
End Sub
Public Sub FindFiles(FolderPath As String, TmpFolder As String, TmpFile As String, FilesCol As Collection)
Dim HwndVal&, TempStr$
Dim FindData As WIN32_FIND_DATA
FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
HwndVal = FindFirstFile(FolderPath & "*", FindData)
If HwndVal = INVALID_HANDLE_VALUE Then Exit Sub
Rtn = 1
Do While Rtn <> 0
TempStr = DelNull(FindData.cFileName)
If (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
If TempStr <> "." And TempStr <> ".." Then Call FindFiles(FolderPath & TempStr, TmpFolder, TmpFile, FilesCol)
Else
If (FolderPath Like TmpFolder) Then
If (TempStr Like TmpFile) Then FilesCol.Add FolderPath & TempStr
End If
End If
Rtn = FindNextFile(HwndVal, FindData)
Loop
Call FindClose(HwndVal)
End Sub
Public Function DelNull(FindStr As String) As String
Pos = InStr(FindStr, Chr(0))
DelNull = IIf(Pos = 1, "", IIf(Pos > 0, Left(FindStr, Pos - 1), FindStr))
End Function