home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1178711172000.psc / ModDirAndFileSearch.bas < prev    next >
Encoding:
BASIC Source File  |  2000-11-18  |  6.2 KB  |  191 lines
  1. Attribute VB_Name = "ModDirAndFileSearch"
  2. '# ---------------------------------------------------
  3. '# DIRECTORY AND FILE SEARCH UTILITY
  4. '#
  5. '# Version 1.2 (BUGFIX VERSION)
  6. '# ---------------------------------------------------
  7. '# DESCRIPTION:
  8. '#
  9. '# search directories, sub-directories and files without
  10. '# having any object on your form.
  11. '# ---------------------------------------------------
  12. '# WHATS NEW:
  13. '#
  14. '# add: size, datetime, attribute.
  15. '# add: sub getsubfiles.
  16. '# fix: duplicated search results will not add again.
  17. '# fix: add a correct char on the right of the string.
  18. '# ---------------------------------------------------
  19. '# CODED BY:
  20. '#
  21. '# MAGiC MANiAC^mTo, ( mto@kabelfoon.nl )
  22. '#
  23. '# MORTAL OBSESSiON:
  24. '# http://home.kabelfoon.nl/~mto
  25. '# ---------------------------------------------------
  26. '# RELEASED 17-NOV-2000 ON:
  27. '#
  28. '# www.planet-source-code.com
  29. '# ---------------------------------------------------
  30.  
  31. Option Explicit
  32.  
  33. Public Type tSearch
  34.   Count As Long
  35.   Path As New Collection
  36.   Size As New Collection
  37.   DateTime As New Collection
  38.   Attr As New Collection
  39. End Type
  40.  
  41. '# Get Directories In Directories...
  42. '#
  43. '# sDir = "c:\windows" or sDir = "c:\windows;c:\windows\system"
  44. '# DirAttr = vbDirectory or DirAttr = vbDirectory + vbHidden
  45. '# cCol = Your tSearch
  46. Public Sub GetDirs(ByVal sDir As String, DirAttr As VbFileAttribute, cCol As tSearch)
  47.   Dim lTmp1 As Long
  48.   Dim sStr1 As String
  49.   Dim sStr2 As String
  50.   Dim sResult() As String
  51.   sStr2 = ""
  52.   For lTmp1 = 0 To sSplit(sDir, "", sResult)
  53.     sResult(lTmp1) = Trim$(sResult(lTmp1))
  54.     If Right$(sResult(lTmp1), 1) <> "\" Then
  55.       sResult(lTmp1) = sResult(lTmp1) + "\"
  56.     End If
  57.     If InStr(sStr2, UCase$(sResult(lTmp1)) + ";") < 1 Then
  58.       sStr2 = sStr2 + UCase$(sResult(lTmp1)) + ";"
  59.       sStr1 = Dir$(sResult(lTmp1) + "*.*", DirAttr)
  60.       While sStr1 <> ""
  61.         DoEvents
  62.         If sStr1 <> "." And sStr1 <> ".." Then
  63.           If (GetAttr(sResult(lTmp1) + sStr1) And vbDirectory) = vbDirectory Then
  64.             cCol.Path.Add sResult(lTmp1) + sStr1
  65.             cCol.Size.Add 0
  66.             cCol.DateTime.Add FileDateTime(sResult(lTmp1) + sStr1)
  67.             cCol.Attr.Add GetAttr(sResult(lTmp1) + sStr1)
  68.           End If
  69.         End If
  70.         sStr1 = Dir
  71.       Wend
  72.     End If
  73.   Next
  74.   cCol.Count = cCol.Path.Count
  75. End Sub
  76.  
  77. '# Get Sub-Directories In Directories...
  78. '#
  79. '# sDir = "c:\windows" or sDir = "c:\windows;c:\windows\system;ect..."
  80. '# DirAttr = vbDirectory or DirAttr = vbDirectory + vbHidden
  81. '# cCol = Your tSearch
  82. Public Sub GetSubDirs(ByVal sDir As String, DirAttr As VbFileAttribute, cCol As tSearch)
  83.   Dim lTmp1 As Long
  84.   Dim cCol1 As tSearch
  85.   GetDirs sDir, DirAttr, cCol1
  86.   For lTmp1 = 1 To cCol1.Count
  87.     cCol.Path.Add cCol1.Path(lTmp1)
  88.     cCol.Size.Add 0
  89.     cCol.DateTime.Add cCol1.DateTime(lTmp1)
  90.     cCol.Attr.Add cCol1.Attr(lTmp1)
  91.     GetSubDirs cCol1.Path(lTmp1), DirAttr, cCol
  92.   Next
  93.   cCol.Count = cCol.Path.Count
  94. End Sub
  95.  
  96. '# Get Files In Directories...
  97. '#
  98. '# sDir = "c:\windows" or sDir = "c:\window;c:\windows\system;ect..."
  99. '# sFilter = "*.*" or sFilter = "*.bat;*.com;*.exe;ect..."
  100. '# FileAttr = vbArchive or FileAttr = vbArchive + vbHidden
  101. '# cCol = Your tSearch
  102. Public Sub GetFiles(sDir As String, sFilter As String, FileAttr As VbFileAttribute, cCol As tSearch)
  103.   Dim lTmp1 As Long
  104.   Dim lTmp2 As Long
  105.   Dim lTmp3 As Long
  106.   Dim sStr1 As String
  107.   Dim sStr2 As String
  108.   Dim sStr3 As String
  109.   Dim sResult1() As String
  110.   Dim sResult2() As String
  111.   sStr2 = ""
  112.   For lTmp1 = 0 To sSplit(sDir, "", sResult1)
  113.     sResult1(lTmp1) = Trim$(sResult1(lTmp1))
  114.     If Right$(sResult1(lTmp1), 1) <> "\" Then
  115.       sResult1(lTmp1) = sResult1(lTmp1) + "\"
  116.     End If
  117.     If InStr(sStr2, UCase$(sResult1(lTmp1)) + ";") < 1 Then
  118.       sStr2 = sStr2 + UCase$(sResult1(lTmp1)) + ";"
  119.       sStr3 = ""
  120.       For lTmp2 = 0 To sSplit(sFilter, "", sResult2)
  121.         sResult2(lTmp2) = Trim$(sResult2(lTmp2))
  122.         If InStr(sStr3, UCase$(sResult2(lTmp2)) + ";") < 1 Then
  123.           sStr3 = sStr3 + UCase$(sResult2(lTmp2)) + ";"
  124.           sStr1 = Dir$(sResult1(lTmp1) + sResult2(lTmp2), FileAttr)
  125.           DoEvents
  126.           While sStr1 <> ""
  127.             cCol.Path.Add sResult1(lTmp1) + sStr1
  128.             cCol.Size.Add FileLen(sResult1(lTmp1) + sStr1)
  129.             cCol.DateTime.Add FileDateTime(sResult1(lTmp1) + sStr1)
  130.             cCol.Attr.Add GetAttr(sResult1(lTmp1) + sStr1)
  131.             sStr1 = Dir
  132.           Wend
  133.         End If
  134.       Next
  135.     End If
  136.   Next
  137.   cCol.Count = cCol.Path.Count
  138. End Sub
  139.  
  140. '# Get Sub-Files In Directories...
  141. '#
  142. '# sDir = "c:\windows" or sDir = "c:\window;c:\windows\system;ect..."
  143. '# sFilter = "*.*" or sFilter = "*.bat;*.com;*.exe;ect..."
  144. '# DirAttr = vbDirectory or DirAttr = vbDirectory + vbHidden
  145. '# FileAttr = vbArchive or FileAttr = vbArchive + vbHidden
  146. '# cCol = Your tSearch
  147. Public Sub GetSubFiles(sDir As String, sFilter As String, DirAttr As VbFileAttribute, FileAttr As VbFileAttribute, cCol As tSearch)
  148.   Dim lTmp1 As Long
  149.   Dim sStr1 As String
  150.   Dim cCol1 As tSearch
  151.   GetSubDirs sDir, DirAttr, cCol1
  152.   sStr1 = ""
  153.   For lTmp1 = 1 To cCol1.Count
  154.     sStr1 = sStr1 + cCol1.Path(lTmp1) + ";"
  155.   Next
  156.   GetFiles sStr1, sFilter, FileAttr, cCol
  157.   cCol.Count = cCol.Path.Count
  158. End Sub
  159.  
  160. '# Split A String...
  161. '#
  162. '# sSplit = Total Strings...
  163. '# sStr1 = "c:\windows" or sStr1 = "c:\windows;c:\windows\system;ect..."
  164. '# sDelims = ";" or sDelims = ";" + chr$(0) + ect...
  165. '# sResult = Dim sResult() As String
  166. Private Function sSplit(ByVal sStr1 As String, sDelims As String, sResult() As String) As Long
  167.   Dim nResult As Long
  168.   Dim lTmp1 As Long
  169.   Dim lTmp2 As Long
  170.   If sDelims = "" Then
  171.     sDelims = ";" + Chr$(0) + Chr$(9) + Chr$(10) + Chr$(13)
  172.   End If
  173.   If InStr(1, Right$(sStr1, 1), sDelims, vbBinaryCompare) < 1 Then
  174.     sStr1 = sStr1 + Left$(sDelims, 1)
  175.   End If
  176.   nResult = -1
  177.   lTmp1 = 1
  178.   For lTmp2 = 1 To Len(sStr1)
  179.     If InStr(1, sDelims, Mid$(sStr1, lTmp2, 1), vbBinaryCompare) > 0 Then
  180.       nResult = nResult + 1
  181.       ReDim Preserve sResult(0 To nResult) As String
  182.       sResult(nResult) = Mid$(sStr1, lTmp1, lTmp2 - lTmp1)
  183.       lTmp1 = lTmp2 + 1
  184.     End If
  185.   Next
  186.   If lTmp1 < 3 Then
  187.     nResult = -1
  188.   End If
  189.   sSplit = nResult
  190. End Function
  191.