Date: 02-16-2022
Return to Index
created by gbSnippets
'... this snippet is in work
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "commctrl.inc"
Declare Function PATHMATCHSPEC Lib "SHLWAPI.DLL" Alias "PathMatchSpecA" ( pszFile As Asciiz, pszSpec As Asciiz ) As Long
Global hDlg,hFolderList,hFileList As Dword, Folders(), Files() As DirData
Global qFreq, qStart, qStop As Quad, FolderCount, FileCount As Long
%IDC_SearchBeene = 600
%IDC_SearchBleck = 601
%IDC_FolderList = 700
%IDC_FileList = 800
%IDC_StartPath = 900
%IDC_FileSpec = 901
Function PBMain() As Long
Local i As Long
Dialog New Pixels, 0, "Folder/File Demo",500,500,350,400, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_SearchBeene,"Get Folders/Files Beene", 10,10,150,20
Control Add Button, hDlg, %IDC_SearchBleck,"Get Folders/Files Pierre", 170,10,150,20
Control Add TextBox, hDlg, %IDC_StartPath, "c:\temp",10,40,330,20
Control Add TextBox, hDlg, %IDC_FileSpec, "*.*",10,70,100,20
Control Add ListView, hDlg, %IDC_FileList,"",10,100,330,290, %WS_Child Or %WS_TabStop Or %WS_Visible Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData
Control Handle hDlg, %IDC_FileList To hFileList
ListView Insert Column hDlg, %IDC_FileList, 1, "Files", 400,0 'set headers
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i,row,col As Long, ParentFolder$, FileSpec$, pLVDI As LV_DispInfo Ptr, temp$, FileSpecZ As Asciiz * %Max_Path
Select Case Cb.Msg
Case %WM_InitDialog
QueryPerformanceFrequency qFreq
ReDim Folders(50000), Files(350000)
Case %WM_Notify
Select Case Cb.NmId
Case %IDC_FileList
Select Case Cb.NmCode
Case %LVN_GetDispInfo 'notification to ask for data
pLVDI = Cb.LParam 'pointer to LVDISPINFO structure for requested subitem
row = @pLVDI.item.iItem 'row being asked for
col = @pLVDI.item.iSubItem 'sub item being asked for (columns)
temp$ = Files(row+1).FileName 'next line won't take stringZ
@pLVDI.item.pszText = StrPtr(temp$) 'text sent to ListView
End Select
End Select
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_SearchBeene
'folders
Reset Folders(), Files()
ListBox Reset hDlg, %IDC_FolderList
ListBox Reset hDlg, %IDC_FileList
FolderCount = 0 : FileCount = 0
Control Get Text hDlg, %IDC_StartPath To ParentFolder$
Control Get Text hDlg, %IDC_FileSpec To FileSpec$
QueryPerformanceCounter qStart
'--------------------------------------------
FileSearchBeene ParentFolder$, FileSpec$
'--------------------------------------------
QueryPerformanceCounter qStop
ListView_SetItemCountEx(hFolderList, FolderCount, 0) 'max rows
ListView_SetItemCountEx(hFileList, FileCount, 0) 'max rows
Dialog Set Text hDlg, "Folders:" + Str$(FolderCount) + " Files:" + Str$(FileCount) + " " + Format$((qStop-qStart)/qFreq," 0.###") + " seconds"
Case %IDC_SearchBleck
'folders
Reset Folders(), Files()
ListBox Reset hDlg, %IDC_FolderList
ListBox Reset hDlg, %IDC_FileList
FolderCount = 0 : FileCount = 0
Control Get Text hDlg, %IDC_StartPath To ParentFolder$
ParentFolder$ = RTrim$( ParentFolder$, "\" ) + "\" 'must have \ at end
Control Get Text hDlg, %IDC_FileSpec To FileSpecZ
QueryPerformanceCounter qStart
'--------------------------------------------
FileSearchBleck ParentFolder$, FileSpecZ, Files()
'--------------------------------------------
QueryPerformanceCounter qStop
ListView_SetItemCountEx(hFolderList, FolderCount, 0) 'max rows
ListView_SetItemCountEx(hFileList, FileCount, 0) 'max rows
Dialog Set Text hDlg, "Folders:" + Str$(FolderCount) + " Files:" + Str$(FileCount) + " " + Format$((qStop-qStart)/qFreq," 0.###") + " seconds"
End Select
End Select
End Function
Sub FileSearchBeene (ParentFolder$, FileSpec$)
Local iPos As Long, tempDIR As DirData, temp$
Folders(iPos).FileName = ParentFolder$ 'no ending \
Do While Len(Folders(iPos).FileName)
temp$ = Dir$(Folders(iPos).FileName + "\*.*", %Normal + %Hidden + %System + %SubDir, To tempDir)
Do While Len(temp$)
tempDir.FileName = Folders(iPos).FileName + "\" + tempDir.FileName
If (tempDir.FileAttributes And %File_Attribute_Directory) = 0 Then 'files
If PathMatchSpec((tempDir.Filename), (FileSpec$)) Then
Incr FileCount : Files(FileCount) = tempDir
End If
Else 'folder
Incr FolderCount : Folders(FolderCount) = tempDir
End If
temp$ = Dir$(Next, To tempDir)
Loop
Incr iPos
Loop
End Sub
Function FileSearchBleck( ByVal strSearchRoot As String, ByRef aszWildcardMasks As Asciiz, ByRef udtW32FD( ) As DirData) As Long
Dim aszSubDirs( 50000 ) As Asciiz * %MAX_PATH
Local hFind As Dword, lngSubDirCount,lngValidFileIndex As Long
Local pwrdFileName1, pwrdFileName2 As Word Ptr, udtTempW32FD As DirData
pwrdFileName1 = VarPtr( udtTempW32FD.Filename )
pwrdFileName2 = pwrdFileName1 + 1
Do
hFind = FINDFIRSTFILE( strSearchRoot + "*", udtTempW32FD )
If hFind <> %INVALID_HANDLE_VALUE Then
Do
If ( udtTempW32FD.FileAttributes And %FILE_ATTRIBUTE_DIRECTORY ) = 0 Then
If PATHMATCHSPEC( udtTempW32FD.Filename, aszWildcardMasks ) Then
Incr FileCount
Incr lngValidFileIndex
udtW32FD( lngValidFileIndex ) = udtTempW32FD
udtW32FD( lngValidFileIndex ).FileName = strSearchRoot + udtTempW32FD.FileName
Iterate Do
End If
Else
If @pwrdFileName1 = 46 Or @pwrdFileName2 = 46 Then Iterate Do
Incr lngSubDirCount : Incr FolderCount
If lngSubDirCount > UBound( aszSubDirs ) Then ReDim Preserve aszSubDirs( lngSubDirCount + 1000 )
aszSubDirs( lngSubDirCount ) = strSearchRoot + udtTempW32FD.FileName + "\"
End If
Loop While FINDNEXTFILE( hFind, udtTempW32FD )
FINDCLOSE hFind
End If
If lngSubDirCount = 0 Then Exit Loop
strSearchRoot = aszSubDirs( lngSubDirCount )
Decr lngSubDirCount
Loop
Function = FileCount
End Function
'gbs_00982
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm