Results 1 to 2 of 2

Thread: can someone help rewrite this?...

  1. #1

    Thread Starter
    Addicted Member thekurbster's Avatar
    Join Date
    Mar 2006
    Posts
    173

    can someone help rewrite this?...

    can someone try to rewrite this class to find *.jpg;*.jpeg;*.gif;*.bmp,

    VB Code:
    1. Option Explicit
    2.  
    3. Event ChangeDir(Path As String)
    4. Private Type FILETIME
    5.   dwLowDateTime As Long
    6.   dwHighDateTime As Long
    7. End Type
    8. Private Type WIN32_FIND_DATA
    9.   dwFileAttributes As Long
    10.   ftCreationTime As FILETIME
    11.   ftLastAccessTime As FILETIME
    12.   ftLastWriteTime As FILETIME
    13.   nFileSizeHigh As Long
    14.   nFileSizeLow As Long
    15.   dwReserved0 As Long
    16.   dwReserved1 As Long
    17.   cFileName As String * 260
    18.   cAlternate As String * 14
    19. End Type
    20. Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    21. Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    22. Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
    23. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    24. Private Files() As String
    25.  
    26. Private Sub FindFiles(Path As String, Mask As String)
    27.   Dim FindInfo As WIN32_FIND_DATA
    28.   Dim TmpFile As String
    29.   Dim Handler As Long, Result As Long
    30.  
    31.   If Right(Path, 1) <> "\" Then Path = Path + "\"
    32.   Handler = FindFirstFile(Path + Mask, FindInfo) 'Get the first file
    33.   If Handler = -1 Then Exit Sub 'If there is no file, just exit sub
    34.   RaiseEvent ChangeDir(Path)
    35.   DoEvents 'Without this, the event is useless
    36.   Do
    37.     TmpFile = Left(FindInfo.cFileName, InStr(FindInfo.cFileName, vbNullChar) - 1) 'Truncate all the null chars at the end of the string
    38.     If (GetFileAttributes(Path + TmpFile) And vbDirectory) <> vbDirectory Then 'If the filename is not a directory...
    39.       ReDim Preserve Files(UBound(Files) + 1) '...allocate a new item in the array
    40.       Files(UBound(Files)) = Path + TmpFile
    41.     End If
    42.     Result = FindNextFile(Handler, FindInfo) 'Get the next file
    43.   Loop Until Result = 0 'Loop until there are no more files
    44.   FindClose Handler 'We don't want to waste useful memory in this crap, right?
    45. End Sub
    46.  
    47. Private Sub FindDirectories(Path As String, Mask As String)
    48.   Dim FindInfo As WIN32_FIND_DATA
    49.   Dim TmpFile As String
    50.   Dim Handler As Long, Result As Long
    51.  
    52.   If Right(Path, 1) <> "\" Then Path = Path + "\"
    53.   FindFiles Path, Mask
    54.   Handler = FindFirstFile(Path + "*.*", FindInfo) 'Get the first subdirectory
    55.   If Handler = -1 Then Exit Sub 'No subdirectories? Damn!!
    56.   RaiseEvent ChangeDir(Path)
    57.   DoEvents
    58.   Do
    59.     TmpFile = Left(FindInfo.cFileName, InStr(FindInfo.cFileName, vbNullChar) - 1)  'Truncate all the nulls chars at the end of the string
    60.     If TmpFile <> "." And TmpFile <> ".." Then If (GetFileAttributes(Path + TmpFile) And vbDirectory) = vbDirectory Then FindDirectories Path + TmpFile, Mask 'Let's make sure that it's really a directory. If so, we called again the FindDirectory sub
    61.     Result = FindNextFile(Handler, FindInfo) 'Find files in this subdirectory
    62.   Loop Until Result = 0 'Loop until no more subdirectories are found
    63.   FindClose Handler
    64. End Sub
    65.  
    66. Public Function Search(Path As String, Mask As String) As Variant
    67.   On Error Resume Next
    68.   Dim FindInfo As WIN32_FIND_DATA
    69.   Dim TmpFile As String
    70.   Dim Handler As Long, Result As Long
    71.  
    72.   ReDim Files(0) 'Allocate the files array
    73.   If Right(Path, 1) <> "\" Then Path = Path + "\"
    74.   FindFiles Path, Mask 'Find files in the main directory
    75.   Handler = FindFirstFile(Path + "*.*", FindInfo) 'Are there some other things in the directory?
    76.   If Handler <> -1 Then 'Yeah, It seems so
    77.     Do
    78.       TmpFile = Left(FindInfo.cFileName, InStr(FindInfo.cFileName, vbNullChar) - 1)
    79.       If TmpFile <> "." And TmpFile <> ".." Then If (GetAttr(Path + TmpFile) And vbDirectory) = vbDirectory Then FindDirectories Path + TmpFile, Mask 'If it's not a subdirectory, just ignore it
    80.       Result = FindNextFile(Handler, FindInfo) 'No explanation needed
    81.     Loop Until Result = 0 'Blah blah blah...
    82.   End If
    83.   FindClose Handler
    84.   Files(0) = UBound(Files) 'How many files we found??
    85.   Search = Files 'If we don't return the array, what do we call the function for?
    86.   Erase Files 'I don't know if the allocated space is deallocated automatically or not, but VB is tricky so we deallocate it manually...we just lose some milliseconds in the process
    87. End Function

    i tried but no success, i keep getting errors
    here's the command im using it with

    VB Code:
    1. Set FindIt = New Class1
    2.     ret = FindIt.Search(File1.Path, "*.jpg*")

    i tried changing "*.jpg*" to "*.jpg;*.jpeg;*.gif;*.bmp" but it didn't find it.
    please someone anyone

  2. #2
    Frenzied Member cssriraman's Avatar
    Join Date
    Jun 2005
    Posts
    1,465

    Re: can someone help rewrite this?...

    Use th following subroutines to find files:
    VB Code:
    1. sub Testing()
    2. Dim Files() As String, i As Long
    3. ' All files in C:\WINDOWS\SYSTEM directory, including system/hidden ones.
    4. Files() = GetFiles("C:\windows\system\*.*", vbNormal + vbHidden _
    5.     + vbSystem)
    6. Print "Found " & UBound(Files) & " files."
    7. For i = 1 To UBound(Files)
    8.     Combo1.AddItem Files(i)
    9. Next
    10. end sub
    11.  
    12. Function GetFiles(filespec As String, Optional Attributes As _
    13.     VbFileAttribute) As String()
    14.     Dim result() As String
    15.     Dim filename As String, count As Long, path2 As String
    16.     Const ALLOC_CHUNK = 50
    17.     ReDim result(0 To ALLOC_CHUNK) As String
    18.     filename = Dir$(filespec, Attributes)
    19.     Do While Len(filename)
    20.         count = count + 1
    21.         If count > UBound(result) Then
    22.             ' Resize the result array if necessary.
    23.             ReDim Preserve result(0 To count + ALLOC_CHUNK) As String
    24.         End If
    25.         result(count) = filename
    26.         ' Get ready for the next iteration.
    27.         filename = Dir$
    28.     Loop
    29.     ' Trim the result array.
    30.     ReDim Preserve result(0 To count) As String
    31.     GetFiles = result
    32. End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width