File/Folder Search Test - Virtual ListView

Category: Controls - ListView

Date: 03-28-2012

Return to Index


 
'... this snippet is in work
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
 
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$(NextTo 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$ (NextTo 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$(NextTo 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


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