Build Procedure List

Category: Source Code Analysis

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
Global hDlg as Dword
 
Function PBMain() As Long
   Local style&
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
 
   Dialog New Pixels, 0, "Test Code",300,300,400,400, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   Control Add TextBox, hDlg, 150, SampleCode, 20,30,350,350, style&
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local temp$
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      Control Get Text hDlg, 150 To temp$
      ? "Procedure List:" + $crlf + BuildProcedureList(temp$)
   End If
End Function
 
Function BuildProcedureList(ProcListBuf As StringAs String
   Local i As Long, tmp$, w1$, w2$, w3$, w4$, r$
   Dim BufArray(ParseCount(ProcListBuf,$CrLf)-1) As String   'break input string into an array
   Parse ProcListBuf$, BufArray(), $CrLf
   For i = 0 To UBound(BufArray)
      tmp$ = Retain$(BufArray(i), Any Chr$(65 To 90, 95, 97 To 122, 48 To 57, $Spc, "()="))
      Replace Any "()" With "  " In tmp$
      While InStr(tmp$, "  ") : Replace "  " With " " In tmp$ : Wend  'remove all pairs of spaces
      w1$ = Parse$(tmp$," ",1) : w2$ = Parse$(tmp$," ",2) : w3$ = Parse$(tmp$," ",3) : w4$ = Parse$(tmp$," ",4)
      If LCase$(w1$+" "+w2$+" "+w3$) = "override property getThen r$=r$+$CrLf+w4$ : Iterate For
      If LCase$(w1$+" "+w2$+" "+w3$) = "override property setThen r$=r$+$CrLf+w4$ : Iterate For
      If LCase$(w1$+" "+w2$) = "macro function"                Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "callback function"             Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "thread function"               Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "class method"                  Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "override method"               Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "property get"                  Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$+" "+w2$) = "property set"                  Then r$=r$+$CrLf+w3$ : Iterate For
      If LCase$(w1$) = "union"                                 Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "macro"                                 Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "sub"                                   Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "functionAnd w2$ <> "="               Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "class"                                 Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "methodAnd w2$ <> "="                 Then r$=r$+$CrLf+w2$ : Iterate For
      If LCase$(w1$) = "interface"                             Then r$=r$+$CrLf+w2$ : Iterate For
   Next i
   Function = Trim$(r$,$CrLf)
End Function
 
Function SampleCode() As String
   Local temp$
   '4 word possibilities
   temp$ = temp$ + $crlf + "Override Property Get myOPG"
   temp$ = temp$ + $crlf + "Override Property Set myOPS"
 
   '3 word possibilities
   temp$ = temp$ + $crlf + "Macro Function myMacroFunction"
   temp$ = temp$ + $crlf + "CallBack Function myCallbackFunction"
   temp$ = temp$ + $crlf + "Thread Function myThreadFunction"
   temp$ = temp$ + $crlf + "Class Method myClassMethod"
   temp$ = temp$ + $crlf + "Override Method myOverrideMethod"
   temp$ = temp$ + $crlf + "Property Get myPropertyGet"
   temp$ = temp$ + $crlf + "Property Set myPropertySGet"
 
   '2 word possibilities
   temp$ = temp$ + $crlf + "Union myUnion"
   temp$ = temp$ + $crlf + "Macro myMacro"
   temp$ = temp$ + $crlf + "Sub mySub"
   temp$ = temp$ + $crlf + "Function myFunction"
   temp$ = temp$ + $crlf + "Thread myThread"       'invalid
   temp$ = temp$ + $crlf + "Callback myCallback"   'invalid
   temp$ = temp$ + $crlf + "Class myClass"
   temp$ = temp$ + $crlf + "Method myMethod"
   temp$ = temp$ + $crlf + "Interface myInterface"
   temp$ = temp$ + $crlf + "Override myOverride"    'invalid
   temp$ = temp$ + $crlf + "Property myProperty"    'invalid
 
   temp$ = temp$ + $crlf + "Function=50"        'code should ignore
   temp$ = temp$ + $crlf + "    Function = 10"  'code should ignore
   temp$ = temp$ + $crlf + "Method=50"          'code should ignore
   temp$ = temp$ + $crlf + "    Method = 10"    'code should ignore
   Function = Trim$(temp$,$crlf)
End Function
 
'gbs_01078
'Date: 03-10-2012


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