Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Intelligent search function for WinApi include files - for PBCC

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

  • Intelligent search function for WinApi include files - for PBCC



    This code searches all include files in a specified directory for occurrences of a given keyword in names of Declarations, Functions, Subs, Macros, TypeVars and Equate and String literal definitions, or a subset of these.

    Many of you will not need this, but often when i look for something that is supposed to be in the WinApi include files, i feel rather lost. Frequently i have no clue where to start searching or what exactly to search for. Defining the search term too exact makes often that i miss what i was looking for, choosing it too loose brings up so much garbage that i can not see the forest from the trees anymore. Sometimes the WinApi help file is very useful, but there is a lot of valuable material in the include files that can be found only by searching these files. As i do not want to bother my fellow forum members with issues that i could have solved myself, i wrote an intelligent search function that does some parsing and searches only in names.

    The method used is totally straightforward, and uses no advanced features whatsoever, but thanks to the speed of modern computers and the efficiency of PB code the response is even then instantaneous.

    Arie Verheul

    --------------------------------------------------------------------------
    Revision jan 12,2009

    1. Function PBMain > duplicate exit condition in program loop removed
    2. Sub GetWinApiFiles > added: TempBuffer = "" to free memory

    --------------------------------------------------------------------------
    Compatability note d.d. jan 15, 2009

    Add metastatement #BREAK ON if compiled with PBCC 5
    --------------------------------------------------------------------------

    Well, for those who recognise the problem described above, here is the code:




    Code:
    '==========================================================================================
    '         SEARCH API - Intelligent search function for WinApi include files
    '
    '                             Written for  PBCC 4.04
    '
    '                             Arie Verheul, jan 2009
    ' ==========================================================================================
    '
    ' This code searches all include files in a specified directory for occurrences of a
    ' given keyword in names of Declarations, Functions, Subs, Macros, TypeVars, Equates,
    ' and String Literals, or a subset of these. The results are presented in the console
    ' window, where blocks and multiline items are shown in full.
    ' Results may be marked, and such marked items are copied to the clipboard.
    ' Marking an item also shows its line number.
    ' Ctrl-A is supported to select and copy all.
    '
    ' The searchterm may be entered through the clipboard, or if nothing suitable is found
    ' on the clipboard, through a user prompt. It may be preceded by %, $, Declare, Sub,
    ' Function, Macro or Type, which will immediately select the appropriate category.
    ' If such a clue is missing, the user is prompted for further information, which may
    ' be entered by means of the keyboard or the mouse.
    ' Pressing Esc, Enter, or mouse buttons, initiates a new search.
    '
    ' Because of the LIB and ALIAS clause in WinApi declarations, the variable list is often
    ' somewhere off the screen. Right clicking on such a declaration will show it nicely
    ' formatted, with each variable on a separate line. This formatted version is copied to
    ' the clipboard too. Clicking again lets you return to the original result list.
    '
    ' However, if the results are so numerous that they have to be presented on multiple pages,
    ' copying to the clipboard works page by page. In such a case marked results from a given
    ' page must be saved before continuing to a next page, or they will be overwritten.
    '
    ' The <Lib> option allows you to search for all declarations associated with a specified
    ' .DLL file. The use of this option excludes other options.
    '
    ' In the WinApi files there is exactly one function "wsPrintf", in User32.DLL, that uses
    ' CDECL variable passing convention, and because of the extra keyword will not be found
    ' when searching by DLL. I did not find it worthwile to complicate the search procedure
    ' for this single case, as it can always found by name, but you are warned.
    '
    ' Note that the WinApi directory may be specified either as a command line parameter,
    ' or through the string literal $WinApiPath. For details see Sub GetWinApiFiles.
     
    '===================================================================================
    #Dim All
    #Compile Exe "SearchApi.exe"
     
    ' Set $WinApiPath to actual WinApi directory,
    ' or enter directory as a command line parameter (and comment out string literal)
     
    $WinApiPath           = "C:\Program Files\PBCC\Winapi\"
     
    %MaxLen               = 63       ' Maximum accepted length of SearchTerm
     
    %PageWidth            = 256      ' Size of virtual console window
    %PageHeight           = 512
     
    %DefaultConsRows      = 5        ' Minimum console window height
    %ScrollIncr           = 10       ' Scrolling step for cursorkeys
     
    %NormalFColor         = 15       ' Console colors
    %HiLightFColor        = 10
    %FormatColor          = 10
    %SepColor             = 6        ' %SepColor must be different from all others
    %BGColor              = 0
     
    %FormatDeclareTopRow  = 2        ' Printing positions used for FormatDeclare routine
    %FormatDeclareLeft    = 3
    %FormatDeclareVarList = 20
     
    $AppName              = "Search WinApi"
    $Prompt1              = "Search term : "
    $Prompt2              = "Search for {F}unctions, {T}ypevars, {E}quates, {S}trings, {L}ib :"
    $OverflowMessage      = " !! Too many results - multiple pages "
    $NothingFound         = " Nothing found "
    $NoFilesFound         = "No include files found in "
     
    '-----------------------------------------------------------------------------------
    ' WinApi equates
     
    %CF_TEXT         = 1
    %GMEM_MOVEABLE   = 2
    %GMEM_ZEROINIT   = &H40
    %HWND_TOPMOST    = &HFFFFFFFF
    %SWP_SHOWWINDOW  = &H0040
     
    '-----------------------------------------------------------------------------------
     
    Type COORD
        x As Integer
        y As Integer
    End Type
     
    Type CONSOLE_FONT_INFO
        nFont As Dword
        dwFontSize As Coord
    End Type
     
    '-----------------------------------------------------------------------------------
    ' WinApi declarations
     
    Declare Function CloseClipboard              Lib   "USER32.DLL" Alias "CloseClipboard" () As Long
    Declare Function EmptyClipboard              Lib   "USER32.DLL" Alias "EmptyClipboard" () As Long
    Declare Function GetClipboardData            Lib   "USER32.DLL" Alias "GetClipboardData" (ByVal uFormat As Dword) As Dword
    Declare Function GetConsoleFontSize          Lib "KERNEL32.DLL" Alias "GetConsoleFontSize" (ByVal hConsoleOutput As Long, ByVal nFont As Long) As Dword
    Declare Function GetCurrentConsoleFont       Lib "KERNEL32.DLL" Alias "GetCurrentConsoleFont"(ByVal hConsoleOutput As Long, ByVal bMaximumWindow As Long, lpConsoleCurrentFont As CONSOLE_FONT_INFO ) As Long
    Declare Function GetLargestConsoleWindowSize Lib "KERNEL32.DLL" Alias "GetLargestConsoleWindowSize" (ByVal hConsoleOutput As Dword) As Dword
    Declare Function GlobalAlloc                 Lib "KERNEL32.DLL" Alias "GlobalAlloc" (ByVal wFlags As Dword, ByVal dwBytes As Dword) As Long
    Declare Function GlobalLock                  Lib "KERNEL32.DLL" Alias "GlobalLock" (ByVal hMem As Dword) As Dword
    Declare Function GlobalUnlock                Lib "KERNEL32.DLL" Alias "GlobalUnlock" (ByVal hMem As Dword) As Long
    Declare Function OpenClipboard               Lib   "USER32.DLL" Alias "OpenClipboard" (ByVal hWnd As Dword) As Long
    Declare Function SetClipboardData            Lib   "USER32.DLL" Alias "SetClipboardData" (ByVal dwFormat As Dword, ByVal hMem As Dword) As Dword
    Declare Function SetWindowPos                Lib   "USER32.DLL" Alias "SetWindowPos" (ByVal hWnd As Dword, ByVal hWndInsertAfter As Dword, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Dword) As Long
     
    '-----------------------------------------------------------------------------------
    ' Local declarations
     
    Declare Sub      ApplicationControl
    Declare Sub      ConsoleScreen
    Declare Sub      AdjustConsole       (DesiredRows As Long)
    Declare Sub      ScrollConsole       (ViewOption As Dword)
    Declare Sub      GetWinApiFiles
    Declare Sub      GetSearchInfo       (SearchTerm As Asciiz, Criterium As Asciiz, NumKeyWords As Long)
    Declare Sub      SearchBuffer
    Declare Sub      MarkItem            (FirstRow As Long, LastRow As Long)
    Declare Sub      FormatDeclare
    Declare Sub      DetermineItemLoc    (FirstRow As Long, LastRow As Long)
    Declare Function ReadFromClipBoard   () As String
    Declare Sub      WriteToClipBoard    (ResultBuffer As String)
    Declare Function CombineNibbles      (LoNibble As Byte, HiNibble As Byte) As Dword
    Declare Sub      WhichFile           (Position As Long, OriginOfCurrentFile As Long, LastLineInCurrentFile As Long)
    Declare Sub      Separator
    Declare Sub      HiLightPrint        (PrintStr As Asciiz, ColorToUse As Byte)
     
    '-----------------------------------------------------------------------------------
     
    Function PBMain () As Long
     
        Dim  FileBuffer (0) As Global String        ' Content of include files
        Dim  WinApiDir  (0) As Global String        ' File names of include files
        Dim  WinApiIndex(0) As Global Long          ' Position of each file in FileBuffer()
     
        Dim  NormalAttr     As Global Dword         ' Composite color attrbutes
        Dim  HiLightAttr    As Global Dword
        Dim  SeparatorAttr  As Global Dword
     
        Dim  ExitProgram    As Global Long          ' Flag to terminate application
     
        NormalAttr    = CombineNibbles (%NormalFColor, %BGColor)  ' Color screen attributes
        HiLightAttr   = CombineNibbles (%HiLightFColor,%BGColor)
        SeparatorAttr = CombineNibbles (%SepColor,     %BGColor)
     
        ConsoleScreen
        GetWinApiFiles
    
        While Not ExitProgram
            SearchBuffer
            Cls
        Wend                    
    
    End Function
     
    '-----------------------------------------------------------------------------------
     
    Sub ApplicationControl
     
        Local FirstRow, LastRow, LastTextLine As Long
        Local KeyInput As Dword
     
        LastTextLine = CursorY
     
        Do
            KeyInput = CvDwd(LSet$(WaitKey$,4 Using(Chr$(0))))   ' Input converted to Dword
                                                                 ' for easy sorting
            Select Case KeyInput
     
                Case &H1B,&HD                        ' Esc, Enter to initiate new search
                     Exit Sub
     
                Case &H3E00                          ' (Alt) F4 for exit
                    ExitProgram = -1
                    Exit Loop
     
                Case &H1                             ' Ctrl-A, select all
                    FirstRow = 1
                    LastRow  = LastTextLine
                    MarkItem FirstRow,LastRow
     
                Case &H104FFFF                       ' Left Mouse, mark or unmark item
     
                    If MouseY < LastTextLine And _
                       ScreenAttr(MouseY,1) <> SeparatorAttr Then
                           DetermineItemLoc FirstRow, LastRow
                           MarkItem FirstRow,LastRow
                    End If
     
                Case &H204FFFF                       ' Right Mouse, Format Declare
     
                    If MouseY < LastTextLine And _
                       ScreenAttr(MouseY,1) <> SeparatorAttr Then
                           FormatDeclare
                           AdjustConsole LastTextLine
                    End If
     
                Case &H4700 To &H5100                ' Cursor keys, Home, End, PgUp, PgDown
     
                    ScrollConsole KeyInput
     
            End Select
        Loop
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub ConsoleScreen
     
        ' Sets up the console window
     
        Local WindowSize                As Dword             ' Size in rows andd columns
        Local ConsX,ConsY               As Long              ' Left top location in pixels
        Local ConsWidth,ConsHeight      As Long              ' Size in rows and columns
        Local ClientWidth,ClientHeight  As Long              ' Desktop client in pixels
     
        WindowSize = GetLargestConsoleWindowSize (GetStdOut) ' HiWrd contains Rows (not needed)
     
        WindowSize = (Lo(Word, WindowSize)) - 1              ' LoWrd contains Cols
     
        Console Set Screen  %DefaultConsRows, WindowSize
        Console Set Virtual %PageHeight, %PageWidth
     
        Desktop Get Client To ClientWidth,ClientHeight
        Desktop Get Loc    To ConsX,ConsY
        Console Get Size   To ConsWidth,ConsHeight
     
        ConsX = ConsX + (ClientWidth - ConsWidth) \ 2        ' Divide the mismatch
     
                                                             ' Set window topmost
     
        SetWindowPos(ConsHndl,%HWND_TOPMOST,ConsX,ConsY,ClientWidth,ConsHeight,%SWP_SHOWWINDOW)
     
        Cursor Off
        Mouse 3
        Mouse On
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub AdjustConsole (DesiredRows As Long)
     
        ' Adjusts console size to actual needs
     
        Dim   FontData                   As CONSOLE_FONT_INFO
        Local ConsX,ConsY,FontHeight     As Long
        Local ConsWidth,ConsHeight       As Long    ' Size in pixels
        Local CurrentRows,CurrentCols    As Long    ' Size in Rows/Columns
        Local ClientWidth,ClientHeight   As Long    ' Desktop client size
     
        ' Collect info about current situation
     
        Console Get Loc    To ConsX,ConsY
        Console Get Size   To ConsWidth,ConsHeight
        Console Get Screen To CurrentRows,CurrentCols
        Desktop Get Client To ClientWidth,ClientHeight
     
        ' Determine height of console font
        ' Both functions below are not in (my copy of) the WinApi includes
     
        GetCurrentConsoleFont(GetStdOut, 0, ByVal VarPtr(FontData))
        FontHeight = Hi(Word,GetConsoleFontSize(GetStdOut, FontData.nFont))
     
        ' Calculate the difference with the current size to avoid frame overhead issues
     
        DesiredRows = Max&(DesiredRows, %DefaultConsRows)
     
        ConsHeight  = ConsHeight + FontHeight * (DesiredRows - CurrentRows)
     
        ConsHeight  = Min&(ConsHeight, ClientHeight - ConsY)   ' Keep scrollbars on the screen
        ConsWidth   = Min&(ConsWidth,  ClientWidth  - ConsX)
     
        SetWindowPos(ConsHndl,%HWND_TOPMOST,ConsX,ConsY,ConsWidth,ConsHeight,%SWP_SHOWWINDOW)
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub ScrollConsole (ViewOption As Dword)
     
        ' Provides scrolling from keyboard
     
        Local ConsRows, ConsCols       As Long     ' Console size in rows and columns
        Local ScrnTop, ScrnLeft        As Long     ' Console view point in rows and columns
        Local LowerLimit, RightLimit   As Long     ' View point may not exceed these values
        Local LastTextLine             As Long     ' Last content line
        Local Inc, NumAdjustments      As Long     ' Adjustment parameters
     
        LastTextLine = CursorY
     
        Console Get Screen To ConsRows, ConsCols   ' Get actual size and view,
        Console Get View   To ScrnTop,  ScrnLeft   ' might be changed by user
     
        LowerLimit = LastTextLine - ConsRows + 1   ' Limit scroll range to actual content size
        RightLimit = %PageWidth   - ConsCols + 1
     
        Select Case ViewOption
     
            Case &H4700 : ScrnTop  = 1 : ScrnLeft = 1            ' Home
     
            Case &H4F00 : ScrnTop  = LowerLimit : ScrnLeft = 1   ' End
     
            Case &H4900 : ScrnTop  = ScrnTop - ConsRows + 1      ' PgUp
     
            Case &H5100 : ScrnTop  = ScrnTop + ConsRows - 1      ' PgDown
     
            Case &H4800 : ScrnTop  = ScrnTop  - %ScrollIncr      ' Cursor Up
     
            Case &H5000 : ScrnTop  = ScrnTop  + %ScrollIncr      ' Cursor Down
     
            Case &H4B00 : ScrnLeft = ScrnLeft + %ScrollIncr      ' Cursor Left
     
            Case &H4D00 : ScrnLeft = ScrnLeft - %ScrollIncr      ' Cursor Right
     
        End Select
     
        ScrnTop  = Max&(ScrnTop, 1)
        ScrnTop  = Min&(ScrnTop, LowerLimit)
     
        ScrnLeft = Max&(ScrnLeft,1)
        ScrnLeft = Min&(ScrnLeft,RightLimit)
     
        ' Show whenever possible a full item at the top of screen, but limit the adjustment
        ' to not more than 4 lines to avoid problems with large blocks.
        ' Normally adjustment is upwards (Inc = -1), but for end of page it is downwards (Inc = 1).
     
        Inc = IIf (ScrnTop < LowerLimit,-1,1)
     
        Do While ScreenAttr(ScrnTop,1) <> SeparatorAttr
            ScrnTop = ScrnTop + Inc
            Incr NumAdjustments
        Loop Until NumAdjustments > 5
     
        Console Set View ScrnTop, ScrnLeft
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub GetWinApiFiles
     
        ' Loads all *.inc files from WinApi directory into global FileBuffer()
        ' File names are stored in global string array WinApiDir(),
        ' and their location in FileBuffer() in global WinApiIndex()
     
        Local WinApiPath   As String
        Local TempBuffer   As String
        Local NumFiles, I  As Long
     
        '-------------------------------------------------------------------------------
        ' Get WinApi path, first check if path is on command Line
     
        If Command$ <> "" Then
     
            WinApiPath = Command$
     
        '......................................................
        ' Path may be hard coded in string literal $WinApiPath
     
        #If %Def($WinApiPath)
     
        Else
            WinApiPath = $WinApiPath
        #EndIf
        '......................................................
     
        End If
     
        '-------------------------------------------------------------------------------
        ' Remove double quotes and leading and trailing spaces
        ' If last backslash is missing then add it
     
        WinApiPath = Trim$(WinApiPath, Any $Spc + $Dq)
     
        If Right$(WinApiPath,1) <> "\" Then WinApiPath = WinApiPath + "\"
     
        '-------------------------------------------------------------------------------
        ' Count number of files
     
        WinApiDir(0) = Dir$(WinApiPath + "*.inc")
     
        While Dir$ <> "" : Incr NumFiles : Wend
     
        '-------------------------------------------------------------------------------
        ' Show error message if path incorrect
     
        If IsFalse Numfiles Then
            Locate 2,4
            Print $NoFilesFound + $Dq + WinApiPath +$Dq
            WaitKey$
            ExitProgram = -1
            Exit Sub
        End If
     
        '-------------------------------------------------------------------------------
        ' Store file names in array WinApiDir()
     
        ReDim WinApiDir (NumFiles) As Global String
     
        WinApiDir(0) = Dir$(WinApiPath + "*.inc")
     
        For I = 1 To NumFiles
            WinApiDir(I) = Dir$
        Next I
     
        Array Sort WinApiDir()
     
        '-------------------------------------------------------------------------------
        ' Load files to FileBuffer() and store their length in WinApiIndex()
     
        ReDim FileBuffer  (NumFiles)  As Global String
        ReDim WinApiIndex (NumFiles)  As Global Long
     
        For I = 0 To NumFiles
     
            Open WinApiPath + WinApiDir(I) For Binary As #1
     
                Get$ 1, Lof(1), FileBuffer(I)
            Close 1
     
            ' Store number of lines per file
     
            WinApiIndex(I) = ParseCount(FileBuffer(I),$CrLf)
     
            ' Calculate cumulative number of lines to find location
     
            If I Then WinApiIndex(I) = WinApiIndex(I-1) + WinApiIndex(I)
        Next I
     
        '-------------------------------------------------------------------------------
        ' FileBuffer() now contains all .inc files, organised file by file
     
        TempBuffer = Join$(FileBuffer(),$CrLf)  ' Join all files in string TempBuffer
     
        I = ParseCount(TempBuffer,$CrLf)        ' Count total number of lines
     
        ' Redim FileBuffer to hold .inc files line by line
     
        ReDim FileBuffer(I) As Global String
     
        Parse TempBuffer,FileBuffer(),$CrLf
     
        ' FileBuffer() now contains all .inc files, organised line by line
    
        TempBuffer = ""
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub GetSearchInfo (SearchTerm As Asciiz, Criterium As Asciiz, NumKeyWords As Long)
     
        ' Collects user input for search function
     
        Local KeyInput    As String
        Local Result      As Asciiz * 8
        Local ConsName    As Asciiz * 64
        Local SearchInput As Asciiz * %MaxLen
        Local I           As Long
     
        '-------------------------------------------------------------------------------
        ' Get SearchTerm
     
        Page 2,2
        AdjustConsole %DefaultConsRows
        Color %NormalFColor,%BGColor
     
    '--------------
    GetSearchInput:
    '--------------
     
        ' Obtain search term
     
        Console Name Space$(1) + $AppName
     
        Do
            Cls
            SearchInput = Trim$(ReadFromClipBoard)
            Locate 2,5
            Print  $Prompt1;
            I = CursorX
            StdOut SearchInput + $Cr;
     
            If SearchInput = "" Then        ' If nothing on clipboard then prompt for input
     
                Do
                    Locate ,I
                    StdOut LSet$(SearchInput,%MaxLen) + $Cr;
                    KeyInput = WaitKey$
     
                    Select Case KeyInput
     
                        Case $Spc To "z"    ' Text characters
     
                            SearchInput = SearchInput + KeyInput
     
                        Case Chr$(8)        ' Backspace
     
                            Asc(SearchInput,Len(SearchInput)) = 0
     
                        Case Chr$(255,255,4,1),Chr$(13) ' Left mouse button, Enter
     
                            Exit Loop                   ' Accept
     
                       Case Chr$(255,255,4,2),Chr$(27),Chr$(0,62) ' Right mouse, Esc, F4
     
                            SearchTerm  = ""                      ' Exit application
                            ExitProgram = -1
                            Exit Sub
                    End Select
                Loop
            End If
        Loop Until SearchInput <> ""
     
        SearchInput = Trim$(SearchInput)
     
        I = InStr(-1,SearchInput,$Spc)        ' If more than one word use last
        SearchTerm = Mid$(SearchInput,I + 1)
     
        SearchTerm = Trim$(SearchTerm, Any($Spc + $Dq))
     
        If SearchTerm = "" Then Exit Sub
     
        '-------------------------------------------------------------------------------
        ' Display search term at the title bar
     
        ConsName   = Space$(1) + $AppName + " :  " + Trim$(SearchTerm)
     
        Console Name ConsName
     
        SearchTerm  = UCase$(SearchTerm)
        SearchInput = UCase$(SearchInput)
     
        '-------------------------------------------------------------------------------
        ' Find out what to search for
        ' If it is clear from SearchTerm then do not ask
     
        Result = ""
     
        If Left$(SearchInput,1) = "%"     Then Result = "E"
        If Left$(SearchInput,1) = "$"     Then Result = "S"
        If InStr(SearchInput,"TYPE "    ) Then Result = "T"  ' Note the space after keyword
        If InStr(SearchInput,"DECLARE " ) Then Result = "F"
        If InStr(SearchInput,"FUNCTION ") Then Result = "F"
        If InStr(SearchInput,"SUB "     ) Then Result = "F"
        If InStr(SearchInput,"MACRO "   ) Then Result = "F"
     
        '-------------------------------------------------------------------------------
        ' If not clear what to search for then ask the user
     
        If Result = "" Then
     
            '---------------------------------------------------------------------------
            ' Display prompt with highlighted initial chars
     
            Locate 4,5
     
            HiLightPrint $Prompt2, %HiLightFColor
     
            '---------------------------------------------------------------------------
            ' Obtain search option
     
            ' Input may be entered through keyboard or by mouseclick
            ' Pressing Esc or Right mouse button allows to jump out of loop
     
            Result = ""
     
            I = CursorX + 1                     ' Print default value
            Locate ,I
            Print "F";
            Console Set View 1,1
     
            '---------------------------------------------------------------------------
            Do
               KeyInput = UCase$(WaitKey$)
     
               Select Case KeyInput
     
                    Case "F","T","E","S","L"    ' Allow only these characters
     
                        If IsFalse InStr(Result,KeyInput) Then Result = Result + KeyInput
     
                    Case Chr$(8)                ' Backspace
     
                            Asc(Result,Len(Result)) = 0
     
                    Case Chr$(255,255,4,1)       ' Select with left mouse
     
                        If MouseY <> CursorY Then Iterate Loop ' No item was clicked
     
                        I = MouseX
     
                        While (ScreenAttr(MouseY,I) <> HiLightAttr) And I > 0
                            Decr I
                        Wend                     ' Find first highlighted character to the left
     
                        Result = Chr$(Screen(MouseY,I))
     
                        Exit Loop
     
                    Case Chr$(27),Chr$(255,255,4,2)
     
                        GoTo GetSearchInput      ' Jump out with Esc
     
                    Case Chr$(13) : Exit Loop    ' Accept with enter
     
                    Case Chr$(0,62)
                        ExitProgram = -1
                        Exit Sub
               End Select
     
               Locate ,I
               StdOut LSet$(Result,8) + $Cr;
            Loop
     
            If Result = "" Then Result = "F"     ' Default if nothing entered
        End If
     
        '-------------------------------------------------------------------------------
        ' Translate user input to Criterium string for later use in selection
        ' and display choice on title bar
     
        ConsName    = ConsName + "  >  Search for "
        Criterium   = ""
        NumKeyWords = 0
     
        If (InStr(Result, "L")) Then                ' <Lib> option excludes others
            Criterium   = "D"
            ConsName    = ConsName + ".DLL"
            NumKeyWords = 5                         ' DLL name is in word 5
        Else
            If (InStr(Result, "F")) Then
                Criterium   = "DFSM"
                ConsName    = ConsName + "Functions/"
                NumKeyWords = 3
            End If
     
            If (InStr(Result, "T")) Then
                Criterium   = Criterium + "T"
                ConsName    = ConsName  + "Typevars/"
                NumKeyWords = Max&(NumKeyWords,2)
            End If
     
            If (InStr(Result, "E")) Then
                Criterium   = Criterium + "%"
                ConsName    = ConsName  + "Equates/"
                NumKeyWords = Max&(NumKeyWords,1)
            End If
     
            If (InStr(Result, "S")) Then
                Criterium   = Criterium + "$"
                ConsName    = ConsName  + "String Literals"
                NumKeyWords = Max&(NumKeyWords,1)
            End If
     
            ConsName = RTrim$(ConsName,"/")
        End If
     
        Console Name ConsName
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub SearchBuffer
     
        ' This is the actual search function
     
        Local LastDisplayLine        As Long
        Local LastLineInCurrentFile  As Long
        Local OriginOfCurrentFile    As Long
        Local FirstLine              As Long
        Local NumKeyWords            As Long
        Local I, J, K                As Long
     
        Local SearchTerm             As Asciiz * (%maxLen)
        Local Criterium              As Asciiz * 8
        Local EvaluationStr          As Asciiz * 256
        Local Termination            As Asciiz * 16
        Local FirstChar              As String * 1
        Local MessageStr             As String
     
        GetSearchInfo SearchTerm, Criterium, NumKeyWords
     
        If ExitProgram Or (SearchTerm = "") Then Exit Sub
     
        Dim KeyWord(1 To NumKeyWords) As Asciiz * 64
     
        '-------------------------------------------------------------------------------
        Page  1,2                                                  ' Print to invisible page
        Cls
        Separator
        '-------------------------------------------------------------------------------
        ' Scan FileBuffer()
     
        For I = 0 To WinApiIndex(UBound(WinApiIndex()))
     
            EvaluationStr    = LTrim$(FileBuffer(I))
            If EvaluationStr = "" Then Iterate For                  ' Skip blank lines
            FirstChar        = UCase$(Left$(EvaluationStr,1))
     
            If IsFalse InStr(Criterium,FirstChar) Then Iterate For  ' Sort by first character
     
            ' From here all items have at least the correct first character
     
            Replace "'" With Chr$(0) In EvaluationStr               ' Remove comment
            EvaluationStr    = RTrim$  (EvaluationStr)
            EvaluationStr    = UCase$  (EvaluationStr)
     
            ' EvaluationStr is a normalised version of FileBuffer(I), intended for tests.
            ' It is stripped of comment and leading and trailing spaces
            ' and is converted to upper case.
     
            '---------------------------------------------------------------------------
            ' Remove double spaces, if present
     
            While InStr(EvaluationStr, Space$(2))
                Replace Space$(2) With Space$(1) In EvaluationStr
            Wend
     
            '---------------------------------------------------------------------------
            ' The search procedure uses first <NumKeyWords> words of each line for testing
     
            Parse EvaluationStr, KeyWord(), $Spc  ' Parse function exits when array full
     
            '---------------------------------------------------------------------------
            ' Do processing and determine if indeed something was found
            ' If a result is found, it is located from FirstLine trough I.
            ' FirstLine is set upfront, last line equals counting variable I.
     
            FirstLine = I
     
            Select Case FirstChar
     
                Case "$","%"                                 ' String literal, Equate
     
                    If IsFalse InStr (KeyWord(1), SearchTerm) Then Iterate For
     
                    If IsFalse InStr (EvaluationStr,"=" )     Then Iterate For
     
                    If InStr(EvaluationStr," _") Then        ' Multi line definition
     
                        GoTo ExtractContinuation
                    Else
                        GoTo DisplayItem                     ' Single line equate definition
                    End If
     
                '-----------------------------------------------------------------------
                Case "T"                                     ' Type declaration ?
     
                    If IsFalse InStr (KeyWord(2), SearchTerm) Then Iterate For
                    If KeyWord(1) <> "TYPE"  Then Iterate For
     
                    Termination = "END TYPE"
                    GoTo ExtractBlock
     
                '-----------------------------------------------------------------------
                Case "D"                                     ' Declaration ?
     
                    If IsFalse InStr (KeyWord(NumKeyWords), SearchTerm) Then Iterate For
                    If KeyWord(1) <> "DECLARE"   Then Iterate For
                    If NumKeyWords = 5 And KeyWord(4) <> "LIB" Then Iterate For
     
                    If InStr(EvaluationStr," _") Or InStr(EvaluationStr,",_") Then
                        GoTo ExtractContinuation
                    End If                                   ' Multi line declaration
     
                    GoTo DisplayItem                         ' Single line declaration
     
                '-----------------------------------------------------------------------
                Case "F"                                     ' Function ?
     
                    If IsFalse InStr (KeyWord(2), SearchTerm) Then Iterate For
                    If KeyWord(1) <> "FUNCTION"  Then Iterate For
     
                    If InStr(EvaluationStr,"=") Then Iterate For ' Return value
     
                    Termination = "END FUNCTION"             ' Extract function block in full
                    GoTo ExtractBlock
     
                '-----------------------------------------------------------------------
                Case "S"                                     ' Sub, Static ?
     
                    Termination = ""
     
                    Select Case KeyWord(1)
     
                        Case "SUB"
     
                            If IsFalse InStr (KeyWord(2), SearchTerm) Then Iterate For
                            Termination = "END SUB"
     
                        Case "STATIC"
     
                            If IsFalse InStr (KeyWord(3), SearchTerm) Then Iterate For
     
                            Termination = Switch$(KeyWord(2) = "SUB",     "END SUB",_
                                                  KeyWord(2) = "FUNCTION","END FUNCTION")
                    End Select
     
                    If Termination = "" Then Iterate For     ' Termination is used as a flag
     
                    GoTo ExtractBlock
     
                '-----------------------------------------------------------------------
                Case "M"                                     ' Macro ?
     
                    If KeyWord(1) <> "MACRO" Then Iterate For
     
                    K = IIf(KeyWord(2) = "FUNCTION",3,2)     ' Macro or Macro Function ?
     
                    If IsFalse InStr (KeyWord(K), SearchTerm) Then Iterate For
     
                    If InStr(EvaluationStr,"=") Then         ' Single line Macro
                        GoTo DisplayItem
                    Else
                        Termination = "END MACRO"
                        GoTo ExtractBlock                    ' Macro block
                    End If
     
            End Select
     
    '-------------------
    ExtractContinuation:
    '-------------------
     
            ' Extract multiline items in full and look for first line
            ' without continuation character
     
            Do
                Incr I
            Loop Until IsFalse(InStr(FileBuffer(I)," _") Or InStr(FileBuffer(I),",_"))
     
            GoTo DisplayItem
     
    '------------
    ExtractBlock:
    '------------
     
            ' Extract blocks in full and look for first occurrence of termination string
     
            Do
                Incr I
                EvaluationStr = UCase$(FileBuffer(I))
            Loop Until InStr (EvaluationStr,Termination)
     
    '-----------
    DisplayItem:
    '-----------
     
            '---------------------------------------------------------------------------
            ' Check for display overflow and, if needed, create a continuation page
     
            If CursorY + I - FirstLine + 3 > %PageHeight Then
     
                MessageStr = $OverflowMessage                     ' Note : LastLine = I
     
                Console Get Screen To J,K                         ' Get console width
     
                K = K - Len(MessageStr) - 2                       ' Column position for message
     
                Color %HiLightFColor,%BGColor
     
                LastDisplayLine = CursorY - 1                     ' Save cursor location
     
                    Locate 1,K               : Print MessageStr;
                    Locate LastDisplayLine,K : Print MessageStr;
     
                Locate LastDisplayLine, 1                         ' Restore cursor location
     
                Page 1,1                                          ' Swap page back
                AdjustConsole CursorY
                Console Set View 1,1
     
                ApplicationControl
     
                If ExitProgram Then Exit Sub
     
                LastLineInCurrentFile = 0      ' Force to display file name on continuation page
                Page 1,2                       ' Continue with remainder of search results
                Cls
                Separator
            End If
     
            '---------------------------------------------------------------------------
            ' Check if search proceeded to a next file
     
            If I > LastLineInCurrentFile Then
                WhichFile I, OriginOfCurrentFile, LastLineInCurrentFile
            End If
     
            '---------------------------------------------------------------------------
            ' Print Line number
     
            Color %BGColor,%BGColor            ' Line number is initially invisible
            Locate CursorY - 1, 2
            Print RSet$(Trim$(Str$(FirstLine - OriginOfCurrentFile)),5 Using "-");
            Color %NormalFColor,%BGColor
            Locate CursorY + 1, 1
     
            ' Print result
     
            For J = FirstLine To I
                StdOut FileBuffer(J)
            Next
     
            Separator
     
            '---------------------------------------------------------------------------
     
        Next I
     
        Page 1,1                               ' Swap page back
     
        If CursorY < 3 Then                    ' Nothing found
           Locate 1,3
           Color %NormalFColor,%BGColor
           Print $NothingFound;
        End If
     
        Locate CursorY - 1, 1                  ' Undo last return
        AdjustConsole CursorY
        Console Set View 1,1
     
        ApplicationControl
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub MarkItem (FirstRow As Long, LastRow As Long)
     
        ' Marks and unmarks selected items and collects them in ResultBuffer
        ' On each selection change, ResultBuffer is copied to the clipboard
     
        Local Row, Col, LastTextLine As Long
        Local CurrentRow, CurrentCol As Long
        Local FColor, RowAttr        As Long
        Local ResultBuffer           As String
     
        LastTextLine  = CursorY - 1  ' Last line is separator, last text line is one line above that
     
        Console Get View To CurrentRow,CurrentCol  ' When marking large blocks
                                                   ' the view needs to be restored afterwards
     
        PCopy 1,3                                  ' Needed to keep screen steady
        Page  1,3                                  ' when marking large blocks
     
        For Row = FirstRow - 1 To LastRow
     
            RowAttr = ScreenAttr(Row,1)
     
            If RowAttr = SeparatorAttr Then        ' Make line number visible
     
                 RowAttr = ScreenAttr(Row + 1,1)
                 FColor = IIf(RowAttr = NormalAttr,%SepColor,%BGColor)
                 Locate Row,2
                 Color FColor,%BGColor,5
            Else                                   ' Mark or unmark item
     
                 FColor = IIf(RowAttr = NormalAttr,%HiLightFColor,%NormalFColor)
                 Locate Row,1
                 Color  FColor,%BGColor,%PageWidth
            End If
        Next
     
        Locate LastTextLine + 1,1                  ' Restore cursor to LastTextLine
        Console Set View CurrentRow,CurrentCol
        Page 1,1
     
        ' --------------------------------------------------------------------------
        ' Collect marked items and copy them to clipboard
     
        ResultBuffer = ""
     
        For Row = 1 To LastTextLine
     
            If ScreenAttr(Row,1) = HiLightAttr Then
     
                For Col = 1 To %PageWidth
                    ResultBuffer = ResultBuffer + Chr$(Screen(Row,Col))
                Next Col
     
                ResultBuffer = RTrim$(ResultBuffer) + $CrLf
            End If
        Next Row
     
        WriteToClipBoard ResultBuffer
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub FormatDeclare
     
        ' Displays a sub/function declaration formatted on the screen
     
        Local FirstRow, LastRow As Long
        Local NumLines, VarLen  As Long
        Local Row, Col, TextLen As Long
        Local I, J, K           As Long
        Local StrBuffer         As String
        Local Result            As Asciiz * 512
        Local KeyWord           As Asciiz * 16
        Local Char              As Long
     
        Dim ParseArray(1 To 1)  As String
     
        '-------------------------------------------------------------------------------
        ' Read item from screen
     
        DetermineItemLoc FirstRow, LastRow
     
        For Row = FirstRow To LastRow
     
            Result = ""
     
            For Col = 1 To %PageWidth
                K = Screen(Row,Col)
                If K = 39 Then Exit For         ' Single quote, skip comment
                Result = Result + Chr$(K)
            Next
     
            Replace Chr$(32,95) With Chr$(32,0) In Result     ' Remove continuation char.
            Replace Chr$(44,95) With Chr$(44,0) In Result
     
            StrBuffer = StrBuffer + Trim$(Result) + $Spc
        Next
     
        '-------------------------------------------------------------------------------
        ' Check if it is indeed a Declaration
     
        If UCase$(Left$(StrBuffer,7)) <> "DECLARE" Then Exit Sub
     
        '-------------------------------------------------------------------------------
        ' Make sure that certain text characters become separated from keywords and variables
     
        For I = 1 To 5
            Char = Choose&(I,40,41,44,91,93)                            ' ( ) , [ ]
            Replace Chr$(Char) With Chr$(32,Char,32) In StrBuffer
        Next
     
        '-------------------------------------------------------------------------------
        ' Parse StrBuffer in separate words
     
        K = ParseCount(StrBuffer,$Spc)
     
        ReDim ParseArray(1 To K) As String
     
        Parse StrBuffer,ParseArray(),$Spc
     
        '-------------------------------------------------------------------------------
        ' Check for presence of listed keywords, change acording to table in Data statement below
        ' and insert markers "{}" for highlighted printing, and markers for parsing "|"
     
        For J = K To 1 Step -1
            If ParseArray(J) = "" Then Array Delete ParseArray(J)   ' Remove any empty elements
        Next
     
        For J = 1 To K                        ' Replace keywords according to table
            KeyWord = UCase$(ParseArray(J))
     
            For I = 1 To DataCount Step 2
     
                If Read$(I) = KeyWord Then ParseArray(J) = Read$(I + 1) : Exit For
            Next I
        Next J
     
        StrBuffer = Join$(ParseArray(),$Spc)  ' Join modified data
     
        Replace " ," With ","  In StrBuffer
        Replace " )" With ")"  In StrBuffer
     
        '-------------------------------------------------------------------------------
        ' Print first section
     
        Page 2,2
        Cls
     
        ' String buffer is parsed in three parts, using markers "|" that where inserted
        ' when changing keywords.
        ' Part 1 : From start to Alias
        ' Part 2 : From Alias to left bracket
        ' Part 3 : Remainder
     
        ReDim ParseArray(1 To 3) As String
        Parse StrBuffer, ParseArray(), "|"
     
        Console Get Screen To Row,Col      ' Get screen size
        Col = Col - %FormatDeclareLeft     ' Determine maximum line length
     
        I = Len(ParseArray(1)) - Tally(ParseArray(1), Any "{|}")
        J = Len(ParseArray(2)) - Tally(ParseArray(2), Any "{|}")
        K = Len(ParseArray(3)) - Tally(ParseArray(3), Any "{|}")
     
        Locate %FormatDeclareTopRow, %FormatDeclareLeft
     
        ' Find out how to print it all
     
        If I + J + K < Col Then               ' Does it all fit on one line ?
            Result = Join$(ParseArray(),"")
            HiLightPrint Result, %FormatColor
            GoTo ReadScreenToBuffer
     
        Else
     
            If I + J < Col Then               ' If not, up to the left bracket ?
     
                Result = ParseArray(1) + Trim$(ParseArray(2)) + "{ _}" + $Lf
                HiLightPrint Result, %FormatColor
     
                ' Remainder is variable list, see next section
     
            Else                              ' If not print up to "Alias" on first line
     
                HiLightPrint ParseArray(1) + "{ _}" + $Lf, %FormatColor
     
                If J + K < Col Then           ' Does all of the remainder fit on second line ?
     
                    Result = ParseArray(2) + ParseArray(3) + $Lf
                    Locate ,%FormatDeclareVarList
                    HiLightPrint Result, %FormatColor
                    GoTo ReadScreenToBuffer
     
                Else             ' If not print from "Alias" to left bracket on second line
     
                    Locate ,%FormatDeclareVarList
                    HiLightPrint Trim$(ParseArray(2)) + "{ _}" + $Lf, %FormatColor
     
                    ' Remainder is variable list, see next section
                End If
            End If
        End If
     
        '-------------------------------------------------------------------------------
        ' Parse variable list per variable
     
        Result    = ParseArray(3)
        If Result = "" Then GoTo ReadScreenToBuffer
     
        NumLines  = ParseCount(Result)                ' Default comma delimited fields
     
        ReDim ParseArray(1 To NumLines) As String
     
        Parse Result, ParseArray()
     
        '-------------------------------------------------------------------------------
        ' Determine maximum length of variable
     
        For I = 1 To Numlines
            ParseArray(I) = Trim$(ParseArray(I))
            VarLen = Max(VarLen, InStr(ParseArray(I),"{As}"))
        Next I
     
        '-------------------------------------------------------------------------------
        ' Print Variable and "As" part
     
        For I = 1 To Numlines
            Locate ,%FormatDeclareVarList
            Result = Extract$(ParseArray(I),"{As}")
            HiLightPrint Result, %FormatColor
     
            Locate ,%FormatDeclareVarList + VarLen
            Result = "{As }" + Remain$(ParseArray(I),"{As}")
            If I < NumLines Then Result = Result + ",{_}"
            Result = Result + $Lf
            HiLightPrint Result, %FormatColor
        Next I
     
    '------------------
    ReadScreenToBuffer:
    '------------------
     
        AdjustConsole CursorY
        Console Set View 1,1
     
        ' Read all into StrBuffer and copy it to the Clipboard
     
        StrBuffer = ""
     
        For Row = %FormatDeclareTopRow To CursorY
     
            For Col = %FormatDeclareLeft To %PageWidth
     
                StrBuffer = StrBuffer + Chr$(Screen(Row,Col))
            Next Col
     
            StrBuffer = RTrim$(StrBuffer) + $CrLf
        Next Row
     
        WriteToClipBoard StrBuffer
     
        '-------------------------------------------------------------------------------
        WaitKey$
        Page 1,1    ' Return to result list
     
    Exit Sub
    '-----------------------------------------------------------------------------------
    ' Highlighted keywords; list may be extended if needed
     
    Data AS,       {As}
    Data LONG,     {Long}
    Data DWORD,    {DWord}
    Data BYVAL,    {ByVal}
    Data ASCIIZ,   {AsciiZ}
    Data ASCIZ,    {AsciZ}
    Data ANY,      {Any}
    Data PTR,      {Ptr}
    Data SINGLE,   {Single}
    Data DOUBLE,   {Double}
    Data BYTE,     {Byte}
    Data WORD,     {Word}
    Data QUAD,     {Quad}
    Data INTEGER,  {Integer}
    Data DECLARE,  {Declare}
    Data SUB,      {Sub}
    Data FUNCTION, {Function}
    Data LIB,      {Lib}
    Data ALIAS,    |{Alias}
    Data OPTIONAL, {Optional}
    Data OPT,      {Opt}
    Data (,        (|
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub DetermineItemLoc (FirstRow As Long, LastRow As Long)
     
        ' Determine top and bottom row of item to mark
     
        FirstRow = MouseY
        LastRow  = MouseY
     
        While (ScreenAttr(FirstRow - 1,1) <> SeparatorAttr)
            Decr FirstRow
        Wend
     
        While (ScreenAttr(LastRow + 1,1)  <> SeparatorAttr)
            Incr LastRow
        Wend
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Function ReadFromClipBoard As String
     
        ' Reads a text string from the ClipBoard
     
        Local  CBPtr As Asciiz Ptr
     
        OpenClipboard 0
     
            CBPtr = GetClipboardData(%CF_TEXT)
            If Len(@CBPtr) < %MaxLen Then       ' If longer it is probably not a search term
                Function = @CBPtr
                EmptyClipBoard
            Else
                Function = ""
            End If
     
        CloseClipBoard
     
    End Function
     
    '-----------------------------------------------------------------------------------
     
    Sub WriteToClipBoard (ResultBuffer As String)
     
         ' Copies ResultBuffer to ClipBoard
     
         Local lpMem As Asciiz Ptr
         Local hMem  As Dword
     
         ' Request a memory block
     
         hMem    = GlobalAlloc(%GMEM_MOVEABLE Or %GMEM_ZEROINIT, Len(ResultBuffer) + 1)
     
         lpMem   = GlobalLock(hMem)    ' Temporarily lock the block and request a pointer to it
         @lpMem  = ResultBuffer        ' Copy text string
         GlobalUnlock hMem             ' Unlock memory block
     
         OpenClipboard 0
            EmptyClipBoard
            SetClipboardData %CF_TEXT, hMem          ' Transfer data handle to clipboard
         CloseClipboard
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Function CombineNibbles(LoNibble As Byte, HiNibble As Byte) As Dword
     
        ' Combines two half-byte values to one byte (used in color attributes)
        ' The byte is stored in a DWord
     
        LoNibble = LoNibble And 15
        HiNibble = HiNibble And 15
     
        Shift Left HiNibble,4
        Function = HiNibble Or LoNibble
     
    End Function
     
    '-----------------------------------------------------------------------------------
     
    Sub WhichFile (Position As Long, OriginOfCurrentFile As Long, LastLineInCurrentFile As Long)
     
        ' Inserts file names in result list
     
        Local Index As Long
     
        Array Scan WinApiIndex(), > Position, To Index
     
        Decr Index
     
        Color %NormalFColor,%BGColor
        Print "'" + CSet$($Spc + WinApiDir(Index) + $Spc, 50 Using"*")
        Separator
     
        OriginOfCurrentFile   = IIf(Index > 0,WinApiIndex(Index - 1) - 1,0)
        LastLineInCurrentFile = WinApiIndex(Index)
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub Separator
     
        ' Prints separator line
     
        Color %SepColor,%BGColor
        Print String$(%PageWidth - 1,"-")
     
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    Sub HiLightPrint(PrintStr As Asciiz, ColorToUse As Byte)
     
        ' Prints a string with highlighted sections
        ' Sections to highlight are enclosed in brackets { }
     
        Local Char  As String * 1
        Local I     As Long
     
            For I = 1 To Len(PrintStr)
     
                Char = Mid$(PrintStr,I,1)
     
                Select Case Char
                    Case "{"  : Color ColorToUse,%BGColor
                    Case "}"  : Color %NormalFColor,%BGColor
                    Case $Lf  : Print
                    Case Else : Print Char;
                End Select
            Next I
    End Sub
     
    '-----------------------------------------------------------------------------------
     
    ' END OF CODE
    Last edited by Arie Verheul; 15 Jan 2009, 02:22 PM. Reason: Compatability note
Working...
X