Results 1 to 30 of 30

Thread: 2 Great Functions

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172

    2 Great Functions

    I made 2 great functions called FoldersToProc and FilesToProc. They work like a system hook, and they call that proc with 2 parameters (Path and Finished). You can call them like this:

    FilesToProc:
    VB Code:
    1. FilesToProc frmMain, "FileProc", VbMethod, "C:\"
    Where frmMain is the object that holds the function, "FileProc" is the name of your function, VbMethod is the call type, and "C:\" is the base path of where to get the path of every file in and in all subdirectories.

    Requirements for FileProc or whatever name you want:
    VB Code:
    1. Public Function FileProc(ByVal Path As String, ByVal Finished As Boolean) As Boolean
    2.     If Not Finished Then
    3.         'Do what you want with Path here
    4.         FileProc = True 'Continue receiving file paths
    5.     Else
    6.         'All file paths have been received, and
    7.         'Path does not include a file path.
    8.     End If
    9. End Function

    (Continued in next post)...
    Last edited by xjake88x; Aug 25th, 2004 at 03:36 PM.

  2. #2

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    FoldersToProc:
    VB Code:
    1. FoldersToProc frmMain, "FolderProc", VbMethod, "C:\"
    Where frmMain is the object that holds the function, "FolderProc" is the name of your function, VbMethod is the call type, and "C:\" is the base path of where to get the path of every subdirectory and their subdirectories etc.

    Requirements for FolderProc or whatever name you want:
    VB Code:
    1. Public Function FolderProc(ByVal Path As String, ByVal Finished As Boolean) As Boolean
    2.     If Not Finished Then
    3.         'Do what you want with Path here
    4.         FileProc = True 'Continue receiving folder paths
    5.     Else
    6.         'All folder paths have been received, and
    7.         'Path does not include a folder path.
    8.     End If
    9. End Function

    (Continued in next post)...

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    The Code!

    Put this in a module in your project and you can use the functions:
    VB Code:
    1. Option Explicit
    2.  
    3. 'Module-Level FileSystem Declare
    4. Dim FS As Object
    5.  
    6. Public Sub FoldersToProc(ByVal ProcObject As Object, ByVal ProcName As String, ByVal ProcCallType As VbCallType, ByVal lpPath As String)
    7.     FoldersToProc2 ProcObject, ProcName, ProcCallType, lpPath, True
    8. End Sub
    9.  
    10. Private Sub FoldersToProc2(ByVal ProcObject As Object, ByVal ProcName As String, ByVal ProcCallType As VbCallType, ByVal lpPath As String, Optional TopLevel As Boolean = False)
    11.     If ProcAbort Then Exit Sub
    12.     Dim PathObject As Object, SubFoldersObject As Object, SubFolder As Object
    13.     Set FS = CreateObject("Scripting.FileSystemObject")
    14.     Set PathObject = FS.GetFolder(lpPath)
    15.     Set SubFoldersObject = PathObject.SubFolders
    16.     For Each SubFolder In SubFoldersObject
    17.         If CallByName(ProcObject, ProcName, ProcCallType, SubFolder, False) = Fals Then Exit Sub
    18.         FoldersToProc2 ProcObject, ProcName, ProcCallType, SubFolder
    19.     Next SubFolder
    20.     DoEvents
    21.     If TopLevel Then CallByName ProcObject, ProcName, ProcCallType, vbNullString, True
    22. End Sub
    23.  
    24. Public Sub FilesToProc(ByVal ProcObject As Object, ByVal ProcName As String, ByVal ProcCallType As VbCallType, ByVal lpPath As String)
    25.     FilesToProc2 ProcObject, ProcName, ProcCallType, lpPath, True
    26. End Sub
    27.  
    28. Private Sub FilesToProc2(ByVal ProcObject As Object, ByVal ProcName As String, ByVal ProcCallType As VbCallType, ByVal lpPath As String, Optional TopLevel As Boolean = False)
    29.     Dim PathObject As Object, SubFoldersObject As Object, SubFolder As Object, SubFile As Object, SubFilesObject As Object
    30.     Set FS = CreateObject("Scripting.FileSystemObject")
    31.     Set PathObject = FS.GetFolder(lpPath)
    32.     Set SubFoldersObject = PathObject.SubFolders
    33.     For Each SubFolder In SubFoldersObject
    34.         FilesToProc2 ProcObject, ProcName, ProcCallType, SubFolder
    35.     Next SubFolder
    36.    
    37.     Set SubFilesObject = PathObject.Files
    38.     For Each SubFile In SubFilesObject
    39.         If CallByName(ProcObject, ProcName, ProcCallType, SubFile, False) = False Then Exit Sub
    40.     Next SubFile
    41.    
    42.     DoEvents
    43.     If TopLevel Then CallByName ProcObject, ProcName, ProcCallType, vbNullString, True
    44. End Sub

    Sorry that it's not commented, I'll comment it and edit the post later!

  4. #4
    PowerPoster RhinoBull's Avatar
    Join Date
    Mar 2004
    Location
    New Amsterdam
    Posts
    24,132
    You should be posting your samples in the Code Bank instead.

  5. #5
    PowerPoster Dave Sell's Avatar
    Join Date
    Mar 2004
    Location
    /dev/null
    Posts
    2,961
    Either that or put it in the CODE IT BETTER forum on this site. And um, the 564-sized font is not necessary.

  6. #6

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    1. Theres no "Code Bank" in the Visual Basic section.
    2. Its size 18 and I didn't know that these forums suck and make it bigger than font size 18.

  7. #7

  8. #8

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    Except for the small fact that I'm not asking anybody how to code it better, since it's fine how it is.

  9. #9
    Fanatic Member
    Join Date
    Dec 2003
    Posts
    703
    FileSystemObject and CallByName aren't optimal to be honest. Defining an interface that you call back to would be better than CallByName, and the FSO isn't as good as the Win32 API calls proper.
    an ending

  10. #10

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    What do you mean an interface that you call back to? Also can you use APIs instead of CallByName? They'd most likely use AddressOf...

  11. #11
    Fanatic Member
    Join Date
    Dec 2003
    Posts
    703
    Not APIs instead of CallByName, APIs instead of FileSystemObject.
    I mean, in a class module define an interface then that has a FileProc and a FolderProc function, then implement that interface in the caller.

    Then add the code to the function to call the appropriate functions on the object that implements the interface you pass in.
    an ending

  12. #12
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632
    True, but the API does get a little messy. But it's worth it if you want it to run **** fast
    Don't like the CallByName though, however, I feel that this may be the smaller contributer to the speed.

    Why not use that code in a class, that have the class raise events?

    Woka

  13. #13
    Fanatic Member
    Join Date
    Dec 2002
    Location
    North Carolina
    Posts
    734
    Someone should test the speed decrease you get when you wrap it in a class... from what I hear VB sucks pretty bad with that.

  14. #14

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    I know you weren't talking about CallByName but do you know of any API's that replace it or something? I've been wondering about that for a while.

  15. #15
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,431
    Originally posted by xjake88x
    Except for the small fact that I'm not asking anybody how to code it better, since it's fine how it is.
    The Code Bank is for finished code samples such as yours. The Code It Better forum is the place to put code that you would like improved.

  16. #16
    Fanatic Member
    Join Date
    Dec 2002
    Location
    North Carolina
    Posts
    734
    VB Code:
    1. 'Create a form with a command button (command1), a list box (list1)
    2. 'and four text boxes (text1, text2, text3 and text4).
    3. 'Type in the first textbox a startingpath like c:\
    4. 'and in the second textbox you put a pattern like *.* or *.txt
    5.  
    6. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    7. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    8. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    9. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    10.  
    11. Const MAX_PATH = 260
    12. Const MAXDWORD = &HFFFF
    13. Const INVALID_HANDLE_VALUE = -1
    14. Const FILE_ATTRIBUTE_ARCHIVE = &H20
    15. Const FILE_ATTRIBUTE_DIRECTORY = &H10
    16. Const FILE_ATTRIBUTE_HIDDEN = &H2
    17. Const FILE_ATTRIBUTE_NORMAL = &H80
    18. Const FILE_ATTRIBUTE_READONLY = &H1
    19. Const FILE_ATTRIBUTE_SYSTEM = &H4
    20. Const FILE_ATTRIBUTE_TEMPORARY = &H100
    21.  
    22. Private Type FILETIME
    23.     dwLowDateTime As Long
    24.     dwHighDateTime As Long
    25. End Type
    26.  
    27. Private Type WIN32_FIND_DATA
    28.     dwFileAttributes As Long
    29.     ftCreationTime As FILETIME
    30.     ftLastAccessTime As FILETIME
    31.     ftLastWriteTime As FILETIME
    32.     nFileSizeHigh As Long
    33.     nFileSizeLow As Long
    34.     dwReserved0 As Long
    35.     dwReserved1 As Long
    36.     cFileName As String * MAX_PATH
    37.     cAlternate As String * 14
    38. End Type
    39. Function StripNulls(OriginalStr As String) As String
    40.     If (InStr(OriginalStr, Chr(0)) > 0) Then
    41.         OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    42.     End If
    43.     StripNulls = OriginalStr
    44. End Function
    45.  
    46. Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    47.     'KPD-Team 1999
    48.     'E-Mail: [email][email protected][/email]
    49.     'URL: [url]http://www.allapi.net/[/url]
    50.  
    51.     Dim FileName As String ' Walking filename variable...
    52.     Dim DirName As String ' SubDirectory Name
    53.     Dim dirNames() As String ' Buffer for directory name entries
    54.     Dim nDir As Integer ' Number of directories in this path
    55.     Dim i As Integer ' For-loop counter...
    56.     Dim hSearch As Long ' Search Handle
    57.     Dim WFD As WIN32_FIND_DATA
    58.     Dim Cont As Integer
    59.     If Right(path, 1) <> "\" Then path = path & "\"
    60.     ' Search for subdirectories.
    61.     nDir = 0
    62.     ReDim dirNames(nDir)
    63.     Cont = True
    64.     hSearch = FindFirstFile(path & "*", WFD)
    65.     If hSearch <> INVALID_HANDLE_VALUE Then
    66.         Do While Cont
    67.         DirName = StripNulls(WFD.cFileName)
    68.         ' Ignore the current and encompassing directories.
    69.         If (DirName <> ".") And (DirName <> "..") Then
    70.             ' Check for directory with bitwise comparison.
    71.             If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
    72.                 dirNames(nDir) = DirName
    73.                 DirCount = DirCount + 1
    74.                 nDir = nDir + 1
    75.                 ReDim Preserve dirNames(nDir)
    76.             End If
    77.         End If
    78.         Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
    79.         Loop
    80.         Cont = FindClose(hSearch)
    81.     End If
    82.     ' Walk through this directory and sum file sizes.
    83.     hSearch = FindFirstFile(path & SearchStr, WFD)
    84.     Cont = True
    85.     If hSearch <> INVALID_HANDLE_VALUE Then
    86.         While Cont
    87.             FileName = StripNulls(WFD.cFileName)
    88.             If (FileName <> ".") And (FileName <> "..") Then
    89.                 FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
    90.                 FileCount = FileCount + 1
    91.                 List1.AddItem path & FileName
    92.             End If
    93.             Cont = FindNextFile(hSearch, WFD) ' Get next file
    94.         Wend
    95.         Cont = FindClose(hSearch)
    96.     End If
    97.     ' If there are sub-directories...
    98.     If nDir > 0 Then
    99.         ' Recursively walk into them...
    100.         For i = 0 To nDir - 1
    101.             FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
    102.         Next i
    103.     End If
    104. End Function
    105. Sub Command1_Click()
    106.     Dim SearchPath As String, FindStr As String
    107.     Dim FileSize As Long
    108.     Dim NumFiles As Integer, NumDirs As Integer
    109.     Screen.MousePointer = vbHourglass
    110.     List1.Clear
    111.     SearchPath = Text1.Text
    112.     FindStr = Text2.Text
    113.     FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    114.     Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    115.     Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    116.     Screen.MousePointer = vbDefault
    117. End Sub

  17. #17

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    I'm still wondering an API equivilent to CallByName.

  18. #18
    Fanatic Member
    Join Date
    Dec 2002
    Location
    North Carolina
    Posts
    734
    Oh a replacement for CallByName... nah I don't think there are any API functions to replace that, I think it is just a VB specific function.

  19. #19

    Thread Starter
    Addicted Member
    Join Date
    Jun 2004
    Location
    USA
    Posts
    172
    Well how else besides callbyname can I make it so they specify a function that is called. There has to be a way, how else would they have made the callbyname function?

  20. #20
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632
    I like the API code nice.
    Creating a file searching class now.

    One thing I am doing is optamising the code. If you change the StripNulls function to:
    VB Code:
    1. Private Function StripNulls(ByRef pstrString As String) As String
    2. Dim lngPos  As Long
    3.     lngPos = InStr(pstrString, vbNullChar)
    4.     If lngPos > 0 Then
    5.         StripNulls = Left(pstrString, lngPos - 1)
    6.     Else
    7.         StripNulls = pstrString
    8.     End If
    9. End Function
    Then this has speeded it up by something like 5%-8%
    Sure there is more I can do.

    Woof

  21. #21
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632
    Right, I have tidied the code up a little.

    It's speeded it up a little.

    Am now going to place in a class to see how that compares.

    Once thing. Why is that code counting folders as files?

    Woka
    Attached Files Attached Files

  22. #22
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632
    Here's the same thing, but tidied up into a neat class module.
    Add a class slows the search down a little, but it's hardly noticable in my bench testing. 20ms or so.

    Woof
    Attached Files Attached Files

  23. #23
    Fanatic Member
    Join Date
    Dec 2003
    Posts
    703
    Cos the bottleneck is the disk. Moving those platters is sloooow.
    an ending

  24. #24
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654
    *whistles innocently*

    VB Code:
    1. Private Function StripNulls(ByRef pstrString As String) As String
    2.     Dim lngPos  As Long
    3.     lngPos = InStr(pstrString, vbNullChar)
    4.     If lngPos <> 0 Then
    5.         StripNulls = Left$(pstrString, lngPos - 1)
    6.     Else
    7.         StripNulls = pstrString
    8.     End If
    9. End Function

    And another speed gain of few percents

  25. #25
    Super Moderator Wokawidget's Avatar
    Join Date
    Nov 2001
    Location
    Headingly Occupation: Classified
    Posts
    9,632
    That's what I posted above...Although you have a <>, why?
    lngPos will never be less than 0, and if it is then you want to return the passed in string so no need to check for < 0.
    Also, $, yea I forgot
    Good addition.

    Woof

  26. #26
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654
    How likely you think -1 will come, knowing that strings you give there are never null? And yes, <> is faster than >

  27. #27

  28. #28
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654
    Actually, I'm relying on two articles I've read about this. I guess I could benchmark those now as I'm tired enough to not be able to do anything wise

  29. #29
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654
    Ok, you shouldn't rely on the skills of article writers: found out this to be untrue, when you turn on all of the advanced optimizations. If you don't turn the optimizations on, then there is some small disadvantage in using > than <>. But... who compiles his programs without the optimizations anyways?

    Not gives interesting results. This was the code I used:

    VB Code:
    1. If Not (Something = 0) Then
    2.    End If

    When Something was 1, it was generally the fastest. But when Something was 0, it was the slowest. Really really wondering the reason for this.

    Anyways, we're talking about really small differences in speed here. If you turn all optimizations on, then it doesn't matter what you use, it is all just about equally fast and you get more varying in speed because of Windows' processes

  30. #30
    Hyperactive Member Vishalgiri's Avatar
    Join Date
    Oct 2003
    Location
    India
    Posts
    345
    sorry but what's great in these two functions!
    Regards,
    Vishalgiri Goswami
    Gujarat, ( INDIA ).
    ---------------------

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