Test - DIR

Category: PowerBASIC

Date: 02-16-2022

Return to Index


'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
 
#Debug Error On
#Debug Display On
 
%Unicode = 1
#Include "Win32API.inc"
 
Declare Function EnumDirTreeA Lib "DbgHelp.dllAlias "EnumDirTree" _
(ByVal hProcess As DwordByRef RootPath As AsciiZByRef InputPathName As AsciiZ, _
 ByRef OutputPathBuffer As AsciiZByVal cb As DwordByVal DATA As DwordAs Long
 
Enum Equates Singular
   IDC_API = 500
   IDC_CMD
   IDC_Get
End Enum
 
Global hDlg As Dword, Files(), Folders() As DirData
Global FileCount, FolderCount, TargetCount As Long, TargetExt$
Global qFreq, qStart, qStop As Quad
 
 
Function PBMain() As Long
   Dialog New Pixels, 0, "FileCount ",300,300,250,100, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_CMD,"CMD", 50,10,80,20
   Control Add Button, hDlg, %IDC_API,"API", 50,40,80,20
   Control Add Button, hDlg, %IDC_Get,"Get", 50,70,80,20
   QueryPerformanceFrequency qFreq
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local i As Long
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_API
               APIGetFiles
            Case %IDC_CMD
               QueryPerformanceCounter   qStart
               CMDGetFiles
               QueryPerformanceCounter   qStop
               ? "Files: " + Format$(FileCount,"###,###,##0") + "  Time: " + Format$((qStop-qStart)/qFreq,"###.0") & " seconds"
            Case %IDC_Get
               QueryPerformanceCounter   qStart
               GetFilesAndFolders("c:\data\gbapps")
               QueryPerformanceCounter   qStop
               ? "Files: " + Format$(FileCount,"###,###,##0") + "  Time: " + Format$((qStop-qStart)/qFreq,"###.0") & " seconds"
         End Select
   End Select
End Function
 
Sub GetFilesAndFolders (ParentFolder$)
   Local iPos As Long, tempDIR As DirData, temp$
   FolderCount = 0 : FileCount = 0
   ReDim Folders(5000), Files(50000)
   Folders(iPos).FileName = ParentFolder$     'no ending \
   Do While Len(Folders(iPos).FileName)
      temp$ = Dir$(Folders(iPos).FileName + "\*.*", %Normal + %SubDir, To tempDir)
      Do While Len(temp$)
         tempDir.FileName = Folders(iPos).FileName + "\" + tempDir.FileName  'add full path to filename
         If (tempDir.FileAttributes And %File_Attribute_Directory) = 0 Then  'files
            If InStr(tempDir.FileName,".bas") Then Incr FileCount
         Else                                                                'folder
            If FolderCount = UBound(Folders) Then ReDim Preserve Folders(FolderCount+5000)
            Incr FolderCount
            Folders(FolderCount) = tempDir
         End If
         temp$ = Dir$(NextTo tempDir)
      Loop
      Incr iPos
   Loop
End Sub
 
Sub CMDGetFiles
   Local i As Long, temp$
   Shell ("cmd /C dir c:\data\gbapps\*.bas  > xxx.txt /s", 0)
   Open "xxx.txtFor Binary As #1 : Get$ #1, Lof(1), temp$ : Close #1
   i = InStr(temp$, "Total File")
   i = InStr(i,temp$,$CrLf)
   temp$ = Mid$(temp$,i+2)
   FileCount = Val(temp$)
   Kill "xxx.txt"
End Sub
 
Sub APIGetFiles()
 Local FileCount As Dword
 Local Tick      As Dword
 Local sPath     As String
 Local sFileSpec As String
 Local sLog      As String
 
 Tick      = GetTickCount()
 sPath     = "c:\data\gbapps\"
 sFileSpec = "*.bas"
 
 EnumDirTreeA(0, (sPath), (sFileSpec), ByVal 0, CodePtr(EnumDirTreeCallBack), VarPtr(FileCount))
 
 sLog = "Path =         " & $Tab & sPath & $CrLf & _
        "FileSpec =     " & $Tab & sFileSpec & $CrLf & _
        "FileCount =    " & $Tab & Format$(FileCount) & $CrLf & _
        "Elapsed time = " & $Tab & Format$((GetTickCount - Tick) / 1000) & " second"
 MessageBox(%HWND_Desktop, (sLog), "AppName", %MB_Ok Or %MB_Topmost)
End Sub
 
Function EnumDirTreeCallBack(ByRef zFullPathFileName As AsciiZByVal pLong As Dword PointerAs Long
 Incr @pLong ': FUNCTION = %TRUE to stop enum
End Function
 
 


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm