Announcement

Collapse
No announcement yet.

Get All Procedures

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Get All Procedures

    The only reason I posted recently about syntax highlighting with a RichEdit was that I wanted not to use Scintilla in a small utility I'm trying to build - gbProcedures.

    I'm always remembering that I wrote a procedure but cannot remember where the procedure is. Also, I manage to use the same procedure name all over the place, but with differing content from one app to another.

    The ideal situation is that I'd keep all my functions in a library such as gbSnippets. But when you're modifying procedures on the fly, it's hard to take time out to record every variation of a procedure.

    I've written other apps to extract procedures from source code files, such as gbProcedureLibrary, but looking back at them they are more complex that I'd like. So, gbProcedures is another attempt to write a procedure-extraction utility. Hopefully this one will strike a chord with me.

    It's not ready for prime time, but I could use a few comments from anyone who might be interested in testing it.

    At the moment it does not have a nice toolbar interface - I just use buttons and checkboxes to get the job done.

    Descriptions of Buttons:
    Get Procedures - finds all files in the folder and extracts sub/functions
    Remove Dupes - removes dupe procedures
    ? - show statistics
    * -- displays all procedures, not just those found in a Search
    Search - search for procedures containing the SearchTerm
    Next - highlights next occurrence of SearchTerm in the currently displayed procedure
    Merge Folders - merge results of a Get Procedures command to the current procedure list
    ProcName Only - Search only procedure names for the SearchTerm

    gbProcedures saves content between sessions.

    I've done nothing to address speed. 30s to extract 50K procedures is my last benchmark. I don't use threads or sleep statements, so the app won't respond during a large extraction. My extraction code handles only Sub/Function/Callback Function procedures. That's all I was interested in right now. I've used much more capable extraction functions in other apps, where other procedure types were extracted, but I wanted to keep this simple.

    In my busiest folder, I extracted about 50K procedures, half of which were duplicates.

    Click image for larger version

Name:	pb_2147.jpg
Views:	26
Size:	70.5 KB
ID:	784900
    Here's the code ... uses Jose's include files.

    Code:
    'Compilable Example:
    #Compiler PBWin 10
    #Compile Exe "gbprocedures.exe"
    #Dim All
    
    #Debug Error On
    #Debug Display On
    
    %Unicode = 1
    #Include "Win32API.inc"
    
    #Resource Icon logo, "gbprocedure.ico"
    '#Resource Manifest, 1, "xpTheme.xml"
    
    $Ver = "1.4"
    $Delimiter = $CrLf + "+;;+;;;;+;;+" + $CrLf
    %FR_Up = 0
    
    Type ProcedureData
       ProcedureName As WStringZ * 100
       ProcedureType As WStringZ * 10
       ParentName As WStringZ * %Max_Path
       filedate As WStringZ * 20
       procsize As WStringZ * 20
       status As Long
       ptr As Long
    End Type
    
    Enum Equates Singular
       IDC_ListView = 500
       IDC_Get
       IDC_ClearAll
       IDC_ParentFolder
       IDC_RichEdit
       IDC_RemoveDupes
       IDC_BuildGBS
       IDC_StatusBar
       IDC_LabelA
       IDC_LabelB
       IDC_LabelC
       IDC_Search
       IDC_ShowAll
       IDC_SearchTerm
       IDC_ProcNameOnly
       IDC_EnableExcludeName
       IDC_ExcludeCallbacks
       IDC_ExcludeSubFolders
       IDC_MergeFolders
       IDC_ShowStats
       IDC_ShowNumber
       IDC_SelectFolder
       IDC_Next
       IDC_Prev
       IDC_IncludeEXT
       IDC_ExcludeName
       IDC_ApplySyntax
    
       IDM_Debug
       IDM_Backup
       IDM_Restore
       IDM_Append
       IDM_Cut
       IDM_Copy
       IDM_Paste
       IDM_Delete
       IDM_CopyAll
       IDM_Sep
       IDM_OpenPath
       IDM_SaveAs
       IDM_ShowClipboard
       IDM_RestoreRE
       IDM_SelectIDE
       IDM_OpenProcedureInIDE
       IDM_OpenClipboardInIDE
       IDM_ClearAll
       IDM_ResetDebug
       IDM_ResetComboBoxes
       IDM_ShowNumber
    
       IDM_FocusInclude
       IDM_FocusExclude
       IDM_FocusPath
       IDM_FocusSearch
       IDM_FocusRichEdit
    
    End Enum
    
    
    Global hDlg, hListView, hRichEdit, hCodeFont As Dword
    Global hDebug, OldREProc, hContextRE, pID As Dword
    
    Global hInclude, hExclude, hFolder, hSearch As Dword
    Global hIncludeEdit, hExcludeEdit, hFolderEdit, hSearchEdit As Dword
    
    Global Restart, MergedFolderCount, MergedFileCount As Long
    
    Global D() As ProcedureData, Procedures() As String, Debug As Long
    Global MaxLines, ProcedureCount, ProcNameOnly, ExcludeSubFolders, ApplySyntax As Long
    Global ExcludeCallbacks, MergeFolders, ShowNumber, EnableExcludeName  As Long
    Global qFreq, qStart, qStop As Quad, tempwZ, SearchTerm As WStringZ * 50
    Global Files(), Folders() As DirData, CurrentProcedure As Long
    Global FileCount, FolderCount As Long
    Global ParentFolder As WStringZ * %Max_Path
    Global CodeCase As Long, REContent$
    Global LWords(), UWords(), MWords() As String
    Global ValidWordCharacters As WStringZ * %Max_Path
    Global IncludeEXT, ExcludeName, IDEName As WStringZ * %Max_Path
    
    Global CDataParent(), CDataInclude(), CDataExclude(), CDataSearchTerm() As WStringZ * %Max_Path   'ParentFolder, Include, Exclude, SearchTerm
    
    Function PBMain() As Long
       Dialog Default Font "Tahoma", 12,1
       Dialog New Pixels, 0, "gbProcedures   v" + $Ver, , , 800,600, %WS_OverlappedWindow,, To hDlg
       Dialog Set Icon hDlg, "logo"
       AddControls
       Dialog Show Modal hDlg, Call DlgProc
       If Restart Then pID = Shell("gbprocedures.exe", 1)  'restart this app
    End Function
    
    Sub AddControls
       If Debug Then Txt.Print FuncName$
       Control Add Button, hDlg, %IDC_SelectFolder,"...", 10,10,25,25
       Control Add ComboBox, hDlg, %IDC_ParentFolder,, 40,10,300,150
       Control Handle hDlg, %IDC_ParentFolder To hFolder
    
       Control Add Button, hDlg, %IDC_Get,"Get Procedures", 350,10,130,25, %BS_Left
       Control Add Button, hDlg, %IDC_ClearAll, "Clr", 490,10,30,25
       Control Add Button, hDlg, %IDC_RemoveDupes,"Remove Dupes", 350,40, 130,25, %BS_Left
       Control Add Button, hDlg, %IDC_ShowStats,"Show Proc Stats", 350,70,130,25, %BS_Left
    
       Control Add Button, hDlg, %IDC_Search,"Search", 570,10,80,25, %BS_Left
       Control Add Button, hDlg, %IDC_ShowAll,"Show All", 570,40,80,25, %BS_Left
       Control Add CheckBox, hDlg, %IDC_ProcNameOnly,"ProcName Only", 665,40,140,25
       Control Add Button, hDlg, %IDC_Next,"Next", 820,40,50,25
       Control Add Button, hDlg, %IDC_Prev,"Prev", 880,40,50,25
    
       Control Add CheckBox, hDlg, %IDC_MergeFolders,"Merge Folders", 30,40,120,20
       Control Add CheckBox, hDlg, %IDC_ShowNumber,"Show #", 30,65,100,20
    
       Control Add CheckBox, hDlg, %IDC_ExcludeCallbacks,"Exclude Callbacks", 165,40,150,20
       Control Add CheckBox, hDlg, %IDC_ExcludeSubFolders,"Exclude SubFolders", 165,65,160,20
    
       Control Add Label, hDlg, %IDC_LabelA,"Include:", 20,90,75,20, %SS_Notify
       Control Add Label, hDlg, %IDC_LabelB,"Exclude:", 20,120,75,20, %SS_Notify
       Control Add CheckBox, hDlg, %IDC_EnableExcludeName,"",90,120,25,25, %SS_Notify
    
       Control Add ComboBox, hDlg, %IDC_IncludeEXT,, 90,90,250,150
       Control Handle hDlg, %IDC_IncludeEXT To hInclude
    
       Control Add ComboBox, hDlg, %IDC_ExcludeName,, 115,120,225,150
       Control Handle hDlg, %IDC_ExcludeName To hExclude
    
       Control Add ComboBox, hDlg, %IDC_SearchTerm,, 665,10, 90,150
       Control Handle hDlg, %IDC_SearchTerm To hSearch
    '   Control Add Button, hDlg, %IDC_BuildGBS,"Build GBS", 280,50,110,20
    
       Control Add ListView, hDlg, %IDC_ListView,"", 10,150,480,250, %WS_Child Or %WS_TabStop Or %WS_Visible Or %LVS_ShowSelAlways Or %LVS_Report Or %LVS_OwnerData Or %LVS_ShowSelAlways Or %LVS_SingleSel, %WS_Ex_ClientEdge
       Control Handle hDlg, %IDC_ListView To hListView                        'handle to ListView
       ListView Insert Column hDlg, %IDC_Listview, 1, "Procedure Name", 250,0  'set headers
       ListView Insert Column hDlg, %IDC_Listview, 2, "File Name", 200,0           'set headers
       ListView Insert Column hDlg, %IDC_Listview, 3, "Date", 120,2           'set headers
       ListView Insert Column hDlg, %IDC_Listview, 4, "Size", 125,2           'set headers
       ListView Insert Column hDlg, %IDC_Listview, 5, "Full Path", 800,0           'set headers
       ListView_SetItemCountEx(hListView, 10, %LVSICF_noInvalidateAll) 'max rows
       SendMessage (hListView, %WM_NOTIFYFORMAT, hDlg, %NF_REQUERY)
       ListView Set StyleXX hDlg, %IDC_ListView, %LVS_Ex_GridLines Or %LVS_Ex_FullRowSelect
    
       Control Add Label, hDlg, %IDC_LabelC,"Procedure:", 570,20,80,20, %SS_Notify
       Control Add CheckBox, hDlg, %IDC_ApplySyntax,"Syntax Highlighting",665,70,200,25, %SS_Notify
       Control Add Statusbar, hDlg, %IDC_StatusBar, "  Welcome to gbProcedures!", 0,0,0,0
    
    End Sub
    
    CallBack Function DlgProc
       Local w,h,i,iCol,iRow, pLVDI As LV_DISPINFOW Ptr, ptMenu As Point, temp$, tmp$, pNMLV As NMLISTVIEW Ptr
       Select Case Cb.Msg
          Case %WM_InitDialog
             If IsFalse IsFolder("backup") Then MkDir "backup"
             ManageDebug
             BuildAcceleratorTable
             CreateRichEdit
             CreateContextMenu
             GetEditBoxHandles
    
             ReDim CDataParent(1 To 5), CDataInclude(1 To 5)
             ReDim CDataExclude(1 To 5), CDataSearchTerm(1 To 5)
    
             Settings_INI "get"
    
             Control Set Check hDlg, %IDC_ProcNameOnly, ProcNameOnly
             Control Set Check hDlg, %IDC_ExcludeCallbacks, ExcludeCallbacks
             Control Set Check hDlg, %IDC_ExcludeSubFolders, ExcludeSubFolders
             Control Set Check hDlg, %IDC_ShowNumber, ShowNumber
             Control Set Check hDlg, %IDC_MergeFolders, MergeFolders
             Control Set Check hDlg, %IDC_EnableExcludeName, EnableExcludeName
             Control Set Check hDlg, %IDC_ApplySyntax, ApplySyntax
    
             SetComboEditValues
             ManageComboData
    
             CodeCase = 3  'mixed
             If IsFile("gbkeywords.txt") Then synInitializeRWords Else LoadKeyWords
    
             QueryPerformanceFrequency qFreq
             ReDim D(0), Procedures(0)
             LoadProcedures
             BuildPointers
             SetLVSource
             If CurrentProcedure Then Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
    
             ListView Select hDlg, %IDC_ListView, CurrentProcedure
             Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
             PostMessage hDlg, %WM_User+500, 0, 0
             Statusbar Set Text hdlg, %IDC_Statusbar, 1, 0, "  Welcome to gbProcedures!     Total Procedures: " + Format$(UBound(Procedures),"##,###,##0") + "   Visible Procedures: " + Format$(MaxLines,"##,###,##0")
    
          Case %WM_User+500
             Txt.Print "WM_User"
             If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
             SendMessage hRichEdit, %EM_SetSel, 0,0
             Control Set Focus hDlg, %IDC_ListView
    
          Case %WM_Help
    '         Control Get Text hDlg, %IDC_Path To ParentFolder
    '         ShellExecute(hDlg, "Open", ParentFolder, $Nul, $Nul, %SW_ShowNormal)
    
         Case %WM_ContextMenu
             ptMenu.x = Lo(Integer,Cb.LParam) : ptMenu.y = Hi(Integer, Cb.LParam)
             Select Case GetDlgCtrlID (Cb.WParam)
                Case %IDC_RichEdit
                   TrackPopupMenu hContextRE, %TPM_LeftAlign, ptMenu.x, ptMenu.y, 0, Cb.Hndl, ByVal 0
             End Select
             Function = 0
    
          Case %WM_Destroy
             If Restart = 0 Then SaveProcedures
             GetComboEditValues
             Settings_INI "save"
    
          Case %WM_Command
             Select Case Cb.Ctl
                Case %IDM_Backup  : Backup
                Case %IDM_Restore : Restore
    
                Case %IDM_Debug   : Debug Xor = 1 : ManageDebug
    
                Case %IDM_Cut     : SendMessage GetFocus, %WM_CUT, 0, 0
                Case %IDM_Copy    : SendMessage GetFocus, %WM_COPY, 0, 0
                Case %IDM_Paste   : SendMessage GetFocus, %WM_PASTE, 0, 0
                Case %IDM_Delete  : SendMessage GetFocus, %WM_CLEAR, 0, 0
    
                Case %IDM_ResetComboBoxes : ResetComboBoxes
    
                Case %IDM_CopyAll
                   Control Get Text hDlg, %IDC_RichEdit To temp$
                   Clipboard Reset
                   Clipboard Set Text temp$
    
                Case %IDM_Append
                   Clipboard Get Text To temp$
                   Control Get Text hDlg, %IDC_RichEdit To tmp$
                   Clipboard Reset
                   Clipboard Set Text temp$ + $CrLf + $CrLf + tmp$
    
                Case %IDM_OpenPath
                   ListView Get Select hDlg, %IDC_ListView To CurrentProcedure
                   ShellExecute(hDlg, "Open", PathName$(Path,D(D(CurrentProcedure).ptr).ParentName), $Nul, $Nul, %SW_ShowNormal)
    
                Case %IDM_SelectIDE
                   SelectIDE
    
                Case %IDM_OpenProcedureInIDE
                   'save to "temp.bas"
                   Control Get Text hDlg, %IDC_RichEdit To temp$
                   Open "temp.bas" For Output As #1 : Print #1, temp$; : Close #1
                   i = Shell(IDEName + " temp.bas", 1)
    
                Case %IDM_OpenClipboardInIDE
                   'save to "temp.bas"
                   Clipboard Get Text To temp$
                   Open "temp.bas" For Output As #1 : Print #1, temp$; : Close #1
                   i = Shell(IDEName + " temp.bas", 1)
    
                Case %IDM_RestoreRE
                   Control Set Text hDlg, %IDC_RichEdit, REContent$
                   SendMessage hRichEdit, %EM_SetSel, 0,0
                   Txt.Print "IDM_RestoreRE"
                   If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
                Case %IDM_ShowClipboard
                   Control Get Text hDlg, %IDC_RichEdit To REContent$
                   Clipboard Get Text To temp$
                   If Len(Trim$(temp$)) = 0 Then Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "Clipboard Empty!" : sBeep : Exit Function
                   Control Set Text hDlg, %IDC_RichEdit, temp$
                   SendMessage hRichEdit, %EM_SetSel, 0,0
                   Txt.Print "IDM_ShowClipboard"
                   If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
    
                Case %IDM_SaveAs
                   Clipboard Get Text To temp$
                   If Len(temp$) = 0 Then Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Clipboard Empty!" : sBeep : Exit Function
    
                   temp$ = SaveFileAs
                   If Len(temp$) Then
                      Open temp$ For Output As #1 : Print #1, temp$; : Close #1
                   End If
    
                Case %IDM_ClearAll, %IDC_ClearAll
                   ClearAll
    
                Case %IDM_ResetDebug
                   Txt.Cls
    
                Case %IDC_RichEdit
    '               If Cb.CtlMsg = %EN_SetFocus Then Control Send Cb.Hndl, %IDC_RichEdit, %EM_SetSel, 0,0
    
                Case %IDC_Next
                   Control Get Text hDlg, %IDC_SearchTerm To SearchTerm
                   SearchText(hRichEdit, (Parse$(SearchTerm,$Spc,1)), %Fr_Down)
    
                Case %IDC_Prev
                   Control Get Text hDlg, %IDC_SearchTerm To SearchTerm
                   SearchText(hRichEdit, (Parse$(SearchTerm,$Spc,1)), %Fr_Up)
    
                Case %IDC_SelectFolder
                   ParentFolder = SelectFolder
    
                Case %IDC_ApplySyntax
                   Control Get Check hDlg, %IDC_ApplySyntax To ApplySyntax
                   Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
                   Txt.Print "IDC_ApplySyntax"
                   If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
                Case %IDC_ProcNameOnly
                   Control Get Check hDlg, %IDC_ProcNameOnly To ProcNameOnly
    
                Case %IDC_ExcludeCallbacks
                   Control Get Check hDlg, %IDC_ExcludeCallbacks To ExcludeCallbacks
    
                Case %IDC_EnableExcludeName
                   Control Get Check hDlg, %IDC_EnableExcludeName To EnableExcludeName
    
                Case %IDC_ExcludeSubFolders
                   Control Get Check hDlg, %IDC_ExcludeSubFolders To ExcludeSubFolders
    
                Case %IDC_ShowNumber
                   Control Get Check hDlg, %IDC_ShowNumber To ShowNumber
                   Control ReDraw hDlg, %IDC_ListView
    
                Case %IDM_ShowNumber
                   ShowNumber Xor= 1
                   Control Set Check hDlg, %IDC_ShowNumber, ShowNumber
                   Control ReDraw hDlg, %IDC_ListView
    
                Case %IDC_MergeFolders
                   Control Get Check hDlg, %IDC_MergeFolders To MergeFolders
    
                Case %IDC_RemoveDupes
                   If UBound(D)=0 Then Exit Function
                   QueryPerformanceCounter   qStart
                   MousePtr 11
                   MaxLines = 0 : SetLVSource
                   RemoveDupes
                   BuildPointers
                   SetLVSource
                   QueryPerformanceCounter   qStop
                   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Dupes Removed:  " + DisplayStatus + "   Time: " + Format$((qStop-qStart)/qFreq,"###.0") & " seconds"
                   MousePtr 0
    
                Case %IDC_ShowStats
                   Statusbar Set Text hDlg, %IDC_Statusbar, 1,0, DisplayStatus
    
                Case %IDC_ShowAll
                   For i = 1 To UBound(D) : D(i).status = 1 : Next i
    
                   MaxLines = 0 : SetLVSource
                   BuildPointers
                   SetLVSource
    
                   CurrentProcedure = IIf(UBound(Procedures),1,0)
                   Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
    
                   SendMessage hRichEdit, %EM_SetSel, 0,0
                   Txt.Print "IDM_ShowAll"
                   If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
                   If UBound(Files) < 1 Then
                      Statusbar Set Text hdlg, %IDC_Statusbar, 1, 0, "  Total Procedures: " + Format$(UBound(Procedures),"##,###,##0") + "   Visible Procedures: " + Format$(MaxLines,"##,###,##0")
                   Else
                      Statusbar Set Text hdlg, %IDC_Statusbar, 1, 0, DisplayStatus
                   End If
    
                Case %IDC_Search
                   ManageComboData
                   SearchFiles
    
                Case %IdOk
                   Select Case GetFocus
                      Case hFolderEdit
                         If BadComboValues Then Exit Function
                         ManageComboData
                         GetFilesAndProcedures(0)
    '                     Thread Create GetFilesAndProcedures(0) To hThread
    '                     Thread Close hThread To hThread
    '                     Control Set Focus hDlg, %IDC_ParentFolder
    '                     SendMessage hFolderEdit, %EM_SetSel, 0, -1
    
                      Case hIncludeEdit
                         If BadComboValues Then Exit Function
                         ManageComboData
                         GetFilesAndProcedures(0)
    '                     Thread Create GetFilesAndProcedures(0) To hThread
    '                     Thread Close hThread To hThread
    '                     Control Set Focus hDlg, %IDC_IncludeEXT
    '                     SendMessage hIncludeEdit, %EM_SetSel, 0, -1
    
                      Case hExcludeEdit
                         If BadComboValues Then Exit Function
                         ManageComboData
                         GetFilesAndProcedures(0)
    '                     Thread Create GetFilesAndProcedures(0) To hThread
    '                     Thread Close hThread To hThread
    '                     Control Set Focus hDlg, %IDC_ExcludeName
    '                     SendMessage hExcludeEdit, %EM_SetSel, 0, -1
    
                      Case hSearchEdit
                         ManageComboData
                         SearchFiles
    
                   End Select
    
                Case %IDC_Get
                   If BadComboValues Then Exit Function
                   ManageComboData
                   GetFilesAndProcedures(0)
    '               Thread Create GetFilesAndProcedures(0) To hThread
    '               Thread Close hThread To hThread
    
                Case %IDM_FocusInclude   : Control Set Focus hDlg, %IDC_IncludeEXT
                Case %IDM_FocusExclude   : Control Set Focus hDlg, %IDC_ExcludeName
                Case %IDM_FocusPath      : Control Set Focus hDlg, %IDC_ParentFolder
                Case %IDM_FocusSearch    : Control Set Focus hDlg, %IDC_SearchTerm
                Case %IDM_FocusRichEdit  : Control Set Focus hDlg, %IDC_RichEdit
    
             End Select
    
          Case %WM_Notify
             Select Case Cb.NmId
                Case %IDC_ListView
                   Select Case Cb.NmCode
                      Case %LVN_ColumnClick
                         FitHeader
                      Case %NM_DblClk
                         ListView Get Select hDlg, %IDC_ListView To CurrentProcedure
                         ShellExecute(hDlg, "Open", D(D(CurrentProcedure).ptr).ParentName, $Nul, $Nul, %SW_ShowNormal)
                      Case %NM_Click
                         ListView Get Select hDlg, %IDC_ListView To CurrentProcedure
                         Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
                         SendMessage hRichEdit, %EM_SetSel, 0,0
                         Txt.Print "NM_Click"
                         If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
                         Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  " + D(D(CurrentProcedure).ptr).ParentName
                      Case %LVN_ItemChanged
                         pNMLV = Cb.LParam
                         If (@pNMLV.uChanged And %LVIF_STATE) = %LVIF_STATE Then  ' if state has changed
                            If (@pNMLV.unewstate And %LVIS_SELECTED) = %LVIS_SELECTED Then
                               ListView Get Select hDlg, %IDC_ListView To CurrentProcedure
                               Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
                               SendMessage hRichEdit, %EM_SetSel, 0,0
                               Txt.Print "LVN_ItemChanged"
                               If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
                               Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  " + D(D(CurrentProcedure).ptr).ParentName
                            End If
                         End If
    
    
                      Case %LVN_GetDispInfo             'notification to ask for data
                         pLVDI = Cb.LParam              'pointer to LVDISPINFO structure for requested subitem
                         iRow = @pLVDI.item.iItem+1      'row being asked for
                         iCol = @pLVDI.item.iSubItem+1   'col being asked for
                         Select Case iCol
                            Case 1
                               If ShowNumber Then
                                  tempwZ = Format$(iRow,"##,###,##0") + " " + D(D(iRow).ptr).ProcedureName
                               Else
                                  tempwZ = D(D(iRow).ptr).ProcedureName
                               End If
                               @pLVDI.item.pszText = VarPtr(tempwZ)
                            Case 2
                               tempwZ = PathName$(Namex,D(D(iRow).ptr).ParentName)
                               @pLVDI.item.pszText = VarPtr(tempwZ)
                            Case 3
                               @pLVDI.item.pszText = VarPtr(D(D(iRow).ptr).filedate)
                            Case 4
                               tempwZ = Format$(Len(Procedures(D(iRow).ptr)), "##,###,##0") + "  "
                               @pLVDI.item.pszText = VarPtr(tempwZ)
                            Case 5
                               @pLVDI.item.pszText = VarPtr(D(D(iRow).ptr).ParentName)
                         End Select
                   End Select
             End Select
    
          Case %WM_Size
             Dialog Get Client hDlg To w,h
             Control Set Loc hDlg, %IDC_LabelC, 570, 72
             Control Set Loc hDlg, %IDC_RichEdit, 570, 95
             Control Set Size hDlg, %IDC_ListView, 550, h-180
             Control Set Size hDlg, %IDC_RichEdit, w-550-30, h-125
             Control Set Size hDlg, %IDC_SearchTerm, w-670, 200
    
       End Select
    End Function
    
    Sub SetLVSource
       If Debug Then Txt.Print FuncName$
       ListView_SetItemCountEx(hListView, MaxLines, %LVSICF_noInvalidateAll) 'max rows
    End Sub
    
    Sub FitHeader
       If Debug Then Txt.Print FuncName$
       ListView Fit Header hDlg, %IDC_Listview, 1
       ListView Fit Header hDlg, %IDC_Listview, 2
    End Sub
    
    Sub BuildPointers
       If Debug Then Txt.Print FuncName$
       Local i, j, EndReached, LastSelected As Long
    
       'reset all pointers
       For i = 1 To UBound(D) : D(i).ptr = 0 : Next i
    
       MaxLines  = 0
       LastSelected = -1
       For i = 1 To UBound(D)
          If (D(i).status) And (i > LastSelected) Then
             Incr MaxLines
             D(i).ptr = i
             LastSelected = i
          Else
             'Find next non-zero beyond the last selected element
             EndReached = 1
             For j = LastSelected+1 To UBound(D)
                If D(j).status Then
                   Incr MaxLines
                   D(i).ptr = j
                   LastSelected = j
                   EndReached = 0
                   Exit For
                End If
             Next j
             If EndReached Then Exit For
          End If
       Next i
       Control ReDraw hDlg, %IDC_ListView
    End Sub
    
    Function IsAllowedFile(fName$) As Long
       If Debug Then Txt.Print FuncName$
       Local temp$, tempArray() As String, i, GoodFlag, BadFlag As Long
    
       'test for allowed extensions
       Control Get Text hDlg, %IDC_IncludeEXT To temp$
       temp$ = LCase$(Shrink$(Trim$(temp$)))
       If Len(temp$) Then
          ReDim tempArray(ParseCount(temp$,$Spc)-1)
          Parse temp$, tempArray(), $Spc
          For i = 0 To UBound(tempArray)
             If InStr(fName$,tempArray(i)) Then GoodFlag = 1 : Exit For
          Next i
       End If
    
       'test for dis-allowed filenames
       If EnableExcludeName Then
          Control Get Text hDlg, %IDC_ExcludeName To temp$
          temp$ = LCase$(Shrink$(Trim$(temp$)))
          If Len(temp$) Then
             ReDim tempArray(ParseCount(temp$,$Spc)-1)
             Parse temp$, tempArray(), $Spc
             For i = 0 To UBound(tempArray)
                If InStr(fName$,tempArray(i)) Then BadFlag = 1 : Exit For
             Next i
          End If
       End If
    
       'Function = 1 if is allowed extension AND not bad file
       If GoodFlag = 1 And BadFlag = 0 Then Function = 1
    End Function
    
    Sub GetFilesAndFolders (ParentFolder$)
       If Debug Then Txt.Print FuncName$
       Local iPos As Long, tempDIR As DirData, temp$
    
       FileCount = 0 : FolderCount = 0
       ReDim Preserve Folders(5000), Files(50000)
       If MergeFolders = 0 Then MergedFolderCount = 0 : MergedFileCount = 0
    
       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
                tempDir.FileName = LCase$(tempDir.FileName)
                If IsAllowedFile((tempDir.FileName)) Then  'check for valid file extension and file name
                   Incr FileCount
                   If FileCount = UBound(Files) Then ReDim Preserve Files(FileCount+5000)
                   Files(FileCount) = tempDir
                End If
             Else                                                                'folder
                If ExcludeSubFolders = 0 Then
                   If FolderCount = UBound(Folders) Then ReDim Preserve Folders(FolderCount+5000)
                   Incr FolderCount
                   Folders(FolderCount) = tempDir
                End If
             End If
             temp$ = Dir$(Next, To tempDir)
          Loop
          Incr iPos
          If ExcludeSubFolders Then Exit Do
       Loop
       ReDim Preserve Files(FileCount)
       ReDim Preserve Folders(FolderCount)
    
       MergedFileCount += FileCount
       MergedFolderCount += FolderCount
    End Sub
    
    Function FileDate(i As Long) As String
       If Debug Then Txt.Print FuncName$
       Local lft As FileTime, st As SystemTime
       FileTimeToLocalFileTime(ByVal VarPtr(Files(i).LastWriteTime), lft)
       FileTimeToSystemTime(lft, st)
       Function = Format$(st.wYear,"0000") + "-" + Format$(st.wMonth,"00") + "-" + Format$(st.wDay, "00")
    End Function
    
    Function DisplayStatus() As String
       Function =  "   Total Procedures: " + Format$(ProcedureCount,"###,###,##0") + "   Visible: " + Format$(MaxLines,"###,###,##0")
    End Function
    
    Sub SearchProcedures
       If Debug Then Txt.Print FuncName$
       Local i,j, iResult, SearchMode As Long, T() As String, temp$
    
       Control Get Check hDlg, %IDC_ProcNameOnly To ProcNameOnly
    
       Control Get Text hDlg, %IDC_SearchTerm To SearchTerm
       SearchTerm = LCase$(SearchTerm)
    
       For i = 0 To UBound(D)
          D(i).status = 0 ': D(i).ptr = i
       Next i
    
       SearchMode = 0     'full string search non-boolean
       If InStr(SearchTerm," and ") Then
          'AND Search
          SearchMode = 1  'AND
          ReDim T(ParseCount(SearchTerm, " and ")-1)
          Parse SearchTerm, T(), " and "
       ElseIf InStr(SearchTerm," or ") Then
          'OR Search
          SearchMode = 2  'OR
          ReDim T(ParseCount(SearchTerm, " or ")-1)
          Parse SearchTerm, T(), " or "
       End If
    
       'Full String Search
       For i = 1 To UBound(D)
          temp$ = IIf$(ProcNameOnly, D(i).ProcedureName, Procedures(i))
          Select Case SearchMode
             Case 0   'not boolean
                If InStr(temp$,SearchTerm) Then D(i).Status = 1
             Case 1   'AND boolean
                iResult = 1
                For j = 0 To UBound(T)
                   If InStr(temp$,T(j)) = 0 Then iResult = 0 : Exit For
                Next j
                If iResult Then D(i).status = 1
             Case 2   'OR boolean
                iResult = 0
                For j = 0 To UBound(T)
                   If InStr(temp$,T(j)) Then iResult = 1 : Exit For
                Next j
                If iResult Then D(i).status = 1
          End Select
       Next i
    
    End Sub
    
    Sub ExtractProcedures
       If Debug Then Txt.Print FuncName$
       Local i,j,InProcedure As Long, SourceCode$, tmp$, ProcType$
    
       If MergeFolders Then
          ReDim Preserve D(ProcedureCount + FileCount*100)            'Procedure Parent File Data
          ReDim Preserve Procedures(ProcedureCount + FileCount*100)   'Each file can have many procedures.  100 is guess at an average.
       Else
          ProcedureCount = 0
          ReDim D(FileCount*100)            'Procedure Parent File Data
          ReDim Procedures(FileCount*100)   'Each file can have many procedures.  100 is guess at an average.
       End If
    
       For i = 1 To UBound(Files)
          Open Files(i).FileName For Binary As #1 : Get$ #1, Lof(1), SourceCode$ : Close #1
          SourceCode$ = LCase$(SourceCode$)
          ReDim CodeLines(ParseCount(SourceCode$,$CrLf)-1) As String
          Parse SourceCode$,CodeLines(),$CrLf                 'split source code into array CodeLines()
          InProcedure = 0
          For j = 0 To UBound(CodeLines)                      'split procedures into Procedures() and procedure titles into Titles()
             tmp$ = Trim$(CodeLines(j))                       'eliminate two-space character strings
    
             If Left$(tmp$,4) = "sub " Or _
                   (Left$(tmp$,9) = "function " And InStr(tmp$,"=") = 0) Or _
                   (Left$(tmp$,18) = "callback function " And ExcludeCallBacks = 0) Or _
                   Left$(tmp$,16) = "thread function " Then
                InProcedure = 1
                Incr ProcedureCount
                D(ProcedureCount).ProcedureName = ProcedureName(CodeLines(j))
                D(ProcedureCount).ProcedureType = ProcType
                D(ProcedureCount).ParentName    = Files(i).FileName
                D(ProcedureCount).filedate      = FileDate(i)
                D(ProcedureCount).procsize      = Format$(Files(i).FileSizeHigh * &H100000000 + Files(i).FileSizeLow,"##,###,##0")
                D(ProcedureCount).status        = 1
                Procedures(ProcedureCount) += CodeLines(j)
             ElseIf Left$(tmp$,7) = "end sub" Then
                InProcedure = 0
                Procedures(ProcedureCount) += $CrLf + CodeLines(j)
             ElseIf Left$(tmp$,12) = "end function" Then
                InProcedure = 0
                Procedures(ProcedureCount) += $CrLf + CodeLines(j)
             ElseIf InProcedure = 1 Then
                Procedures(ProcedureCount) += $CrLf + CodeLines(j)
             End If
          Next j
       Next i
       ReDim Preserve D(ProcedureCount)
       ReDim Preserve Procedures(ProcedureCount)
    End Sub
    
    Function ProcedureName(ByVal code$) As String
       If Debug Then Txt.Print FuncName$
       Replace "(" With $Spc In code$
       code$ = Shrink$(code$)
       If Left$(code$,4) = "sub " Then
          code$ = Trim$(Mid$(code$,5))
          Replace "(" With $Spc In code$
          Function = Parse$(code$, $Spc, 1)
       ElseIf Left$(code$,9) = "function " Then
          code$ = Trim$(Mid$(code$,10))
          Replace "(" With $Spc In code$
          Function = Parse$(code$, $Spc, 1)
       ElseIf Left$(code$,18) = "callback function " Then
          code$ = Trim$(Mid$(code$,19))
          Replace "(" With $Spc In code$
          Function = Parse$(code$, $Spc, 1)
       ElseIf Left$(code$,16) = "thread function " Then
          code$ = Trim$(Mid$(code$,17))
          Replace "(" With $Spc In code$
          Function = Parse$(code$, $Spc, 1)
       End If
    End Function
    
    Sub LoadProcedures   'procedures.dat ... procedures.txt
       If Debug Then Txt.Print FuncName$
       Local temp$
    
       If ProcedureCount = 0 Then
          CurrentProcedure = 0
          FileCount = 0
          FolderCount = 0
          ReDim D(0)
          ReDim Procedures(0)
          ReDim Files(0)
          ReDim Folders(0)
          MaxLines = 0
          SetLVSource
          Exit Sub
       End If
    
       Open "procedures.txt" For Binary As #1
       Get$ #1, Lof(1), temp$
       Close #1
    
       ProcedureCount = ParseCount(temp$,$Delimiter)-1
       ReDim Procedures(ProcedureCount)
       Parse temp$, Procedures(), $Delimiter
       If ProcedureCount > 0 Then CurrentProcedure = 1 Else CurrentProcedure = 0
    
       ReDim D(ProcedureCount)
       Open "procedures.dat" For Binary As #1
       Get #1,, D()
       Close #1
    End Sub
    
    Sub SaveProcedures   'procedures.dat ... procedures.txt
       If Debug Then Txt.Print FuncName$
       Open "procedures.txt" For Output As #1
       Print #1, Join$(Procedures(), $Delimiter);
       Close #1
    
       Open "procedures.dat" For Binary As #1
       Put #1,, D()
       SetEof(1)
       Close #1
    End Sub
    
    Sub RemoveDupes
       If Debug Then Txt.Print FuncName$
       Local iMax,i,j,iResult As Long
       iMax = UBound(Procedures)
       For i = 1 To iMax-1
          For j = i+1 To iMax
             If Procedures(i) = Procedures(j) Then
                Array Delete D(j)
                Array Delete Procedures(j)
                Decr iMax
             End If
          Next j
       Next i
       CurrentProcedure = 1
       ProcedureCount = iMax
       MaxLines = iMax
       ReDim Preserve Procedures(iMax)
       ReDim Preserve D(iMax)
    End Sub
    
    Sub CreateContextMenu
       If Debug Then Txt.Print FuncName$
       Menu New PopUp To hContextRE
       Menu Add String, hContextRE, "Cut",  %IDM_Cut,  %MF_Enabled
       Menu Add String, hContextRE, "Copy", %IDM_Copy, %MF_Enabled
       Menu Add String, hContextRE, "Paste",  %IDM_Paste,  %MF_Enabled
       Menu Add String, hContextRE, "Delete", %IDM_Delete,  %MF_Enabled
       Menu Add String, hContextRE, "Copy All", %IDM_CopyAll,  %MF_Enabled
       Menu Add String, hContextRE, "Append All", %IDM_Append,  %MF_Enabled
       Menu Add String, hContextRE, "-", %IDM_Sep, 0
       Menu Add String, hContextRE, "Save Clipboard As", %IDM_SaveAs,  %MF_Enabled
       Menu Add String, hContextRE, "Show Clipboard", %IDM_ShowClipboard,  %MF_Enabled
       Menu Add String, hContextRE, "Restore Procedure", %IDM_RestoreRE,  %MF_Enabled
       Menu Add String, hContextRE, "-", %IDM_Sep, 0
       Menu Add String, hContextRE, "Select IDE", %IDM_SelectIDE,  %MF_Enabled
       Menu Add String, hContextRE, "Open Procedure in IDE", %IDM_OpenProcedureInIDE,  %MF_Enabled
       Menu Add String, hContextRE, "Open Clipboard in IDE", %IDM_OpenClipboardInIDE,  %MF_Enabled
       Menu Add String, hContextRE, "-", %IDM_Sep, 0
       Menu Add String, hContextRE, "Open Path", %IDM_OpenPath,  %MF_Enabled
       Menu Add String, hContextRE, "-", %IDM_Sep, 0
       Menu Add String, hContextRE, "Backup", %IDM_Backup,  %MF_Enabled
       Menu Add String, hContextRE, "Restore", %IDM_Restore,  %MF_Enabled
       Menu Add String, hContextRE, "-", %IDM_Sep, 0
       Menu Add String, hContextRE, "Reset Procedure List", %IDM_ClearAll,  %MF_Enabled
       Menu Add String, hContextRE, "Reset Debug", %IDM_Debug,  %MF_Enabled
    End Sub
    
    Sub Settings_INI(Task$)
       If Debug Then Txt.Print FuncName$
       Local xResult, yResult, tempz, INIFileName As WStringZ * %Max_Path
       Local WinPla As WindowPlacement
       Local DefaultX, DefaultY, wDeskTop, hDeskTop As Long
    
       'set ini filename
       INIFileName = Exe.Path$ + "gbprocedures.ini"
       If Task$ = "get" Then
    
          'get dialog width/height from INI file and use to set Dialog size
          GetPrivateProfileString "All", "Width", "1200", xResult, %Max_Path, INIFileName
          GetPrivateProfileString "All", "Height", "600", yResult, %Max_Path, INIFileName
          Dialog Set Size hDlg,Val(xResult), Val(yResult)   'width/height
    
          'default should be centered on screen
          Desktop Get Client To wDeskTop, hDeskTop
          DefaultX = (wDeskTop-Val(xResult))/2
          DefaultY = (hDeskTop-Val(yResult))/2
    
          'get dialog top/left from INI file and use to set Dialog location
          Getprivateprofilestring "All", "Left", Str$(DefaultX), xResult, %Max_Path, INIFileName
          Getprivateprofilestring "All", "Top", Str$(DefaultY), yResult,  %Max_Path, INIFileName
          Dialog Set Loc hDlg, Val(xResult), Val(yResult)   'left/top
    
          'get value for string variables
          Getprivateprofilestring "All", "ExcludeName", "bak backup_",   ExcludeName,  %Max_Path, INIFileName
          Getprivateprofilestring "All", "IncludeEXT", ".bas .inc",      IncludeEXT,  %Max_Path, INIFileName
          Getprivateprofilestring "All", "SearchTerm", "getcursorpos",   SearchTerm,  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ParentFolder", "c:\pbwin10",   ParentFolder,  %Max_Path, INIFileName
    
          Getprivateprofilestring "All", "IDEName", "c:\pbwin10\bin\pbedit.exe",   IDEName,  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ValidWordCharacters", Chr$(48 To 57, 65 To 90, 95, 97 To 122), ValidWordCharacters, %Max_Path, INIFileName
          '                                                            0-9        A-Z     _     a-z
    
          Getprivateprofilestring "All", "SearchTerm1", "getcursorpos", CDataSearchTerm(1),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "SearchTerm2", "getfocus",     CDataSearchTerm(2),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "SearchTerm3", "setfocus",     CDataSearchTerm(3),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "SearchTerm4", "sendmessage",  CDataSearchTerm(4),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "SearchTerm5", "postmessage",  CDataSearchTerm(5),  %Max_Path, INIFileName
    
          Getprivateprofilestring "All", "ExcludeName1", "bak backup_", CDataExclude(1),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ExcludeName2", "bak", CDataExclude(2),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ExcludeName3", "backup_", CDataExclude(3),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ExcludeName4", "", CDataExclude(4),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ExcludeName5", "", CDataExclude(5),  %Max_Path, INIFileName
    
          Getprivateprofilestring "All", "IncludeEXT1", ".bas .inc", CDataInclude(1),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "IncludeEXT2", ".bas", CDataInclude(2),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "IncludeEXT3", ".inc", CDataInclude(3),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "IncludeEXT4", ".gbs", CDataInclude(4),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "IncludeEXT5", "", CDataInclude(5),  %Max_Path, INIFileName
    
          Getprivateprofilestring "All", "ParentFolder1", "c:\pbwin10", CDataParent(1),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ParentFolder2", "", CDataParent(2),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ParentFolder3", "", CDataParent(3),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ParentFolder4", "", CDataParent(4),  %Max_Path, INIFileName
          Getprivateprofilestring "All", "ParentFolder5", "", CDataParent(5),  %Max_Path, INIFileName
    
          'get value for numeric variables
          Getprivateprofilestring "All", "ProcNameOnly", "0",  tempz,  %Max_Path, INIFileName       : ProcNameOnly = Val(tempz)
          Getprivateprofilestring "All", "EnableExcludeName", "0",  tempz,  %Max_Path, INIFileName  : EnableExcludeName = Val(tempz)
          Getprivateprofilestring "All", "ExcludeCallbacks", "1",  tempz,  %Max_Path, INIFileName   : ExcludeCallbacks = Val(tempz)
          Getprivateprofilestring "All", "ExcludeSubFolders", "0",  tempz,  %Max_Path, INIFileName  : ExcludeSubFolders = Val(tempz)
          Getprivateprofilestring "All", "ShowNumber", "0",  tempz,  %Max_Path, INIFileName         : ShowNumber = Val(tempz)
          Getprivateprofilestring "All", "MergeFolders", "0",  tempz,  %Max_Path, INIFileName       : MergeFolders = Val(tempz)
          Getprivateprofilestring "All", "CurrentProcedure", "0",  tempz,  %Max_Path, INIFileName   : CurrentProcedure = Val(tempz)
          Getprivateprofilestring "All", "FileCount", "0",  tempz,  %Max_Path, INIFileName          : FileCount = Val(tempz)
          Getprivateprofilestring "All", "FolderCount", "0",  tempz,  %Max_Path, INIFileName        : FolderCount = Val(tempz)
          Getprivateprofilestring "All", "ProcedureCount", "0",  tempz,  %Max_Path, INIFileName     : ProcedureCount = Val(tempz)
          Getprivateprofilestring "All", "ApplySyntax", "1",  tempz,  %Max_Path, INIFileName        : ApplySyntax = Val(tempz)
          Getprivateprofilestring "All", "MergedFileCount", "0",  tempz,  %Max_Path, INIFileName    : MergedFileCount = Val(tempz)
          Getprivateprofilestring "All", "MergedFolderCount", "0",  tempz,  %Max_Path, INIFileName  : MergedFolderCount = Val(tempz)
    
       End If
    
       If Task$ = "save" Then
          WinPla.Length = SizeOf(WinPla)
          GetWindowPlacement hDlg, WinPla
          WritePrivateProfileString "All", "Left", Str$(WinPla.rcNormalPosition.nLeft), INIFileName
          WritePrivateProfileString "All", "Top", Str$(WinPla.rcNormalPosition.nTop), INIFileName
          WritePrivateProfileString "All", "Width", Str$(WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft), INIFileName
          WritePrivateProfileString "All", "Height", Str$(WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop), INIFileName
    
          'save string variables
          WritePrivateProfileString "All", "ExcludeName",   ExcludeName, INIFileName
          WritePrivateProfileString "All", "IncludeEXT",   IncludeEXT, INIFileName
          WritePrivateProfileString "All", "SearchTerm",   SearchTerm, INIFileName
          WritePrivateProfileString "All", "ParentFolder",   ParentFolder, INIFileName
          WritePrivateProfileString "All", "IDEName", IDEName, INIFileName
          WritePrivateProfileString "All", "ValidWordCharacters",ValidWordCharacters, INIFileName
    
          WritePrivateProfileString "All", "SearchTerm1",   CDataSearchTerm(1), INIFileName
          WritePrivateProfileString "All", "SearchTerm2",   CDataSearchTerm(2), INIFileName
          WritePrivateProfileString "All", "SearchTerm3",   CDataSearchTerm(3), INIFileName
          WritePrivateProfileString "All", "SearchTerm4",   CDataSearchTerm(4), INIFileName
          WritePrivateProfileString "All", "SearchTerm5",   CDataSearchTerm(5), INIFileName
    
          WritePrivateProfileString "All", "ExcludeName1",   CDataExclude(1), INIFileName
          WritePrivateProfileString "All", "ExcludeName2",   CDataExclude(2), INIFileName
          WritePrivateProfileString "All", "ExcludeName3",   CDataExclude(3), INIFileName
          WritePrivateProfileString "All", "ExcludeName4",   CDataExclude(4), INIFileName
          WritePrivateProfileString "All", "ExcludeName5",   CDataExclude(5), INIFileName
    
          WritePrivateProfileString "All", "IncludeEXT1",   CDataInclude(1), INIFileName
          WritePrivateProfileString "All", "IncludeEXT2",   CDataInclude(2), INIFileName
          WritePrivateProfileString "All", "IncludeEXT3",   CDataInclude(3), INIFileName
          WritePrivateProfileString "All", "IncludeEXT4",   CDataInclude(4), INIFileName
          WritePrivateProfileString "All", "IncludeEXT5",   CDataInclude(5), INIFileName
    
          WritePrivateProfileString "All", "ParentFolder1",   CDataParent(1), INIFileName
          WritePrivateProfileString "All", "ParentFolder2",   CDataParent(2), INIFileName
          WritePrivateProfileString "All", "ParentFolder3",   CDataParent(3), INIFileName
          WritePrivateProfileString "All", "ParentFolder4",   CDataParent(4), INIFileName
          WritePrivateProfileString "All", "ParentFolder5",   CDataParent(5), INIFileName
    
          'save numeric variables
          WritePrivateProfileString "All", "ProcNameOnly",      Str$(ProcNameOnly), INIFileName
          WritePrivateProfileString "All", "EnableExcludeName", Str$(EnableExcludeName), INIFileName
          WritePrivateProfileString "All", "ExcludeCallbacks",  Str$(ExcludeCallbacks), INIFileName
          WritePrivateProfileString "All", "ExcludeSubFolders", Str$(ExcludeSubFolders), INIFileName
          WritePrivateProfileString "All", "ShowNumber",        Str$(ShowNumber), INIFileName
          WritePrivateProfileString "All", "MergeFolders",      Str$(MergeFolders), INIFileName
          WritePrivateProfileString "All", "CurrentProcedure",  Str$(CurrentProcedure), INIFileName
          WritePrivateProfileString "All", "FileCount",         Str$(FileCount), INIFileName
          WritePrivateProfileString "All", "FolderCount",       Str$(FolderCount), INIFileName
          WritePrivateProfileString "All", "ProcedureCount",    Str$(ProcedureCount), INIFileName
          WritePrivateProfileString "All", "ApplySyntax",       Str$(ApplySyntax), INIFileName
          WritePrivateProfileString "All", "MergedFileCount",   Str$(MergedFileCount), INIFileName
          WritePrivateProfileString "All", "MergedFolderCount", Str$(MergedFolderCount), INIFileName
    
       End If
    End Sub
    
    Sub CreateRichEdit
       If Debug Then Txt.Print FuncName$
    '    LoadLibrary("RichEd32.dll")
    '    Control Add "RichEdit", hDlg, %IDC_RichEdit, "", 5, 60, 150, 100, _
        LoadLibrary("msftedit.dll")
        Control Add "RichEdit50W", hDlg, %IDC_RichEdit, "", 5, 60, 150, 100, _
                %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
                Or %WS_TabStop Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel, _
                %WS_Ex_ClientEdge
        Control Handle hDlg, %IDC_RichEdit To hRichEdit
        Font New "Courier New",12,1 To hCodeFont
        Control Set Font hDlg, %IDC_RichEdit, hCodeFont
        OldREProc = SetWindowLong(hRichEdit, %GWL_WndProc, CodePtr(NewREProc))
    '    SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE
    '    SendMessage hRichEdit, %EM_EXLIMITTEXT, 0, 1024 * 1024 - 1
    End Sub
    
    Function NewREProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      Select Case wMsg
        Case %WM_KeyUp        'trap key up, for syntax color check while editing
            Local CurLine As Long
            CurLine = SendMessage(hRichEdit, %EM_EXLINEFROMCHAR, 0, -1)
            ScanLine(CurLine, CurLine)              'check current line only
            Function = 0 : Exit Function                  'return zero
        Case %WM_Char
           If wParam = &H16 Then
              Txt.Print "RE Paste"
              If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
           End If
      End Select
      NewREProc = CallWindowProc(OldREProc, hWnd, wMsg, wParam, lParam)
    End Function
    
    Sub synApplySyntax()   'scan all lines
       If Debug Then Txt.Print FuncName$
      TurnOffCol
      ScanLine(0, SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
    '  SetFocus hRichEdit
    End Sub
    
    Sub synInitializeRWords
       If Debug Then Txt.Print FuncName$
      Local temp$, i As Long
      ReDim UWords(1000), LWords(1000), MWords(1000)
      Open Exe.Path$ + "gbkeywords.txt" For Input As #1
      While IsFalse Eof(1)
        Line Input #1, temp$
        If Len(Trim$(temp$)) Then
            MWords(i) = temp$
            UWords(i) = UCase$(MWords(i))
            LWords(i) = LCase$(MWords(i))
            Incr i
        End If
      Wend
      Close #1
      ReDim Preserve UWords(i-1), LWords(i-1), MWords(i-1)
    End Sub
    
    Function setRichTextColor( ByVal NewColor As Long) As Long
    '   If Debug Then Txt.Print FuncName$
    ' setRichTextColor sets the textcolor for selected text in a Richedit control.
    ' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
      Local cf As CHARFORMAT
      cf.cbSize      = Len(cf)      'Length of structure
      cf.dwMask      = %CFM_COLOR    'Set mask to colors only
      cf.crTextColor = NewColor      'Set the new color value
      SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPtr(cf))
    End Function
    
    Sub TurnOffCol
       If Debug Then Txt.Print FuncName$
    ' Set all text to black - faster this way
      Local cf As CHARFORMAT, xEvent As Long
      Local tTime As Single : tTime = Timer                      'get time
      xEvent = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)        'Get eventmask
      SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)            'Disable eventmask
    '  MousePtr 11                                                'Hourglass
      cf.cbSize      = Len(cf)                                  'Length of structure
      cf.dwMask      = %CFM_COLOR                                'Set mask to colors only
      cf.crTextColor = &H0                                      'Set black color value
      SendMessage(hRichEdit, %EM_SETCHARFORMAT, -1, VarPtr(cf)) '%SCF_ALL = -1
      If xEvent Then
        SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvent)    'Enable eventmask
      End If                                                    'Arrow
    '  MousePtr 0
      SendMessage(hRichEdit, %EM_SETMODIFY, %FALSE, 0)          'reset modify flag
    End Sub
    
    Sub ScanLine(ByVal Line1 As Long, ByVal Line2 As Long)
       If Debug Then Txt.Print FuncName$
    ' Syntax color parser for received line numbers
      Local pd As CHARRANGE, Oldpd As CHARRANGE, tBuff As TEXTRANGE
      Local xWord As String , Buf As WString
      Local Aspect As Long, xEvents As Long, I As Long , J As Long, stopPos As Long
      Local lnLen As Long, Result As Long, wFlag As Byte, Letter As Word Ptr
    
      SendMessage(hRichEdit, %EM_EXGETSEL, 0, VarPtr(Oldpd)) 'Original position
                                                              '(so we can reset it later)
      'Disable the event mask, for better speed
      xEvents = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)
      SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)
    
      'Turn off redraw for faster and smoother action
      SendMessage(hRichEdit, %WM_SETREDRAW, 0, 0)
    
      If Line1 <> Line2 Then                                  'if multiple lines
    '    MousePtr 11
      Else                                                                    'editing a line
        pd.cpMin = SendMessage(hRichEdit, %EM_LINEINDEX, Line1, 0)                'line start
        pd.cpMax = pd.cpMin + SendMessage(hRichEdit, %EM_LINELENGTH, pd.cpMin, 0) 'line end
        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))                  'select line
        setRichTextColor &H0                                            'set black
      End If
    
      For J = Line1 To Line2
        Aspect = SendMessage(hRichEdit, %EM_LINEINDEX, J, 0)      'line start
        lnLen  = SendMessage(hRichEdit, %EM_LINELENGTH, Aspect, 0) 'line length
    
        If lnLen Then
            Buf = Space$(lnLen + 1)
            tBuff.chrg.cpMin = Aspect
            tBuff.chrg.cpMax = Aspect + lnLen
            tBuff.lpstrText = StrPtr(Buf)
            lnLen = SendMessage(hRichEdit, %EM_GETTEXTRANGE, 0, ByVal VarPtr(tBuff)) 'Get line
    
            'CharUpperBuff(ByVal StrPtr(Buf), lnLen)        'Make UCASE
            Buf = UCase$(Buf)
            'I always use this one, since it handles characters > ASC(127) as well.. ;-)
    
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            ' Loop through the line, using a pointer for better speed
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            Letter = StrPtr(Buf) : wFlag = 0
            For I = 1 To Len(Buf)
              Select Case @Letter 'The characters we need to inlude in a word
                  Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, _
                                                    35 To 38, 48 To 57, 63, 95
                    If wFlag = 0 Then
                        wFlag = 1 : stopPos = I
                    End If
    
                  Case 34 ' string quotes -> "
                    stopPos = InStr(I + 1, Buf, Chr$(34)) 'Find match
                    If stopPos Then
                      pd.cpMin = Aspect + I
                      pd.cpMax = Aspect + stopPos - 1
                      SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))
                      setRichTextColor &HFF
                      StopPos = (StopPos - I + 1)
                      I = I + StopPos
                      Letter = Letter + StopPos
                      wFlag = 0
                    End If
    
                  Case 39 ' uncomment character -> '
                    pd.cpMin = Aspect + I - 1
                    pd.cpMax = Aspect + lnLen
                    SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))
                    setRichTextColor &H00008000&
                    wFlag = 0
                    Exit For
    
                  Case Else  'word is ready
                    If wFlag = 1 Then
                        xWord = Mid$(Buf, stopPos, I - stopPos)  'Get word
    
                        If xWord = "REM" Then  'extra for the uncomment word, REM
                          pd.cpMin = Aspect + I - Len(xWord) - 1
                          pd.cpMax = Aspect + lnLen
                          SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))
                          setRichTextColor &H00008000&
                          wFlag = 0
                          Exit For
                        End If
                        Array Scan UWords(0), = xWord, To Result  'Is it in the array?
                        If Result Then
                          pd.cpMin = Aspect + stopPos - 1
                          pd.cpMax = Aspect + I - 1
    '---------------------------------upper/lower/mixed handled here-----------
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))
                        xWord = Choose$(CodeCase&, UWords(Result-1), LWords(Result-1), MWords(Result-1))
                        Control Send hDlg, %IDC_RichEdit, %EM_ReplaceSel, %True, StrPtr(xWord)
    '----------------------------------------------------------------------
                          SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(pd))
                          setRichTextColor(&HFF0000)      'set blue color
                        End If
                        wFlag = 0
                    End If
              End Select
    
              Incr Letter
            Next I
        End If
      Next J
    
      'Reset original caret position
      SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPtr(Oldpd))
    
      'Turn on Redraw again and refresh - this one causes some flicker in Richedit..
      SendMessage hRichEdit, %WM_SETREDRAW, 1, 0
      InvalidateRect hRichEdit, ByVal %NULL, 0 : UpdateWindow hRichEdit
    
      'Reset the event mask
      If xEvents Then SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvents)
    End Sub
    
    Sub sBeep
       WinBeep(250,300)
    End Sub
    
    Function SelectFolder() As String
       If Debug Then Txt.Print FuncName$
       Local title$, start$, flags&, folder$, x,y As Long
       Dialog Get Loc hDlg To x,y
       title$ = "Select Folder"    'if "" then "Open" is used
       start$ = ParentFolder
       flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
       Display Browse  hDlg, 100, 100, title$, start$, flags& To folder$
       'folder$ is set to "" if Cancel/Escape is pressed
       If Len(folder$) Then Function = folder$ Else Function = ParentFolder
    End Function
    
    Sub RESetTopLine(NewTopLine As Long)
       If Debug Then Txt.Print FuncName$
       Local RETopLine As Long
       RETopLine  = SendMessage(hRichEdit, %EM_GetFirstVisibleLine, 0, 0)
       SendMessage hRichEdit, %EM_LineScroll, 0, NewTopLine - RETopLine
    End Sub
    
    Sub LoadKeyWords
       If Debug Then Txt.Print FuncName$
       Local i As Long
       ReDim UWords(DataCount), LWords(DataCount), MWords(DataCount)
       For i = 1 To DataCount
          MWords(i) = Read$(i)
          UWords(i) = UCase$(MWords(i))
          LWords(i) = LCase$(MWords(i))
       Next i
    
       Data #Align,#Bloat,#Com,#Compile,#Compiler,#Debug,#Dim,#If,#ElseIf,#Else
       Data #EndIf,#Include,#Messages,#Optimize,#Option,#PBForms,#Register,#Resource,#Stack,#Tools
       Data #Utility,%Def,ABS,Accel,Accept,Acode$,Add,Addr,Alloc,AND
       Data Arc,Array,Arrayattr,Asc,Asm,Assign,Atn,Attach,Bar,Beep
       Data Bgr,Bin$,Bit,Bitmap,Bits,Bitse,Block,Bold,Box,Browse
       Data Build$,Button,Calc,Call,CallBack,CallSTK,CallSTK$,CallSTKcount,Cancel,Case,CB.Ctl
       Data CB.Ctlmsg,CB.Hndl,CB.lParam,CB.Msg,CB.Nmcode,CB.Nmhdr,CB.Nmhdr$,CB.Nmhwnd,CB.NmID,CB.wParam
       Data Cbctl,Cbctlmsg,Cbhndl,Cblparam,Cbmsg,Cbwparam,CByt,CCur,CCux,CDbl
       Data Cdwd,Ceil,CExt,ChDir,ChDrive,Check,Check3State,Checkbox,Child,Choose
       Data Chr,Chr$,Cint,Class,Clear,Click,Client,Clipboard,Clng
       Data Close,ClsID$,Code,CodePTR,Collate,Color,ColorMode,Column,ComboBox,Comm
       Data Command$,Content,Control,Copies,Copy,Cos,Count,Cqud,Create,Cset
       Data CSet$,CSng,CurDir$,CVByt,CVCur,CVCux,CVD,CVDwd,CVE,CVI
       Data CVL,CVQ,CVS,CVWrd,CWrd,Data,Datacount,Date$,Declare,Decr
       Data DefByt,DefCur,DefCux,DefDbl,DefDwd,DefExt,DefInt,DefLng,DefQud,DefSng
       Data DefStr,DefWrd,Delete,Desktop,Detach,Dialog,Dim,Dir$,Disable,DiskFree
       Data DiskSize,Display,DLLmain,Do,Doevents,Draw,Duplex,DWord,Ellipse,ElseIf, Enable
       Data End,Environ,Environ$,Eof,Eqv,Erase,Erl,Erl$,Err,ErrClear
       Data Error,Error$,Events,Exact,Exe,Exit,Exp,Exp10,Exp2,Expanded
       Data Explicit,Extract$,Field,FileAttr,FileCopy,FileName$,FileScan,Find,Fit,Fix
       Data Flush,Focus,Font,For,Format$,FormFeed,Frac,Frame,Free,FreeFile
       Data FuncName$,Function,Get,Get$,GetAttr,Global,GlobalMem,GoSub,GoTo,Graphic
       Data Guid$,GuidTxt$,Handle,Header,Hex$,Hi,HiByt,HiInt,HiWrd
       Data Host,Icon,ID,IDispInfo,If,IIF,Image,Image2,ImageList
       Data ImageX,ImgButton,ImgButtonX,Imp,Incr,Inkey$,Input,Input#,InputBox$,Insert
       Data Instance,Instr,Int,Interface,IsFalse,IsFile,IsInterface,IsMissing,IsNothing
       Data IsObject,IsTrue,IsWin,Item,Iterate,Join$,Kill,Label,LBound,LCase$
       Data Left$,Len,Let,LibMain,Line,Lines,ListBox,ListView,Lo,Load
       Data LoByt,Loc,Local,Lock,Lof,Log,Log10,Log2,LoInt,Loop,LoWrd
       Data LPrint,LPrint$,LSet,LTrim$,Macro,Mak,MakDwd,MakInt,MakPtr,MakWrd
       Data Margin,Masked,Mat,Max,Mcase$,Me,Menu,Method,Mid$,Min
       Data Mix,MkByt$,MkCur$,MkCux$,MkD$,MkDir,MkDwd$,Mke$,Mki$,Mkl$
       Data Mkq$,Mks$,Mkwrd$,Mod,Modal,Mode,Modeless,MousePTR,MsgBox,MyBase
       Data Name,New,Next,Not,Notify,Nul$,ObjActive,Object,ObjPTR,ObjResult
       Data ObjResult$,Oct$,OEMtext,On,Open,OpenFile,Option,Or,Orientation,Overlay
       Data Page,PageSize,Paint,Paper,Papers,Parent,Parse,Parse$,ParseCount,Parts
       Data PathName$,PathScan$,PBLibMain,PBMain,Peek,Peek$,Pie,Pixel,Pixels,Poke
       Data Poke$,Polygon,Polyline,Popup,Pos,Post,PPI,Previous,Print,Print#
       Data Printer$,PrinterCount,Profile,ProgID$,ProgressBar,Property,Put,Put$,Quality,RaiseEvent
       Data Randomize,Range,Read$,Recv,ReDim,Redraw,RegExpr,Register,RegRepl,REM
       Data Remain$,Remove$,Render,Repeat$,Replace,Reset,Resume,Retain$,Return,Rgb
       Data Right$,RmDir,Rnd,Root,Rotate,Round,RSet,RSet$,RTrim$,Save
       Data SaveFile,Scale,Scan,ScrollBar,Seek,SelCount,Select,Send,Separator,Set
       Data SetAttr,Seteof,Sgn,Shell,Shift,Show,Sin,Size,SizeOf,Sleep
       Data Sort,Space$,Sqr,State,Static,Status,StatusBar,Step,Str$,StrDelete$
       Data Stretch,String,String$,StrInsert$,StrPTR,StrReverse$,Style,StyleXX,Sub
       Data Suspend,Swap,Switch,Tab,Tab$,Tally,Tan,Tcp,Text,TextBox
       Data Thread,ThreadCount,Threaded,ThreadID,Time$,Timer,Tix,Toolbar,Trace,TrackPOS
       Data Tray,Trays,TreeView,Trim$,Try,Type,UBound,UCase$
       Data UCode$,UDP,Unicode,Union,Units,UnLock,UnSelect,Until, User,Using$
       Data Val,Variant#,Variant$,VariantVT,VarPTR,Verify,Visible,WaitKey$,Wend,While,Width
       Data Window,WinMain,Write#,XOR,XPrint,XPrint$
    End Sub
    
    Function SaveFileAs() As String
       If Debug Then Txt.Print FuncName$
       Local hParent As Dword, title$, folder$, filter$, start$, defaultext$, flags&, filevar$, countvar&, temp$
    
       Clipboard Get Text To temp$
    
       hParent = hDlg              'if not parent, use 0 or %hWnd_Desktop
       title$ = "Save File As"     'if "", then "Save As" is used
       folder$ = "c:\"             'if "", then current directory is used
       filter$ = Chr$("*.bas and *.inc", 0, "*.bas;*.inc", 0)
       start$ = ""               'starting filename
       defaultext$ = "bas"
       flags& = %OFN_PathMustExist Or %OFN_Explorer Or %OFN_OverWritePrompt
       Display Savefile hParent, 100, 100, "Save File", folder$, filter$, start$, _
          defaultext$, flags& To filevar$, countvar&
       '  filevar$ contains name of filename to use for Save
       '  countvar$ contains number of files selected
       '  if no file is selected, filevar$ = ""
       If Len(filevar$) Then Function = filevar$
    End Function
    
    Sub SelectIDE
       If Debug Then Txt.Print FuncName$
        Local title$, startfolder$, filter$, startfile$, defaultext$, flags&, filevar$, countvar&
        title$ = "Select IDE"    'caption title. if "", then "open" is displayed
        filter$ = "pbwin ide" + $Nul + "*.exe" + $Nul   ' or filter$ = chr$("text",0,"*.txt",0)
        startfolder$ = PathName$(Path,IDEName)    'initial folder to be displayed
        If IsFile(IDEName) Then startfile$ = IDEName Else startfile$ = ""       'name to be used as initial selection
        defaultext$ = "exe"                 'default extension to append to selection if user does not enter it
        flags& = %OFN_Explorer Or %OFN_FileMustExist Or %OFN_HideReadOnly
        Display Openfile hdlg, 100, 100, title$, startfolder$, filter$, startfile$, _
                                  defaultext$, flags& To filevar$, countvar&
        If Len(filevar$) Then IDEName = filevar$
    End Sub
    
    Sub ClearAll
       If Debug Then Txt.Print FuncName$
       QueryPerformanceFrequency qFreq
       Control Set Text hDlg, %IDC_RichEdit, ""
       ProcedureCount = 0
    
       If IsFile("procedures.txt") Then Kill "procedures.txt"
       If IsFile("procedures.dat") Then Kill "procedures.dat"
    
       LoadProcedures
       BuildPointers
       SetLVSource
       Statusbar Set Text hdlg, %IDC_Statusbar, 1, 0, "  Welcome to gbProcedures!     Total Procedures: " + Format$(UBound(Procedures),"##,###,##0") + "   Visible Procedures: " + Format$(MaxLines,"##,###,##0")
    End Sub
    
    Function SearchText(hRichEdit As Dword, ByVal sTextToSearchFor As WString, SearchDirection As Long) As Long
       If Debug Then Txt.Print FuncName$
     Local  FindTextText         As FINDTEXTEX
     Local  NextMatch, SelStart, SelEnd As Long
    
     SendMessage(hRichEdit, %EM_GETSEL, VarPtr(SelStart), VarPtr(SelEnd))
     FindTextText.lpStrText = StrPtr(sTextToSearchFor)
    
     If SearchDirection = %FR_Down Then
       FindTextText.chrg.cpMin = SelEnd + 1 'Search from current position
       FindTextText.chrg.cpMax = -1         '- till the end
     Else '%FR_UP
       FindTextText.chrg.cpMin = SelStart   'Search from current position
       FindTextText.chrg.cpMax = 0          '- up to the start
     End If
    
     NextMatch = SendMessage(hRichEdit, %EM_FINDTEXTEX, SearchDirection, VarPtr(FindTextText)) 'Return next match or -1 for no more
    
     If NextMatch = -1 Then WinBeep(250,300) :Exit Function
     SendMessage(hRichEdit, %EM_SETSEL, FindTextText.chrgText.cpMin, FindTextText.chrgText.cpMax)
    
    End Function
    
    Sub BuildAcceleratorTable
       If Debug Then Txt.Print FuncName$
       Local c As Long, ac() As ACCELAPI, hAccelerator As Dword  ' for keyboard accelator table values
       Dim ac(10)
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_I  : ac(c).cmd   = %IDM_FocusInclude        : Incr c   '00
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_E  : ac(c).cmd   = %IDM_FocusExclude        : Incr c   '01
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_F  : ac(c).cmd   = %IDM_FocusPath           : Incr c   '02
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_S  : ac(c).cmd   = %IDM_FocusSearch         : Incr c   '03
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_R  : ac(c).cmd   = %IDM_FocusRichEdit       : Incr c   '04
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_G  : ac(c).cmd   = %IDC_Get                 : Incr c   '05
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_N  : ac(c).cmd   = %IDC_Next                : Incr c   '06
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_P  : ac(c).cmd   = %IDC_Prev                : Incr c   '07
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_Z  : ac(c).cmd   = %IDM_ResetComboBoxes     : Incr c   '08
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_D  : ac(c).cmd   = %IDM_Debug               : Incr c   '09
       ac(c).fvirt = %FVIRTKEY Or %FCONTROL : ac(c).key   = %VK_Y  : ac(c).cmd   = %IDM_ResetDebug          : Incr c   '10
       Accel Attach hDlg, AC() To hAccelerator
    End Sub
    
    Sub GetEditBoxHandles
       If Debug Then Txt.Print FuncName$
       Local ComboInfo As ComboBoxInfo
       ComboInfo.cbSize = SizeOf(ComboBoxInfo)
    
       GetComboBoxInfo(hFolder, ByVal VarPtr(ComboInfo))          'get data about combobox
       hFolderEdit = ComboInfo.hwndItem                           'handle to edit control of combobox
    
       GetComboBoxInfo(hInclude, ByVal VarPtr(ComboInfo))          'get data about combobox
       hIncludeEdit = ComboInfo.hwndItem                           'handle to edit control of combobox
    
       GetComboBoxInfo(hExclude, ByVal VarPtr(ComboInfo))          'get data about combobox
       hExcludeEdit = ComboInfo.hwndItem                           'handle to edit control of combobox
    
       GetComboBoxInfo(hSearch, ByVal VarPtr(ComboInfo))          'get data about combobox
       hSearchEdit = ComboInfo.hwndItem                           'handle to edit control of combobox
    
    End Sub
    
    'Thread Function GetFilesAndProcedures(ByVal x As Long) As Long
    Function GetFilesAndProcedures(ByVal x As Long) As Long
       If Debug Then Txt.Print FuncName$
       MousePtr 11
       QueryPerformanceCounter   qStart
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... getting procedures ..."
       ParentFolder = Trim$(ParentFolder,"\")
    
       If MergeFolders = 0 Then
          FolderCount = 0 : FileCount = 0
          ReDim Procedures(0), D(0), Files(0), Folders(0)
       End If
       CurrentProcedure = 0 : MaxLines = 0 : SetLVSource
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... getting file list ..."
       Dialog DoEvents
       GetFilesAndFolders ((ParentFolder))
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... extracting procedures ..."
       Dialog DoEvents
       ExtractProcedures
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... sorting ..."
       Dialog DoEvents
       If UBound(Procedures) Then CurrentProcedure = 1 Else CurrentProcedure = 0
       Array Sort D(1), TagArray Procedures()
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... building pointers ..."
       Dialog DoEvents
       BuildPointers
       SetLVSource
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Please wait ... applying syntax ..."
       Dialog DoEvents
    
       ListView Select hDlg, %IDC_ListView, CurrentProcedure
       Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
       SendMessage hRichEdit, %EM_SetSel, 0,0
       Txt.Print "GetFilesAndFolders"
       If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
       QueryPerformanceCounter   qStop
       Statusbar Set Text hdlg, %IDC_Statusbar, 1, 0, "  Folders: " + Format$(MergedFolderCount,"###,###,##0") + _
             "   Files: " + Format$(MergedFileCount,"###,###,##0") + DisplayStatus + "   Time: " + Format$((qStop-qStart)/qFreq,"###.0") & " seconds"
       MousePtr 0
       Control Set Focus hDlg, %IDC_ListView
    End Function
    
    Sub SearchFiles
       If Debug Then Txt.Print FuncName$
       MousePtr 11
       QueryPerformanceCounter   qStart
    
       Control Set Text hDlg, %IDC_RichEdit, ""
       MaxLines = 0 : SetLVSource
    
       SearchProcedures
       BuildPointers
       SetLVSource
    
       If UBound(Procedures) Then CurrentProcedure = 1 Else CurrentProcedure = 0
       ListView Select hDlg, %IDC_ListView, CurrentProcedure
       Control Set Text hDlg, %IDC_RichEdit, Procedures(D(CurrentProcedure).ptr)
       SendMessage hRichEdit, %EM_SetSel, 0,0
       Txt.Print "SearchFiles"
       If ApplySyntax Then MousePtr 11 : synApplySyntax : MousePtr 0
    
       QueryPerformanceCounter   qStop
    
       Control Set Focus hDlg, %IDC_SearchTerm
       SendMessage hSearch, %EM_SetSel, 0, -1
    
       Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Search Complete:    " + DisplayStatus + "   Time: " + Format$((qStop-qStart)/qFreq,"###.0") & " seconds"
       MousePtr 0
    End Sub
    
    Function BadComboValues() As Long
       If Debug Then Txt.Print FuncName$
       Control Get Text hDlg, %IDC_ParentFolder To ParentFolder
       Control Get Text hDlg, %IDC_IncludeEXT To IncludeEXT
       Control Get Text hDlg, %IDC_ExcludeName To ExcludeName
       If IsFalse IsFolder(ParentFolder) Then Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  Bad Folder!" : sBeep : Function = 1 : Exit Function
       If Trim$(IncludeEXT) = "" Then Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "  No Includes!" : sBeep : Function = 1 : Exit Function
    End Function
    
    Sub GetComboEditValues
       If Debug Then Txt.Print FuncName$
       Control Get Text hDlg, %IDC_ParentFolder To ParentFolder
       Control Get Text hDlg, %IDC_IncludeEXT To IncludeEXT
       Control Get Text hDlg, %IDC_ExcludeName To ExcludeName
       Control Get Text hDlg, %IDC_SearchTerm To SearchTerm
    End Sub
    
    Sub SetComboEditValues
       If Debug Then Txt.Print FuncName$
       Control Set Text hDlg, %IDC_ParentFolder, ParentFolder
       Control Set Text hDlg, %IDC_IncludeEXT, IncludeEXT
       Control Set Text hDlg, %IDC_ExcludeName, ExcludeName
       Control Set Text hDlg, %IDC_SearchTerm, SearchTerm
    End Sub
    
    Sub MRU(tempArray() As WStringZ * %Max_Path, TestValue$)
       If Debug Then Txt.Print FuncName$
       Local iResult As Long
       Array Scan tempArray(), = testValue$, To iResult
       Array Insert tempArray() For iResult, testValue$
    End Sub
    
    Sub ManageComboData
       If Debug Then Txt.Print FuncName$
       Local i, iCount As Long
    
       Control Get Text hDlg, %IDC_ParentFolder To ParentFolder
       Control Get Text hDlg, %IDC_IncludeEXT To IncludeEXT
       Control Get Text hDlg, %IDC_ExcludeName To ExcludeName
       Control Get Text hDlg, %IDC_SearchTerm To SearchTerm
    
       ComboBox Reset hDlg, %IDC_ParentFolder
       ComboBox Reset hDlg, %IDC_IncludeEXT
       ComboBox Reset hDlg, %IDC_ExcludeName
       ComboBox Reset hDlg, %IDC_SearchTerm
    
       MRU (CDataParent(),     (ParentFolder))  'adjust the array
       MRU (CDataInclude(),    (IncludeEXT))   'adjust the array
       MRU (CDataExclude(),    (ExcludeName))  'adjust the array
       MRU (CDataSearchTerm(), (SearchTerm))  'adjust the array
    
       iCount = 0
       For i = 1 To 5
          If Len(Trim$(CDataParent(i))) Then
             Incr iCount
             ComboBox Insert hDlg, %IDC_ParentFolder, iCount, CDataParent(i)
          End If
       Next i  'set ComboBox values
    
       iCount = 0
       For i = 1 To 5
          If Len(Trim$(CDataInclude(i))) Then
             Incr iCount
             ComboBox Insert hDlg, %IDC_IncludeEXT, iCount, CDataInclude(i)
          End If
       Next i
    
       iCount = 0
       For i = 1 To 5
          If Len(Trim$(CDataExclude(i))) Then
             Incr iCount
             ComboBox Insert hDlg, %IDC_ExcludeName, iCount, CDataExclude(i)
          End If
       Next i
    
       iCount = 0
       For i = 1 To 5
          If Len(Trim$(CDataSearchTerm(i))) Then
             Incr iCount
             ComboBox Insert hDlg, %IDC_SearchTerm, iCount, CDataSearchTerm(i)
          End If
       Next i
    
       Control Set Text hDlg, %IDC_ParentFolder, ParentFolder
       Control Set Text hDlg, %IDC_IncludeEXT, IncludeEXT
       Control Set Text hDlg, %IDC_ExcludeName, ExcludeName
       Control Set Text hDlg, %IDC_SearchTerm, SearchTerm
    End Sub
    
    Sub ResetComboBoxes
       If Debug Then Txt.Print FuncName$
    
       ComboBox Reset hDlg, %IDC_ParentFolder
       ComboBox Reset hDlg, %IDC_IncludeEXT
       ComboBox Reset hDlg, %IDC_ExcludeName
       ComboBox Reset hDlg, %IDC_SearchTerm
    
       Reset CDataParent(), CDataInclude(), CDataExclude(), CDataSearchTerm()
    
       ParentFolder = "c:\data\gbapps\gbtest"
       IncludeEXT   = ".bas .inc .gbs"
       ExcludeName  = "bak backup_"
       SearchTerm   = "case"
    
       SetComboEditValues
    
       CDataParent(1)     = ParentFolder
       ComboBox Insert hDlg, %IDC_ParentFolder, 1, CDataParent(1)
       CDataParent(2)     = "c:\data\gbapps"
       ComboBox Insert hDlg, %IDC_ParentFolder, 2, CDataParent(2)
       CDataParent(3)     = "c:\pbwin10"
       ComboBox Insert hDlg, %IDC_ParentFolder, 3, CDataParent(3)
    
       CDataInclude(1)    = IncludeEXT
       ComboBox Insert hDlg, %IDC_IncludeEXT, 1, CDataInclude(1)
       CDataInclude(2)    = ".bas"
       ComboBox Insert hDlg, %IDC_IncludeEXT, 2, CDataInclude(2)
       CDataInclude(3)    = ".inc"
       ComboBox Insert hDlg, %IDC_IncludeEXT, 3, CDataInclude(3)
       CDataInclude(4)    = ".gbs"
       ComboBox Insert hDlg, %IDC_IncludeEXT, 4, CDataInclude(4)
    
       CDataExclude(1)    = ExcludeName
       ComboBox Insert hDlg, %IDC_ExcludeName, 1, CDataExclude(1)
    
       CDataSearchTerm(1) = SearchTerm
       ComboBox Insert hDlg, %IDC_SearchTerm, 1, CDataSearchTerm(1)
       CDataSearchTerm(2) = "select"
       ComboBox Insert hDlg, %IDC_SearchTerm, 2, CDataSearchTerm(2)
       CDataSearchTerm(3) = "wm_command"
       ComboBox Insert hDlg, %IDC_SearchTerm, 3, CDataSearchTerm(3)
       CDataSearchTerm(4) = "wm_notify"
       ComboBox Insert hDlg, %IDC_SearchTerm, 4, CDataSearchTerm(4)
       CDataSearchTerm(5) = "wm_initdialog"
       ComboBox Insert hDlg, %IDC_SearchTerm, 5, CDataSearchTerm(5)
    
    End Sub
    
    Sub ManageDebug
    If Debug Then Txt.Print FuncName$
       Local hDebug As Long
       If Debug Then
          Txt.Window "Debug", 100,10,80,40 To hDebug '<--- choose your own startup location
          Txt.Print "TXT Window Opened"
       Else
          Txt.End
       End If
    End Sub
    
    Sub Backup
       If IsFile("procedures.txt")   Then FileCopy "procedures.txt", "backup\procedures.txt"
       If IsFile("procedures.dat")   Then FileCopy "procedures.dat", "backup\procedures.dat"
       If IsFile("gbprocedures.ini") Then FileCopy "gbprocedures.ini", "backup\gbprocedures.ini"
       Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "  Backup completed ... " + Time$
    End Sub
    
    Sub Restore
       If IsFile("backup\procedures.txt")   Then FileCopy "backup\procedures.txt", "procedures.txt"
       If IsFile("backup\procedures.dat")   Then FileCopy "backup\procedures.dat", "procedures.dat"
       If IsFile("backup\gbprocedures.ini") Then FileCopy "backup\gbprocedures.ini", "gbprocedures.ini"
       Restart = 1
       Dialog End hDlg
    End Sub
    Last edited by Gary Beene; Yesterday, 06:26 PM.

  • #2
    Needs Roca includes
    Kept getting error 53 in SYNINIT (which couldn't be found) so looked for ON ERROR (which also can't be found.)
    So removed #Debug Error On #Debug Display On and it started.
    This file apppears to be needed: OPEN EXE.PATH$ + "gbkeywords.txt" FOR INPUT AS #1
    When error 53 occurs it only displays first part of function name. Hopefully ON ERROR isn't needed.

    Typed in the root folder of where the procedures could be found and didn't want all folders under it (but that is how it works.)
    Would be nice to show the full path in second column if just looking for where the files are.

    Would be nice to copy and paste the found procedure to clipboard or better a merge file if multiple procedures are wanted.
    Would be nice if searching all subfolders was not required (but purpose of this program may not be for constructing programs.)

    I have a very old routine called PULL.BAS.
    When I wanted to put together a program I would select the procedure wanted and it appended into a work file.
    When done, a running program would be created from the work file.
    It works by searching through a list of modules (program names .bas files)

    The intent of this program may be different, but putting together programs by selecting functions is very valuable.
    I'm pretty sure another of your programs mght be better suited for that (since there are so many to choose from.)

    I use "Everything" and "NotePad++" to find things for merging into a program. Not the intent of this program.
    Removing duplicate functions is very dangerous because the same function name might be used in another program.
    I'd be extremely careful doing any mass delete or using a function that appears to be what you want if there are multiple copies.

    In a perfect world we would put functions in a common DLL to prevent rewriting.
    I have always liked runtime libraries instead of reinventing the wheel.

    https://duckduckgo.com instead of google

    Comment


    • #3
      Good morning, Mike!

      Thanks for taking a look!

      Yes, I should always put "Requires Jose Includes" in my code. I've used it exclusively for so long that I forget other's might not.

      I"ve put keywords.txt content into a function with Data statements - one less file to worry about.

      Regarding putting path in 2nd column ... I don't have a huge opinion on that. I didn't do that because the path widths means I have to scroll left and right to find the file name. If I showed path, in col 2, I'd need to make that column wider, I think..

      Copy to clipboard ... see RichEdit context menu

      Exclude Subfolders added ... but for me, the whole idea was to located procedures everywhere.

      Everything ... I knew it could search inside files but I've not used it for that. How well does that work for you?

      Mass delete? gbProcedures only has a copy of the procedures from the original file. Deletions are made from the copy. So if dupes are deleted, you can always rebuild.

      Also, just to clarify, there's no Save function (other than saving the temp copy between sessions).

      Yes, the DLL would be great. Maybe when i reach 70 in a couple of years I'll find the time!

      Revised code entered up in OP.

      Comment


      • #4
        Everything ... I knew it could search inside files but I've not used it for that. How well does that work for you?
        I use the free NotePad++ for finding something in a source file.
        Click Search, Find in files and fill in options.
        It works extremely well.
        https://duckduckgo.com instead of google

        Comment


        • #5
          Whoops ... forgot the code to exclude subfolders ... have it in just a few minutes ...

          Comment


          • #6
            Mike,
            So you don't use the in-file search capability of Everything? You use it just to find a file name, then use NotePad++ to search that file(s)?

            Comment


            • #7
              That is correct. I didn't even find an option to search within files using Everything.
              I use NotePad++ to find .BAS files and .INC files in a specified folder (but c:\*.* could be used.)
              https://duckduckgo.com instead of google

              Comment


              • #8
                Mike,

                OP#1 code updated to include "Exclude SubFolder" option ...

                Thanks again for the suggestions.

                The interface is getting a bit crowded but a toolbar would mean I have to include icons along with the source code. Life is complicated.

                Comment


                • #9
                  NotePad++ is great for creating a list of files containing what is searched for, but can't find how to view or copy a function.
                  If too many items on the toolbar, those buttons with an option to click on the right for a pulldown are nice.




                  https://duckduckgo.com instead of google

                  Comment


                  • #10
                    I just ran gbProcedures across my entire C: drive. I found 4K bas/inc files, split roughly equally between bas and inc files. There are about 57K procedures, half those were duplicates.

                    I'd guess that the inc file count is a bit misleading because many of the inc files are not useful for PowerBASIC coding.

                    4K *.bas/*.inc files is less than I might have expected. I work my whole life and I have only 4K code files? OR, I'm to be congratulated because I re-use procedures a lot?

                    What's in your wallet?

                    Comment


                    • #11
                      I just typed *.bas into Everything and got 6736. A ton of them start with Backup.
                      *.INC 6146.which is a surprise.
                      https://duckduckgo.com instead of google

                      Comment


                      • #12
                        Originally posted by Gary Beene View Post
                        Regarding putting path in 2nd column ... I don't have a huge opinion on that. I didn't do that because the path widths means I have to scroll left and right to find the file name. If I showed path, in col 2, I'd need to make that column wider, I think..
                        Knowing the path would be useful. How about adding a third column for that information?

                        Comment


                        • #13
                          Howdy, Stuart!

                          Yep, the path is already there - last column to the right. I didn't make it normally visible only to reduce the amount of space taken up by the ListView.

                          Date/Size/Path are the 3 extra columns that are hidden - must be horizontally scrolled into view.

                          Comment


                          • #14
                            I just reconstructed a program using only copy and paste into PBEDIT.
                            An include file (aes256.inc) was unavailable when attempting to open it in PbEdit until gbProcedures was closed.

                            Suggestions:
                            Option to copy a found procedure into clipboard xor select all.
                            Option to append a found procedure into a temp file so all wanted procedures can later be merged or pasted into a program.

                            This sure gives a great way to look at a current project when working in a single folder or construct a new program without programming.



                            https://duckduckgo.com instead of google

                            Comment


                            • #15
                              Other features in the CallBack ...

                              Double-click on a ListView line to open the file.

                              Click on a column header to autosize the column width to the items in the list.


                              Comment


                              • #16
                                Hey Mike!

                                More feedback, great!


                                >>>An include file (aes256.inc) was unavailable when attempting to open it in PbEdit until gbProcedures was closed.
                                That's surprising. I'm only displaying a list of bas/inc files. No files are opened. I'll go look to see if I can replicate what you see.


                                >>>Option to copy a found procedure into clipboard xor select all.
                                The RichEdit context menu has those. Do you mean something different?


                                >>>Option to append a found procedure into a temp file so all wanted procedures can later be merged or pasted into a program.
                                If I had a RichEdit context menu item that said "Append To Clipboard" would that match your suggestion? Or, would it be better to have checkboxes on all line items so that you can select/unselect at will before executing a command to export all to the clipboard? If the checkbox, then toggling display of only-checked procedures would be useful too. Otherwise it is a bit of a scrolling problem if selected procedures are widely spread.

                                Append to Clipboard would be the easiest to implement


                                >>>This sure gives a great way to look at a current project when working in a single folder or construct a new program without programming.
                                I guess it is kind of like being able to look into a "virtual DLL"

                                Comment


                                • #17
                                  Because it was so easy to do, I went ahead and updated the OP code to include "Append to Clipboard". But I'm open to a checkbox version.

                                  You first do a "Copy All", to reset/prime the clipboard. Then you use "Append To Clipboard" to append the current procedure to what is in the clipboard.

                                  I'll go test the issue you had with opening a file. Back soon ...

                                  Comment


                                  • #18
                                    And while I was at it, I added an "Open Path" to the RichEdit context menu to open the folder containing the file.

                                    Mike,
                                    When I double-click on a file, it opens just fine in PBEdit. Are you saying that it won't open for you? Or, did you try to open the file another way? Any more details?

                                    Comment


                                    • #19
                                      Mike,
                                      Of course, if you want to append to the clipboard, you'll probably also want a "Save Clipboard As" context menu too! Just added that to the OP code.

                                      Comment


                                      • #20

                                        When I double-click on a file, it opens just fine in PBEdit. Are you saying that it won't open for you? Or, did you try to open the file another way? Any more details?
                                        I have the PbEditor open to allow pasting functions into it from gbProcedures.
                                        When in the PbEdtior, right clicking on a line #INCLUDE "aes256.inc" the normal Open File "aes256.inc" appears.
                                        Clicking on aes256.inc brings up an error message box that file can't be accessed.
                                        Ending gbProcedures allows the file to be accessed.
                                        https://duckduckgo.com instead of google

                                        Comment

                                        Working...
                                        X