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