Date: 02-16-2022
Return to Index
'This code extracts all words found in a code listing.
created by gbSnippets
'It ignores literal text (word between quotes) and comments
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Include "Win32API.inc"
%IDC_Button = 500
%IDC_TextIn = 501
%IDC_TextOut = 502
Global hDlg,hFont As Dword
Global WordList() As String
Function PBMain() As Long
Local temp$, style&
style& = %WS_TabStop Or %WS_Border Or %ES_WantReturn Or %ES_MultiLine
temp$ = "Sub MySub" + $CrLf + " s += " + $Dq + "text" + $Dq + $CrLf + " Call MyFunction 'comment" + $CrLf + "End Sub"
Dialog New Pixels, 0, "Extract Words From Code",300,300,505,230, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button,"Create Word List", 10,5,120,25
Control Add TextBox, hDlg, %IDC_TextIn,temp$, 10,35,240,190,style&, %WS_Ex_ClientEdge
Control Add TextBox, hDlg, %IDC_TextOut,"<output>", 260,35,240,190,style&, %WS_Ex_ClientEdge
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local temp$
Select Case Cb.Msg
Case %WM_InitDialog
Font New "Tahoma",10,0 To hFont
Control Set Font hDlg, %IDC_Button, hFont
Control Set Font hDlg, %IDC_TextIn, hFont
Control Set Font hDlg, %IDC_TextOut, hFont
Case %WM_Command
If Cb.Ctl = %IDC_Button And Cb.CtlMsg = %BN_Clicked Then
Control Get Text hDlg, %IDC_TextIn To temp$
Control Set Text hDlg, %IDC_TextOut, ScanCode(temp$)
End If
End Select
End Function
Function ScanCode(InText$) As String
Local pd As CHARRANGE, Oldpd As CHARRANGE, tBuff As TEXTRANGE, temp$
Local xWord,Buf,UCBuf As String
Local i,j,StopPos,lnLen As Long
Local wFlag As Byte, Letter As Byte Ptr
For J = 1 To ParseCount(InText$, $CrLf)
Buf = Parse$(InText$,$CrLf,J)
UCBuf = UCase$(Buf) + $Spc
If Len(Trim$(UCBuf))=0 Then Iterate For
lnLen = Len(UCBuf$)
Letter = StrPtr(UCBuf) : wFlag = 0
For I = 1 To Len(UCBuf)
Select Case @Letter
Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255,35 To 38, 48 To 57, 63, 95 'word characters
If wFlag = 0 Then wFlag = 1 : stopPos = I
Case 34 'string quotes -> "
stopPos = InStr(I + 1, UCBuf, Chr$(34)) 'Find match
If stopPos Then
StopPos = (StopPos - I + 1)
I = I + StopPos
Letter = Letter + StopPos
wFlag = 0
End If
Case 39 'comment character -> '
wFlag = 0
Exit For
Case Else 'word is ready
If wFlag = 1 Then
xWord = Mid$(Buf, stopPos, I - stopPos) 'Get word
If xWord = "REM" Then wFlag = 0 : Exit For
wFlag = 0
'--- do something with the word here ---
temp$ += $CrLf + xWord
'---------------------------------------
End If
End Select
Incr Letter
Next I
Next J
Function = LTrim$(temp$,$CrLf)
End Function
'gbs_01452
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm