【VB开源代码栏目提醒】：网学会员,鉴于大家对VB开源代码十分关注，论文会员在此为大家搜集整理了“用VB编一个多功能的资源管理器_VB源码 - 计算机教材”一文，供大家参考学习!

用VB编一个多功能的资源管理器的所有源代码 以下保存为文件：clsSearch.cls VERSION 1.0 CLASS BEGIN MultiUse -1 True Persistable 0 NotPersistable DataBindingBehavior 0 vbNone DataSourceBehavior 0 vbNone MTSTransactionMode 0 NotAnMTSObject END Attribute VB_Name quotclsSearchquot Attribute VB_GlobalNameSpace False Attribute VB_Creatable True Attribute VB_PredeclaredId False Attribute VB_Exposed False Option Explicit Private Declare Function FreeLibrary Lib quotkernel32quot ByVal hLibModule As Long As Long Private Declare Function LoadString Lib quotuser32quot Alias quotLoadStringAquot ByVal hInstance As Long ByVal uID As Long ByVal lpBuffer As String ByVal nBufferMax As Long As Long Private Declare Function LoadLibrary Lib quotkernel32quot Alias quotLoadLibraryAquot ByVal lpLibFileName As String As Long Private Declare Sub GetSystemTime Lib quotkernel32quot lpSystemTime As SYSTEMTIME Private Declare Function GetTimeZoneInformation Lib quotkernel32quot lpTimeZoneInformation As TIME_ZONE_INFORMATION As Long Private Declare Function SystemTimeToTzSpecificLocalTime Lib quotkernel32quot lpTimeZoneInformation As TIME_ZONE_INFORMATION lpUniversalTime As SYSTEMTIME lpLocalTime As SYSTEMTIME As Long Private Declare Function FileTimeToSystemTime Lib quotkernel32quot lpFileTime As FILETIME lpSystemTime As SYSTEMTIME As Long Private Declare Function FindFirstFile Lib quotkernel32quot Alias quotFindFirstFileAquot ByVal lpFileName As String lpFindFileData As WIN32_FIND_DATA As Long Private Declare Function FindNextFile Lib quotkernel32quot Alias quotFindNextFileAquot ByVal hFindFile As Long lpFindFileData As WIN32_FIND_DATA As Long Private Declare Function FindClose Lib quotkernel32quot ByVal hFindFile As Long As Long Private Const INVALID_HANDLE_VALUE As Long -1 Private Const MaxLFNPath As Integer 260 Private Const vbBackslash As String quotquot Private Const vbAllFiles As String quot.quot Private Const vbKeyDot As Integer 46 Public sShell32 As String Public Enum ResType TEXT_RESOURCE_WORKSPACE 4162 TEXT_RESOURCE_MYCOMPUTER 9216 TEXT_RESOURCE_CONTROLPANEL 4161 TEXT_RESOURCE_COL_NAME 8976 TEXT_RESOURCE_COL_SIZE 8978 TEXT_RESOURCE_COL_TYPE 8979 TEXT_RESOURCE_COL_MODIFIED 8980 TEXT_RESOURCE_COL_CREATED 8996 ICON_RESOURCE_WORKSPACE 34 ICON_RESOURCE_MYCOMPUTER 16 ICON_RESOURCE_MYDOCUMENTS 20 ICON_RESOURCE_NETWOORK 17 ICON_RESOURCE_CONTROLPANEL 35 End Enum Private Enum FileAtribs FILE_ATTRIBUTE_ARCHIVE ampH20 FILE_ATTRIBUTE_DIRECTORY ampH10 FILE_ATTRIBUTE_HIDDEN ampH2 FILE_ATTRIBUTE_NORMAL ampH80 FILE_ATTRIBUTE_READONLY ampH1 FILE_ATTRIBUTE_SYSTEM ampH4 FILE_ATTRIBUTE_TEMPORARY ampH100 End Enum Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type 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 Private Type TIME_ZONE_INFORMATION bias As Long StandardName0 To 63 As Byte StandardDate As SYSTEMTIME StandardBias As Long DaylightName0 To 63 As Byte DaylightDate As SYSTEMTIME DaylightBias As Long End Type Private WFD As WIN32_FIND_DATA Private sZipFolders As String Private hItem As Long Private hFile As Long Private msFileSpec As String Private msPath As String Private mbSearching As Boolean Private mbSubDirs As Boolean Private mbSystemDirs As Boolean Private mbHiddenDirs As Boolean Private mbUseCase As Boolean Private mbSearchString As String Private sExtension As String Private mbExtension As Boolean Private mbUseString As Boolean Private mbZipFiles As Boolean Private mbCompareDate As tCompareDate Private mbSize As Double Private mbSizeType As Integer Private mlTotalDirs As Long Private mlTotalFiles As Long Public Event BeginFindFiles Public Event EndFindFilesFileCount As Long Public Event FoundFileFileName As String FilePath As String Size As Long InZip As Boolean sFileType As String sTmpLocation As String sDate As String Cancel As Boolean Public Event FolderChangesFolder As String Private Function ConvertTimefFiletime As FILETIME Optional bFull As Boolean False As String Dim SysTime As SYSTEMTIME Dim Ret As Long Dim sDateSetial As Single Convert file time to the system time Ret FileTimeToSystemTimefFiletime SysTime If Ret Then sDateSetial DateSerialSysTime.wYear SysTime.wMonth SysTime.wDay Date serial to convert to string If sDateSetial gt 0 Then Convert the time to a string we can read If bFull True Then ConvertTime FormatsDateSetial quotdd/mm/yy quot amp String2 - LenCStrSysTime.wHour quot0quot amp SysTime.wHour amp quot:quot amp String2 - LenCStrSysTime.wMinute quot0quot amp SysTime.wMinute Stop Else ConvertTime FormatsDateSetial quotdd/mm/yyquot End If Else ConvertTime quotNo Datequot End If End If End Function Public Sub SetComparePropstType As eCompareDate tTime As Integer tCompare As Boolean tWhich As eCompareType Fast easy way to set multiple properties at once With mbCompareDate .tCompare tCompare .tType tType .tTime tTime .tWhich tWhich End With End Sub Public Property Let sTypeByVal vData As String Only certain type sExtension vData If LenvData 0 Then mbExtension 0 Else mbExtension 1 End If End Property Public Property Get sType As String sType sExtension End Property Public Property Let SearchZipsByVal vData As Boolean Search Zip files mbZipFiles vData End Property Public Property Get SearchZips As Boolean SearchZips mbZipFiles End Property Public Property Let CompareSizeTypeByVal vData As Integer Use Size matching If so which type. mbSizeType vData End Property Public Property Get CompareSizeType As Integer CompareSizeType mbSizeType End Property Public Property Let CompareSizeByVal vData As Double The size limit we might be searching for mbSize vData End Property Public Property Get CompareSize As Double CompareSize mbSize End Property Public Property Let SearchWordsByVal vData As String Containing text.... mbUseString LenvData gt 0 mbSearchString vData End Property Public Property Get SearchWords As String SearchWords mbSearchString End Property Public Property Let CaseSensitiveByVal vData As Boolean Ignore case mbUseCase vData End Property Public Property Get CaseSensitive As Boolean CaseSensitive mbUseCase End Property Public Property Let SearchHiddenFoldersByVal vData As Boolean Search hidden folders mbHiddenDirs vData End Property Public Property Get SearchHiddenFolders As Boolean SearchHiddenFolders mbHiddenDirs End Property Public Property Let SearchSystemFoldersByVal vData As Boolean Search system folders mbSystemDirs vData End Property Public Property Get SearchSystemFolders As Boolean SearchSystemFolders mbSystemDirs End Property Public Property Let SearchSubFoldersByVal vData As Boolean Search sub folders mbSubDirs vData End Property Public Property Get SearchSubFolders As Boolean SearchSubFolders mbSubDirs End Property Public Property Let PathByVal vData As String This is always required the path to search. msPath vData End Property Public Property Get Path As String Path msPath End Property Public Property Let FileSpecByVal vData As String The regular expression to match. msFileSpec vData End Property Public Property Get FileSpec As String FileSpec msFileSpec End Property Public Property Let SearchingByVal vData As Boolean Our property to cancel the search mbSearching vData End Property Public Property Get Searching As Boolean Searching mbSearching End Property Public Function FindAllByRef FileListArray As String As Boolean Dim asfiles As String Our find all files function this was the original edited of course. I really should just remove it for efficiency but im a lazy git to be honest. Erase sZipFolders If FindFilesasfiles Then Stop FileListArray asfiles FindAll True Else FindAll False End If eop_error: Select Case Err.Number Case Is gt 0 FindAll False Err.Raise Err.Number Err.Source Err.Description Err.HelpFile Err.HelpContext End Select eop_exit: End Function Private Function FindFilesasFoundFiles As String As Boolean FindFiles False If Searching Then Searching False GoTo eop_exit End If On Error Resume Next A parsing routine could be implemented here for multiple file spec searches i.e. quot.bmp.wmfquot etc. See the MS KB article Q130860 for information on how FindFirstFile does not handle the quotquot wildcard char correctly If LenFileSpec 0 Then GoTo eop_exit If LenPath 0 Then GoTo eop_exit mbSearching True RaiseEvent BeginFindFiles Call SearchDirsPath asFoundFiles Searching False mlTotalFiles J_UBoundasFoundFiles Stop RaiseEvent EndFindFilesmlTotalFiles FindFiles True eop_exit: End Function Private Sub SearchDirsCurPath As String asFoundFiles As String Dim dirs As Integer Dim dirbuf As String Dim i As Integer On Error GoTo ErrClear DoEvents Tell the program we are searching a new folder. RaiseEvent FolderChangeCurPath If user cancelled then exit. If Not Searching Then GoTo eop_exit Find the first file. hItemamp FindFirstFileCurPath amp vbAllFiles WFD If hItemamp ltgt INVALID_HANDLE_VALUE Then Do Stop If mbSubDirs And WFD.dwFileAttributes And vbDirectory Then If its a folder. Check the following if we need to. If Not mbHiddenDirs And WFD.dwFileAttributes And FileAtribs.FILE_ATTRIBUTE_HIDDEN FileAtribs.FILE_ATTRIBUTE_HIDDEN Then GoTo Skipper If Not mbSystemDirs And WFD.dwFileAttributes And FileAtribs.FILE_ATTRIBUTE_SYSTEM FileAtribs.FILE_ATTRIBUTE_SYSTEM Then GoTo Skipper If AscWFD.cFileName ltgt vbKeyDot Then If its the good old . aka folder up. Stop mlTotalDirs mlTotalDirs 1 If dirs Mod 10 0 Then ReDim Preserve dirbufdirs 10 Saves procesing time to only add every ten ticks. dirs dirs 1 dirbufdirs LeftWFD.cFileName InStrWFD.cFileName vbNullChar - 1 End If End If Skipper: Continue looping while we are finding more files. Loop While FindNextFilehItemamp WFD Stop the searching. Call FindClosehItemamp End If Our function to search indiviual files. Call SearchFileSpecCurPath asFoundFiles For i 1 To dirs Search sub folders. SearchDirs CurPath amp dirbufi amp vbBackslash asFoundFiles Next My dirty little hack for searching inside zip files. Call SearchZipFilesasFoundFiles eop_exit: Exit Sub ErrClear: MsgBox quotSearchDirs : Error: quot amp Err.Number amp quot : quot amp Err.Description amp quot : quot amp Err.Source End Sub Private Sub SearchFileSpecCurPath As String asFoundFiles As String Optional ZipFolder As String quotquot Dim Cancel As Boolean Dim sTempFile As String Dim Pos As Integer Dim sFileTime As String Dim wftTime As FILETIME Dim sTmp As String Dim sExt As String Dim sTime As String On Error GoTo ErrClear hFileamp FindFirstFileCurPath amp FileSpec WFD If hFileamp ltgt INVALID_HANDLE_VALUE Then Do DoEvents If Not mbSearching Then GoTo eop_exit sTempFile CurPath amp LeftWFD.cFileName InStrWFD.cFileName vbNullChar - 1 Full path Pos InStrRevsTempFile quotquot Check for end of folder name. If Not RightsTempFile LensTempFile - Pos quot.quot And Not RightsTempFile LensTempFile - Pos quot..quot Then If its not a REAL folder... If Not mbHiddenDirs And WFD.dwFileAttributes And FileAtribs.FILE_ATTRIBUTE_HIDDEN FileAtribs.FILE_ATTRIBUTE_HIDDEN Then GoTo Skipperd If mbZipFiles True Then If we want to search inside these later... If RightsTempFile 4 quot.zipquot Then ReDim Preserve sZipFoldersJ_UBoundsZipFolders 1 sZipFoldersJ_UBoundsZipFolders sTempFile Add it to our array of zip files. End If End If Stop If mbUseString Then If CheckForStringsTempFile mbSearchString False Then GoTo Skipperd Check containing string Stop Pos InStrRevsTempFile quot.quot If mbExtension True And Pos 0 Then GoTo Skipperd sExt RightsTempFile LensTempFile - Pos sTmp GetTypesExt If mbExtension True Then If Not StrCompsTmp sExtension vbBinaryCompare 0 Then GoTo Skipperd If DirExistssTempFile True Then sTmp quotFile Folderquot Else If LensTmp 0 And LensExt gt 0 Then sTmp UCasesExt amp quot Filequot End If sTime ConvertTimeWFD.ftLastWriteTime True If mbCompareDate.tCompare True Then If we need to compare file dates. If mbCompareDate.tWhich eCreated Then Set to check Creation time. wftTime WFD.ftCreationTime sFileTime ConvertTimewftTime Else Set to check Modification time. wftTime WFD.ftLastWriteTime sFileTime ConvertTimewftTime End If If sFileTime quotNo Datequot Then GoTo Skipperd Has no date If CompareDatessFileTime False Then GoTo Skipperd Isnt within our search parametres. End If If mbSize gt 0 Then If we need to check file size If mbSizeType 1 Then Check is the file size greater than allowed If WFD.nFileSizeLow gt CDblmbSize 1024 Then GoTo Skipperd Else Check is the file size less than allowed If WFD.nFileSizeLow lt CDblmbSize 1024 Then GoTo Skipperd End If End If ReDim Preserve asFoun.