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
Declare Function PATHMATCHSPEC Lib "SHLWAPI.DLL" Alias "PathMatchSpecA" ( pszFile As Asciiz, pszSpec As Asciiz ) As Long
#Include "Win32API.inc"
#Include "commctrl.inc"
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_SearchPierre = 602
%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",100,300,750,390, %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 Bleck", 10,40,150,20
Control Add Button, hDlg, %IDC_SearchPierre,"Get Folders/Files Pierre", 10,70,150,20
' Control Add TextBox, hDlg, %IDC_StartPath, "c:\data\apps\powerbasic\apps_gbapps\gbsearch",10,40,400,20
Control Add TextBox, hDlg, %IDC_StartPath, "c:\data\apps",10,100,500,20
Control Add TextBox, hDlg, %IDC_FileSpec, "*.bas",520,100,200,20
Control Add ListView, hDlg, %IDC_FolderList,"",10,130,500,250, %WS_Child Or %WS_TabStop Or %WS_Visible Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData
Control Handle hDlg, %IDC_FolderList To hFolderList
ListView Insert Column hDlg, %IDC_FolderList, 1, "Folder", 1200,0 'set headers
Control Add ListView, hDlg, %IDC_FileList,"",520,130,220,250, %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(250000)
Case %WM_Notify
Select Case Cb.NmId
Case %IDC_FolderList
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$ = Folders(row).FileName 'next line won't take stringZ
@pLVDI.item.pszText = StrPtr(temp$) 'text sent to ListView
End Select
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
'--------------------------------------------
GetFilesAndFolders ParentFolder$, FileSpec$
' GetFolderList_Beene ParentFolder$
' GetFileList_Beene 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$
Control Get Text hDlg, %IDC_FileSpec To FileSpecZ
QueryPerformanceCounter qStart
'--------------------------------------------
FileSearchBleck ParentFolder$, FileSpecZ, Files(), %False
'--------------------------------------------
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_SearchPierre
'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 FileSpecZ
QueryPerformanceCounter qStart
'--------------------------------------------
FileEnum ParentFolder$, FileSpecZ
'--------------------------------------------
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 GetFilesAndFolders (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 + "\" + FileSpec$, %Normal + %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
Sub GetFolderList_Beene (ParentFolder$)
Local iPOS As Long, tempDIR As DirData, temp$
Folders(FolderCount).FileName = ParentFolder$
While Len(Folders(iPOS).FileName)
temp$ = Dir$(Folders(iPOS).FileName + "\*.*", Only %SubDir To tempDir) 'subfolders only
tempDir.FileName = ParentFolder$ + "\" + tempDir.FileName
While Len(temp$)
Incr FolderCount
Folders(FolderCount) = tempDir
Folders(FolderCount).FileName = Folders(iPos).FileName + "\" + temp$
temp$ = Dir$ (Next, To tempDir)
tempDir.FileName = ParentFolder$ + "\" + tempDir.FileName
Wend
Incr iPOS
Wend
End Sub
Sub GetFileList_Beene (FileSpec$)
Local i As Long, tempDir As DirData, temp$
For i = 0 To FolderCount
temp$ = Dir$(Folders(i).FileName + "\" + FileSpec$, To tempDir)
While Len(temp$)
Incr FileCount
Files(FileCount) = tempDir
Files(FileCount).FileName = Folders(i).FileName + "\" + Files(FileCount).FileName
temp$ = Dir$(Next, To tempDir)
Wend
Next i
End Sub
Function FileEnum( ParentFolder$, FileSpecZ As Asciiz) As Long
End Function
Function FileSearchBleck( ByVal strSearchRoot As String, BYREF aszWildcardMasks As AsciiZ, _
BYREF udtW32FD( ) AS DirData, OPTIONAL BYREF lngResetArray As Long ) As Long
'*==========================================================================================*
'| FileSearch |
'*==========================================================================================*
'| REQ IN strSearchRoot ASCIIZ Root directory to start the search |
'| REQ IN aszWildcardMasks ASCIIZ Semicolon or Comma delimited wildcard masks |
'| REQ IN OUT udtW32FD() WIN32_FIND_DATA Array that receives valid files |
'| OPT IN lngResetArray Long Optional Flag to persist data in udtW32FD() |
'| OUT Function Long Number of new items found |
'*==========================================================================================*
'| This non-recursive routine will allow you to a supply a starting directory with a set of *
'| wildcard masks and will return an array of WIN32_FIND_DATA structures with all matches *
'| found in any of the sub-directories. Wildcard matching is performed by the *
'| PATHMATCHSPEC API. The wildcard list must be delimited with semicolons. *
'| EX: "*.jpg; *.gif *.bmp" *
'| *
'| WIN32_FIND_DATA strutures are used in the return array to maintain more information then *
'| just The file name. Be aware that FINDFIRSTFILE/FINDLASTFILE do not return the full *
'| path to a file in the cFilename element.; to compensate, this routine will update that *
'| element to include the full path as well as the file name. *
'| *
'| Some parameters can be tuned for better efficiency, which includes... *
'| aszSubDirs() pre-size of 1000, aszSubDirs() resize of 1000, udtW32FD resize of 200000 *
'| *
'| The function return is the number of NEW items added to udtW32FD() and not the total *
'| total in the array. Use UBOUND-LBOUND+1 to get total items in udtW32FD(). *
'*==========================================================================================*
DIM aszSubDirs( 1000 ) As AsciiZ * %MAX_PATH
DIM hFind AS DWord
DIM lngNewFileCount As Long
DIM lngSubDirCount As Long
DIM lngValidFileIndex As Long
DIM lngWildcardMaskIndex As Long
DIM pwrdFileName1 AS WORD PTR
DIM pwrdFileName2 AS WORD PTR
DIM udtTempW32FD AS DirData
' We can allow the data in udtW32FD() to persist if we set lngResetArray=%FALSE
IF ISMISSING( lngResetArray ) OR lngResetArray = %TRUE THEN ERASE udtW32FD( )
lngValidFileIndex = UBOUND( udtW32FD )
pwrdFileName1 = VARPTR( udtTempW32FD.Filename )
pwrdFileName2 = pwrdFileName1 + 1
' Make sure root ends with "\"
strSearchRoot = RTRIM$( strSearchRoot, "\" ) + "\"
DO
' Get the first item in the directory
hFind = FINDFIRSTFILE( strSearchRoot + "*", udtTempW32FD )
' We do an IF instead of jumping to the DO so we can neatly close the open handle
IF hFind <> %INVALID_HANDLE_VALUE THEN
DO
' Check if it's a directory or a file
IF ( udtTempW32FD.FileAttributes AND %FILE_ATTRIBUTE_DIRECTORY ) = 0 THEN
' It's a file, check to see if it matches a mask in aszWildcardMasks
IF PATHMATCHSPEC( udtTempW32FD.Filename, aszWildcardMasks ) THEN
' It's a mask match, add it to a matched file array, size the array as needed in reasonable increments
INCR lngNewFileCount
INCR lngValidFileIndex
IF lngValidFileIndex > UBOUND( udtW32FD ) THEN REDIM PRESERVE udtW32FD( lngValidFileIndex + 200000 )
' When we copy the temp UDT to the matched file array make sure to include the full path
udtW32FD( lngValidFileIndex ) = udtTempW32FD
udtW32FD( lngValidFileIndex ).FileName = strSearchRoot + udtTempW32FD.FileName
' We got a match, no need to continue checking for more
ITERATE DO
END IF
ELSE
' It's a directory check for ".", ".." and if so then ignore
IF @pwrdFileName1 = 46 OR @pwrdFileName2 = 46 THEN ITERATE DO
' Add it to the end of the SubDirectory array, size the array as needed in reasonable increments
INCR lngSubDirCount
IF lngSubDirCount > UBOUND( aszSubDirs ) THEN REDIM PRESERVE aszSubDirs( lngSubDirCount + 1000 )
aszSubDirs( lngSubDirCount ) = strSearchRoot + udtTempW32FD.FileName + "\"
END IF
' Get the next entry or exit the loop if none found
LOOP WHILE FINDNEXTFILE( hFind, udtTempW32FD )
' Close the open handle
FINDCLOSE hFind
END IF
'If we have no more SubDirectories to search then exit the loop
IF lngSubDirCount = 0 THEN EXIT LOOP
' Set the Search Root for the next loop to the last SubDirectory in the array, make sure to decrease the SubDirectory count
strSearchRoot = aszSubDirs( lngSubDirCount )
DECR lngSubDirCount
LOOP
' If we added some new files to the array "right size" it and remove the extra space used for growth
IF lngNewFileCount THEN REDIM PRESERVE udtW32FD( lngValidFileIndex )
' Report the number of matches found during this search (NOT necessarily the total number in the array), use UBOUND-LBOUND+1 for that.
Function = lngNewFileCount
End Function
'gbs_00981
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm