Tweet
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