dim i& dim i as long dim i as global long dim i as static long local i as.. global i as.. static i as..
' ' Source Code Checker - Looks for Un-Used Subs, Functions, ' And variables. ' ' Compile wiht PBCC/2.0 ' ' ' ' Usage: CheckIt <BASFILENAME> ' ' Program will output a file called CHECKIT.TXT with info ' on un-used functions, subs, & variables. This program ' Will not SCAN Include files that are not in the current ' calling directory or that do not have full path names ' in the #Include statement. ' ' This program will not process Conditional Compiling ' statements with the exception of #IF 0 blocks. If the ' #IF statement is followed by anything other than 0 then ' this program will ignore it. ' ' The output will show the SUB,FUNCT,or VAR name followed by ' [FilName.BAS:565] where the number after the : is the line ' number in the file name before it. ' ' Dontated to the public domain by Scott Slater ' [email protected] ' ' %VERBOSE = 1 ' 1 = Print To Screen, 0 = Screen Print OFF #Dim All Type InfoStruct zName As Asciiz * 256 IsUsed As Dword InFile As Asciiz * 256 InProc As Asciiz * 256 LineNum As Dword End Type ' Process Source File SF Sub Process(SF As String) Dim lVars(1:1) As InfoStruct ' Un-Used Locals Dim Vars(1:1) As InfoStruct ' All Locals in Current Proc (TEMP) Dim gVars(1:1) As InfoStruct ' All Globals Dim Functs(1:1) As InfoStruct ' All Functions Dim Subs(1:1) As InfoStruct ' All Subs Dim Incl(1:1) As InfoStruct ' All Include Files Local zWork As Asciiz * 256 Local sTemp As String Local sWork As String Local InWhich As String ' Curr Proc Name Local CurrFile As String ' Curr File Name Local i As Dword Local j As Dword Local iVars As Dword ' # of Vars Local ilVars As Dword ' # of lVars Local igVars As Dword ' # of gVars Local iFuncts As Dword ' # of Functs Local iSubs As Dword ' # of Subs Local iIncl As Dword ' # of Incl Local hFile As Dword ' File Handle Local DblQuote As Dword ' Double-Quote Flag Local CurrPos As Dword Local CurrLine As Dword Local TimesThru As Dword ' Pass # for Curr Job Local FoundIt As Byte ' Var,Sub,Func Flag Local InProc As Byte ' Flag whether or not we are in a proc Local If_Zero As Byte ' we are currently in an #IF 0 block Local In_Type As Byte ' Processing a TYPE structure Local pWork As Byte Ptr ' Pointer to zWork Local UnUsedNm As String * 40 ' For Padding in Report pWork = VarPtr(zWork) ' Point to zWork hFile = FreeFile ' Get a Free Handle InProc = 0 ' We're not in a Proc TimesThru = 1 ' First Pass Open SF For Input As hFile #If %VERBOSE Print "Begin File " & SF #EndIf CurrFile = SF ' Set Current File CurrLine = 0 ' Set Current Line Do If Eof(hFile) Then ' Find Next File to Process If iIncl Then Close hFile sWork = Incl(1) ' Get File Name Open sWork For Input As hFile ' Open it Array Delete Incl(1) ' Remove it from array Decr iIncl ' Lower the count If iIncl Then ' Resize the Array ReDim Preserve Incl(1:iIncl) As InfoStruct Else ReDim Incl(1:1) As InfoStruct End If CurrFile = sWork CurrLine = 0 #If %VERBOSE Print Print "Begin File " & CurrFile #EndIf Else ' If we have gone thru twice then exit otherwise ' do it again. If TimesThru = 1 Then ' Now check variables in PASS 2 TimesThru = 2 Close hFile Open SF For Input As hFile CurrFile = SF CurrLine = 0 ' Clear all variable arrays (They should be ' empty anyway) ReDim Vars(1:1) As InfoStruct iVars = 0 ReDim lVars(1:1) As InfoStruct ilVars = 0 ReDim gVars(1:1) As InfoStruct igVars = 0 ReDim Incl(1:1) As InfoStruct iIncl = 0 #If %VERBOSE Print Print "Begin File " & CurrFile #EndIf Else Exit Loop End If End If End If sWork = InKey$ If sWork = Chr$(27) Then Exit Loop ' Abort if ESC pressed Line Input# hFile, sWork ' Get Line from file Incr CurrLine ' Up the line # count sWork = UCase$(Trim$(sWork, Any Chr$(9,32,0))) ' UCASE for comparisons If Len(sWork) = 0 Then Iterate ' Nothing There get another line! If Left$(sWork, 1) = "'" Then Iterate ' Comment If Left$(sWork, 4) = "REM " Then Iterate ' Comment If Left$(sWork, 8) = "DECLARE " Then Iterate ' Don't Care If Left$(sWork, 4) = "TYPE" Then ' Struct In_Type = 1 Iterate End If If Left$(sWork, 8) = "END TYPE" Then ' End Struct In_Type = 0 Iterate End If If In_Type Then ' Still Processing a TYPE Sturcture Iterate ' So ignore this line End If ' Handle #IF 0 Comment Blocks ' =================================================== If Left$(sWork, 5) = "#IF 0" Then Incr If_Zero If Left$(sWork, 5) = "$IF 0" Then Incr If_Zero If Left$(sWork, 5) = "#ELSE" Then If If_Zero Then Decr If_Zero Iterate End If If Left$(sWork, 5) = "$ELSE" Then If If_Zero Then Decr If_Zero Iterate End If If Left$(sWork, 6) = "#ENDIF" Then If If_Zero Then Decr If_Zero Iterate End If If Left$(sWork, 6) = "$ENDIF" Then If If_Zero Then Decr If_Zero Iterate End If If If_Zero Then Iterate ' In Block Get another line ' End #IF 0 Comment Handling ' =================================================== ' Include Statement Save File if we can read it. If Left$(sWork, 8) = "#INCLUDE" Then sWork = Remain$(sWork, " ") sWork = Trim$(sWork) sWork = Extract$(sWork, " ") sWork = Remove$(sWork, Chr$(34)) If Len(Dir$(sWork)) Then ' Get Only ones we can find! Incr iIncl ReDim Preserve Incl(1:iIncl) As InfoStruct Incl(iIncl).zName = sWork End If Iterate End If If Left$(sWork, 8) = "$INCLUDE" Then sWork = Remain$(sWork, " ") sWork = Trim$(sWork) sWork = Extract$(sWork, " ") sWork = Remove$(sWork, Chr$(34)) If Len(Dir$(sWork)) Then ' Get Only ones we can find! Incr iIncl ReDim Preserve Incl(1:iIncl) As InfoStruct Incl(iIncl).zName = sWork End If Iterate End If ' Leaving Proceedure, so Clear local Vars() ' and save any unused ones to lVars() If Left$(sWork, 12) = "END FUNCTION" Then 'Outside Proceedure InProc = 0 If iVars Then j = ilVars For i = 1 To iVars If Vars(i).IsUsed = 0 Then Incr j ReDim Preserve lVars(1:j) As InfoStruct lVars(j).zName = Vars(i).zName lVars(j).IsUsed = Vars(i).IsUsed lVars(j).InFile = Vars(i).InFile lVars(j).LineNum = Vars(i).LineNum lVars(j).InProc = Vars(i).InProc End If Next i ilVars = j iVars = 0 ReDim Vars(1:1) As InfoStruct End If End If If Left$(sWork, 7) = "END SUB" Then InProc = 0 If iVars Then j = ilVars For i = 1 To iVars If Vars(i).IsUsed = 0 Then Incr j ReDim Preserve lVars(1:j) As InfoStruct lVars(j).zName = Vars(i).zName lVars(j).IsUsed = Vars(i).IsUsed lVars(j).InFile = Vars(i).InFile lVars(j).LineNum = Vars(i).LineNum lVars(j).InProc = Vars(i).InProc End If Next i ilVars = j iVars = 0 ReDim Vars(1:1) As InfoStruct End If End If If Left$(sWork, 10) = "FUNCTION =" Then sWork = Mid$(sWork,11) End If If Left$(sWork, 9) = "FUNCTION=" Then sWork = Mid$(sWork,10) End If ' Entering Proceedure If Left$(sWork, 9) = "FUNCTION " Then InProc = 1 If TimesThru = 2 Then Iterate ' Second Pass so do no more sWork = Mid$(sWork,9) sWork = Trim$(sWork) ' Remove Leading Space sTemp = Extract$(sWork, Any " (") ' Get Only Function Name If sTemp = "PBMAIN" Then Iterate End If If sTemp = "WINMAIN" Then Iterate End If If sTemp = "LIBMAIN" Then Iterate End If If sTemp <> "=" Then Incr iFuncts ReDim Preserve Functs(1:iFuncts) As InfoStruct Functs(iFuncts).zName = sTemp Functs(iFuncts).InFile = CurrFile Functs(iFuncts).LineNum = CurrLine InWhich = sTemp Iterate End If End If If Left$(sWork, 18) = "CALLBACK FUNCTION " Then InProc = 1 If TimesThru = 2 Then Iterate sWork = Mid$(sWork,18) sWork = Trim$(sWork) ' Remove Leading Space sWork = Extract$(sWork, Any " (") ' Get Only Sub Name Incr iFuncts ReDim Preserve Functs(1:iFuncts) As InfoStruct Functs(iFuncts).zName = sWork Functs(iFuncts).InFile = CurrFile Functs(iFuncts).LineNum = CurrLine InWhich = sWork Iterate End If If Left$(sWork, 4) = "SUB " Then InProc = 1 If TimesThru = 2 Then Iterate Incr iSubs ReDim Preserve Subs(1:iSubs) As InfoStruct sWork = Mid$(sWork,4) sWork = Trim$(sWork) ' Remove Leading Space sWork = Extract$(sWork, Any " (") ' Get Only Sub Name Subs(iSubs).zName = sWork Subs(iSubs).InFile = CurrFile Subs(iSubs).LineNum = CurrLine InWhich = sWork Iterate End If If TimesThru = 1 Then Iterate ' We only want Subs & Functs ' on the first pass ' Local Variable Processing If Left$(sWork, 4) = "DIM " Then If InProc = 0 Then Iterate sWork = Mid$(sWork,4) sWork = Extract$(sWork,"REM") sWork = Extract$(sWork,"'") For i = 1 To ParseCount(sWork,",") Incr iVars ReDim Preserve Vars(1:iVars) As InfoStruct sTemp = Parse$(sWork,",",i) sTemp = Trim$(sTemp) sTemp = Extract$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = Instr(sTemp, Any "&%@!#$?") If CurrPos > 1 Then sTemp = Left$(sTemp, CurrPos-1) End If Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich Next i Iterate End If If Left$(sWork, 7) = "STATIC " Then If InProc = 0 Then Iterate sWork = Mid$(sWork,7) sWork = Extract$(sWork,"REM") sWork = Extract$(sWork,"'") For i = 1 To ParseCount(sWork,",") Incr iVars ReDim Preserve Vars(1:iVars) As InfoStruct sTemp = Parse$(sWork,",",i) sTemp = Trim$(sTemp) sTemp = Extract$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = Instr(sTemp, Any "&%@!#$?") If CurrPos > 1 Then sTemp = Left$(sTemp, CurrPos-1) End If Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich Next i Iterate End If If Left$(sWork, 6) = "LOCAL " Then If InProc = 0 Then Iterate sWork = Mid$(sWork,6) sWork = Extract$(sWork,"REM") sWork = Extract$(sWork,"'") For i = 1 To ParseCount(sWork,",") Incr iVars ReDim Preserve Vars(1:iVars) As InfoStruct sTemp = Parse$(sWork,",",i) sTemp = Trim$(sTemp) sTemp = Extract$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = Instr(sTemp, Any "&%@!#$?") If CurrPos > 1 Then sTemp = Left$(sTemp, CurrPos-1) End If Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich Next i Iterate End If ' Global Variable Processing If Left$(sWork, 7) = "GLOBAL " Then If InProc = 1 Then Iterate sWork = Mid$(sWork,7) sWork = Extract$(sWork,"REM") sWork = Extract$(sWork,"'") For i = 1 To ParseCount(sWork,",") Incr igVars ReDim Preserve gVars(1:igVars) As InfoStruct sTemp = Parse$(sWork,",",i) sTemp = Trim$(sTemp) sTemp = Extract$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = Instr(sTemp, Any "&%@!#$?") If CurrPos > 1 Then sTemp = Left$(sTemp, CurrPos-1) End If gVars(igVars).zName = sTemp gVars(igVars).InFile = CurrFile gVars(igVars).LineNum = CurrLine Next i Iterate End If ' Ok, it's a regular line of Code... Process it If InProc = 0 Then Iterate ' Make Sure we are in a SUB for FUNCT ' Step 1, Remove Quoted Strings sTemp = "" zWork = sWork DblQuote = 0 For i = 0 To Len(zWork)-1 If @pWork[i] = 34 Then ' Quote Mark If DblQuote Then DblQuote = 0 Else DblQuote = 1 End If ElseIf DblQuote = 0 Then ' Outside of Quotes sTemp = sTemp & Chr$(@pWork[i]) End If Next i ' Step 2, Remove Comments i = Instr(sTemp,Chr$(39)) If i Then sTemp = Left$(sTemp,i-1) End If sTemp = Extract$(sTemp,Chr$(39)) sTemp = Extract$(sTemp,"REM") sWork = sTemp ' Step 3, Separate all keywords and varaible/sub/func names For i = 1 To ParseCount(sWork, Any ".()[],=+-*/\: ") sTemp = Parse$(sWork, Any ".()[],=+-*/\: ",i) sTemp = Trim$(sTemp) If Val(sTemp) > 0 Then Iterate ' Skip Numbers If Len(sTemp) = 0 Then Iterate Do If Left$(sTemp,1) = "@" Then sTemp = Mid$(sTemp,2) Else sTemp = Extract$(sTemp, Any "&%@!#$?") Exit Loop End If Loop #If %VERBOSE Print "+"; #EndIf ' Check Local Variable's First FoundIt = 0 If iVars Then For j = 1 To iVars If Trim$(UCase$(sTemp)) = Trim$(UCase$(Vars(j).zName)) Then Incr Vars(j).IsUsed FoundIt = 1 #If %VERBOSE Print "L"; #EndIf Exit For End If Next j If FoundIt Then Iterate For End If ' Next check Global Variables If igVars Then For j = 1 To igVars If Trim$(UCase$(sTemp)) = Trim$(UCase$(gVars(j).zName)) Then Incr gVars(j).IsUsed FoundIt = 1 #If %VERBOSE Print "G"; #EndIf Exit For End If Next j If FoundIt Then Iterate For End If ' Check Sub Names Next If iSubs Then For j = 1 To iSubs If Trim$(UCase$(sTemp)) = Trim$(UCase$(Subs(j).zName)) Then Incr Subs(j).IsUsed FoundIt = 1 #If %VERBOSE Print "S"; #EndIf Exit For End If Next j If FoundIt Then Iterate For End If ' Last Check Function Names If iFuncts Then For j = 1 To iFuncts If Trim$(UCase$(sTemp)) = Trim$(UCase$(Functs(j).zName)) Then ' Make Sure we're not in the current function of the ' same name... If Trim$(UCase$(sTemp)) <> Trim$(UCase$(InWhich)) Then Incr Functs(j).IsUsed #If %VERBOSE Print "F"; #EndIf Exit For End If End If Next j End If Next i Loop Close hFile #If %VERBOSE Print #EndIf ' Now Prepare a Report of what we've found out! Open "CheckIt.TXT" For Output As hFile sWork = String$(80,"*") #If %VERBOSE Print sWork Print #EndIf Print# hFile, sWork Print# hFile, "" sWork = "Report of Un-Used Variables, Subs, & Functions for " & SF Print# hFile, sWork #If %VERBOSE Print sWork #EndIf sWork = "And Its INCLUDE files that were able to be located." Print# hFile, sWork Print# hFile, "" #If %VERBOSE Print sWork Print " File CheckIt.TXT contains this report also." #EndIf sWork = String$(80,"*") Print# hFile, sWork #If %VERBOSE Print sWork #EndIf sWork = "++++[ UN-USED FUNCTIONS ] +++++" Print# hFile, "" Print# hFile, sWork Print# hFile, "" #If %VERBOSE Print Print sWork Print #EndIf If iFuncts Then For i = 1 To iFuncts If Functs(i).IsUsed = 0 Then UnUsedNm = "FUNCTION " & Functs(i).zName sWork = UnUsedNm & " [" & Functs(i).InFile & ":" & _ Format$(Functs(i).LineNum) & "]" #If %VERBOSE Print sWork #EndIf Print# hFile, sWork End If Next i End If sWork = "++++[ UN-USED SUBS ] +++++" Print# hFile, "" Print# hFile, sWork Print# hFile, "" #If %VERBOSE Print Print sWork Print #EndIf If iSubs Then For i = 1 To iSubs If Subs(i).IsUsed = 0 Then UnUsedNm = "SUB " & Subs(i).zName sWork = UnUsedNm & " [" & Subs(i).InFile & ":" & _ Format$(Subs(i).LineNum) & "]" #If %VERBOSE Print sWork #EndIf Print# hFile, sWork End If Next i End If sWork = "++++[ UN-USED GLOBAL VARIABLES ] +++++" Print# hFile, "" Print# hFile, sWork Print# hFile, "" #If %VERBOSE Print Print sWork Print #EndIf If igVars Then For i = 1 To igVars If gVars(i).IsUsed = 0 Then UnUsedNm = gVars(i).zName sWork = UnUsedNm & " [" & gVars(i).InFile & ":" & _ Format$(gVars(i).LineNum) & "]" #If %VERBOSE Print sWork #EndIf Print# hFile, sWork End If Next i End If sWork = "++++[ UN-USED LOCAL VARIABLES ] +++++" Print# hFile, "" Print# hFile, sWork Print# hFile, "" #If %VERBOSE Print Print sWork Print #EndIf If ilVars Then For i = 1 To ilVars If lVars(i).IsUsed = 0 Then UnUsedNm = lVars(i).zName sWork = UnUsedNm & " [" & lVars(i).InFile & ":" & _ Format$(lVars(i).LineNum) & "]" #If %VERBOSE Print sWork #EndIf Print# hFile, sWork End If Next i End If Print# hFile, "" Print# hFile, "" #If %VERBOSE Print Print Print "Finished checking " & CurrFile #EndIf Close hFile End Sub Function PbMain Local Source As String Source = UCase$(Command$) If Len(Source) = 0 Then Print Print "PowerBASIC Source Code Checker. Checks for Un-Used Variables, Subs," Print "and Functions. Reports to a file called CheckIt.TXT. Public Domain" Print "by Scott Slater ([email protected])" Print Print Print "Usage: CheckIt <PowerBASIC File Name>" Print Print Exit Function End If If Right$(Source,4) <> ".BAS" Then If Instr(Source, ".") Then Print "Source File MUST be a PowerBASIC file with the .BAS extension." Exit Function End If Source = Source & ".BAS" End If If Len(Dir$(Source)) Then Process Source End If End Function
it'll help other people like me when we go to write add-on code 
Tweet
...........
sTemp = Extract$(sWork, Any " (") ' Get Only Function Name
If sTemp = "PBMAIN" Then
Iterate
End If
If sTemp = "WINMAIN" Then
Iterate
End If
If sTemp = "LIBMAIN" Then
Iterate
End If
If sTemp <> "=" Then
...........
CHANGE TO:
............
sTemp = Extract$(sWork, Any " (") ' Get Only Function Name
If sTemp = "PBMAIN" Then
InWhich = sTemp
Iterate
End If
If sTemp = "WINMAIN" Then
InWhich = sTemp
Iterate
End If
If sTemp = "LIBMAIN" Then
InWhich = sTemp
Iterate
End If
If sTemp <> "=" Then
...........
sWork = Incl(1) ' Get File Name
sWork = Incl(1).zName ' Get File Name
DIM Ht(32,1) AS LONG
^^
''************************************************************************ ' Source Code Checker - Looks for Un-Used Subs, Functions, And variables. ' ' Program will output a file called CHECKIT.TXT with info ' on un-used functions, subs, & variables. This program ' Will not SCAN Include files that are not in the current ' calling directory or that do not have full path names ' in the #Include statement. ' ' This program will not process Conditional Compiling ' statements with the exception of #IF 0 blocks. If the ' #IF statement is followed by anything other than 0 then ' this program will ignore it. ' ' The output will show the SUB,FUNCT,or VAR name followed by ' [FilName.BAS:565] where the number after the : is the line ' number in the file name before it. ' ' Dontated to the public domain by Scott Slater [email protected] ' #COMPILE EXE "CheckIt.exe" #REGISTER NONE #DIM ALL 'xConfirm 4000 ' PreCompile Parser 'xErrors 5000 ' PreCompile Parser Show Errors TYPE InfoStruct zName AS ASCIIZ * 256 IsUsed AS DWORD InFile AS ASCIIZ * 256 InProc AS ASCIIZ * 256 LineNum AS DWORD END TYPE GLOBAL lVars() AS InfoStruct ' Un-Used Locals GLOBAL Vars() AS InfoStruct ' All Locals in Current Proc (TEMP) GLOBAL gVars() AS InfoStruct ' All Globals GLOBAL Functs() AS InfoStruct ' All Functions GLOBAL Subs() AS InfoStruct ' All Subs GLOBAL Incl() AS InfoStruct ' All Include Files GLOBAL Files() AS STRING, Folders() AS STRING ' Global FileName String Arrays GLOBAL Wdth AS LONG, Hght AS LONG, BtnW AS LONG, BtnS AS LONG, BtnH AS LONG, FrmS AS LONG, FrmW AS LONG GLOBAL TxtS AS LONG, TxtW AS LONG, Disp AS LONG, TxtH AS LONG, Done AS LONG, hDlg AS LONG GLOBAL FilePathStr AS STRING, FileNameStr AS STRING, LineStr AS STRING, DestFile AS STRING GLOBAL zWork AS ASCIIZ * 256, sTemp AS STRING, sWork AS STRING, InWhich AS STRING ' Curr Proc Name GLOBAL CurrFile AS STRING, i AS DWORD, j AS DWORD, hFile AS DWORD, DblQuote AS DWORD, CurrPos AS DWORD, CurrLine AS DWORD Global iVars AS DWORD ' # of Vars Global ilVars AS DWORD ' # of lVars Global igVars AS DWORD ' # of gVars Global iFuncts AS DWORD ' # of Functs Global iSubs AS DWORD ' # of Subs Global iIncl AS DWORD ' # of Incl Global TimesThru AS DWORD ' Pass # for Curr Job Global FoundIt AS BYTE ' Var,Sub,Func Flag Global InProc AS BYTE ' Flag whether or not we are in a proc Global If_Zero AS BYTE ' we are currently in an #IF 0 block Global In_Type AS BYTE ' Processing a TYPE structure GLOBAL zWorkPtr AS BYTE PTR ' Pointer to zWork GLOBAL UnUsedNm AS STRING * 40 ' For Padding in Report #INCLUDE "WIN32API.INC" ' Basic Win API definitions '************************************************************************ ' Seperate FileName and FilePath, return Long Filename '************************************************************************ FUNCTION Seperate(pf AS STRING, p AS STRING, f AS STRING) AS LONG ' seperate LOCAL i AS LONG i = INSTR(-1, pf, any "\/") ' find last backslash p = LEFT$(pf, i) ' Path ShortName f = RIGHT$(pf, LEN(pf)-i) ' File ShortName f = DIR$(p+f) ' File LongName FUNCTION = i END FUNCTION '************************************************************************ ' GetDroppedFiles - Function Loads File/Folder names into the global arrays '************************************************************************ FUNCTION GetDroppedFiles( BYVAL hDrop AS LONG, Fi() AS STRING, Fo() AS STRING ) AS LONG 'returns %true, if any files where placed in Files LOCAL Count AS DWORD, i AS LONG, j AS LONG, k AS LONG, Pos AS LONG, TempStr AS STRING LOCAL fString AS ASCIIZ*%MAX_PATH Count = DRAGQUERYFILE(hDrop, &HFFFFFFFF&, "", BYVAL 0&) ' Get number of dropped files IF Count > 0 THEN ' Do we really need this check? REDIM Fi(Count) ' Make room in the global array REDIM Fo(Count) ' Make room in the global array FOR k = 1 TO Count fString = SPACE$(%MAX_PATH) 'clear zero terminators Pos = DRAGQUERYFILE(hDrop, k-1, fString, LEN(fString)-1) 'put FileName(i-1) into fString And Get Position TempStr = LEFT$(fString, Pos) IF GETATTR(TempStr) = 16 THEN ' check if it's a dir INCR i Fo(i) = TempStr ' directorys ELSE INCR j Fi(j) = TempStr ' Files END IF NEXT REDIM PRESERVE Fi(j) 'Make array the correct size REDIM PRESERVE Fo(i) 'Make array the correct size FUNCTION = %True END IF END FUNCTION '************************************************************************ ' GetCommandFiles - Function Loads File/Folder names into the global arrays '************************************************************************ FUNCTION GetCommandFiles( BYVAL CmdStr AS STRING, Fi() AS STRING, Fo() AS STRING ) AS LONG 'Returns the number of files in the string LOCAL TempStr AS STRING, i AS LONG, j AS LONG, k AS LONG, Count AS LONG Count = PARSECOUNT(CmdStr, any " ") REDIM Fi(Count) 'Make room in the global array REDIM Fo(Count) 'Make room in the global array TempStr = " " WHILE TempStr <> "" INCR k TempStr = PARSE$(COMMAND$, any " ", k) IF GETATTR(TempStr) = 16 THEN ' check if it's a dir INCR i Fo(i) = TempStr ' directorys ELSE INCR j Fi(j) = TempStr ' Files END IF WEND DECR j ' Empty last one REDIM PRESERVE Fi(j) 'Make array the correct size REDIM PRESERVE Fo(i) 'Make array the correct size FUNCTION = Count END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤' SUB Process ' Process Source File SF zWorkPtr = VARPTR(zWork) ' Point to zWork hFile = FREEFILE ' Get a Free Handle InProc = 0 ' We're not in a Proc TimesThru = 1 ' First Pass Seperate Files(1), FilePathStr, FileNameStr ' Extract Path and Name CHDIR FilePathStr IF RIGHT$(UCASE$(FileNameStr), 4) <> ".BAS" THEN MSGBOX "Source File MUST be a PowerBASIC file with the .BAS extension.",,"Error" EXIT SUB END IF OPEN FilePathStr+FileNameStr FOR INPUT AS hFile IF LOF(hFile) < 1 THEN CONTROL SET TEXT hDlg, 114, FileNameStr+" is empty" EXIT SUB END IF CurrFile = FileNameStr ' Set Current File CurrLine = 0 ' Set Current Line DO WHILE Done = 0 IF EOF(hFile) THEN ' reached the end of the first file IF iIncl THEN ' Find Next File to Process CLOSE hFile sWork = Incl(1).zName ' Get File Name OPEN sWork FOR INPUT AS hFile ' Open it ARRAY Delete Incl(1) ' Remove it from array DECR iIncl ' Lower the count IF iIncl THEN ' Resize the Array REDIM PRESERVE Incl(1:iIncl) AS InfoStruct ELSE REDIM Incl(1:1) AS InfoStruct END IF CurrFile = sWork CurrLine = 0 ELSE IF TimesThru = 1 THEN TimesThru = 2 ' Now check variables in PASS 2 CLOSE hFile OPEN FilePathStr+FileNameStr FOR INPUT AS hFile CurrFile = FileNameStr CurrLine = 0 REDIM Vars(1:1) AS InfoStruct ' Clear all variable arrays (They should be empty anyway) iVars = 0 REDIM lVars(1:1) AS InfoStruct ilVars = 0 REDIM gVars(1:1) AS InfoStruct igVars = 0 REDIM Incl(1:1) AS InfoStruct iIncl = 0 CONTROL SET TEXT hDlg, 114, "Begin File " & CurrFile ELSE EXIT LOOP ' If we have gone thru twice then exit otherwise do it again. END IF END IF END IF IF Done THEN EXIT LOOP ' Abort if Quit Hit LINE INPUT# hFile, LineStr ' Get Line from file INCR CurrLine ' Up the line # count LineStr = UCASE$(TRIM$(LineStr, Any CHR$(9,32,0))) ' UCASE for comparisons IF LEN(LineStr) = 0 THEN ITERATE ' Nothing There get another line! IF LEFT$(LineStr, 1) = "'" THEN ITERATE ' Comment IF LEFT$(LineStr, 4) = "REM " THEN ITERATE ' Comment IF LEFT$(LineStr, 8) = "DECLARE " THEN ITERATE ' Don't Care IF LEFT$(LineStr, 4) = "TYPE" THEN In_Type = 1 : ITERATE ' Struct IF LEFT$(LineStr, 8) = "END TYPE" THEN In_Type = 0 : ITERATE ' End Struct 'IF In_Type THEN ' Still Processing a TYPE Sturcture so ignore this line ' Handle #IF 0 Comment Blocks ' =================================================== IF LEFT$(LineStr, 5) = "#IF 0" THEN INCR If_Zero IF LEFT$(LineStr, 5) = "$IF 0" THEN INCR If_Zero IF LEFT$(LineStr, 5) = "#ELSE" THEN IF If_Zero THEN DECR If_Zero ITERATE END IF IF LEFT$(LineStr, 5) = "$ELSE" THEN IF If_Zero THEN DECR If_Zero ITERATE END IF IF LEFT$(LineStr, 6) = "#ENDIF" THEN IF If_Zero THEN DECR If_Zero ITERATE END IF IF LEFT$(LineStr, 6) = "$ENDIF" THEN IF If_Zero THEN DECR If_Zero ITERATE END IF IF If_Zero THEN ITERATE ' In Block Get another line ' End #IF 0 Comment Handling ' =================================================== IF LEFT$(LineStr, 8) = "#INCLUDE" OR LEFT$(LineStr, 8) = "$INCLUDE" THEN ' Find other files included sWork = PARSE$(LineStr, ANY CHR$(34), 2) ' get filename IF LEN(DIR$(sWork)) THEN ' Get Only ones we can find! INCR iIncl REDIM PRESERVE Incl(1:iIncl) AS InfoStruct Incl(iIncl).zName = sWork END IF ITERATE END IF IF LEFT$(LineStr, 12) = "END FUNCTION" THEN ' Clear local Vars()and save any unused ones to lVars() InProc = 0 IF iVars THEN j = ilVars FOR i = 1 TO iVars IF Vars(i).IsUsed = 0 THEN INCR j REDIM PRESERVE lVars(1:j) AS InfoStruct lVars(j).zName = Vars(i).zName lVars(j).IsUsed = Vars(i).IsUsed lVars(j).InFile = Vars(i).InFile lVars(j).LineNum = Vars(i).LineNum lVars(j).InProc = Vars(i).InProc END IF NEXT i ilVars = j iVars = 0 REDIM Vars(1:1) AS InfoStruct END IF END IF IF LEFT$(LineStr, 7) = "END SUB" THEN ' Clear local Vars()and save any unused ones to lVars() InProc = 0 IF iVars THEN j = ilVars FOR i = 1 TO iVars IF Vars(i).IsUsed = 0 THEN INCR j REDIM PRESERVE lVars(1:j) AS InfoStruct lVars(j).zName = Vars(i).zName lVars(j).IsUsed = Vars(i).IsUsed lVars(j).InFile = Vars(i).InFile lVars(j).LineNum = Vars(i).LineNum lVars(j).InProc = Vars(i).InProc END IF NEXT i ilVars = j iVars = 0 REDIM Vars(1:1) AS InfoStruct END IF END IF IF LEFT$(LineStr, 10) = "FUNCTION =" THEN LineStr = MID$(LineStr,11) IF LEFT$(LineStr, 9) = "FUNCTION=" THEN LineStr = MID$(LineStr,10) IF LEFT$(LineStr, 9) = "FUNCTION " THEN ' Entering Proceedure InProc = 1 IF TimesThru = 2 THEN ITERATE ' Second Pass so do no more sWork = MID$(LineStr,9) sWork = TRIM$(sWork) ' Remove Leading Space sTemp = EXTRACT$(sWork, Any " (") ' Get Only Function Name IF sTemp = "PBMAIN" THEN InWhich = sTemp : ITERATE IF sTemp = "WINMAIN" THEN InWhich = sTemp : ITERATE IF sTemp = "LIBMAIN" THEN InWhich = sTemp : ITERATE IF sTemp <> "=" THEN INCR iFuncts REDIM PRESERVE Functs(1:iFuncts) AS InfoStruct Functs(iFuncts).zName = sTemp Functs(iFuncts).InFile = CurrFile Functs(iFuncts).LineNum = CurrLine InWhich = sTemp ITERATE END IF END IF IF LEFT$(LineStr, 18) = "CALLBACK FUNCTION " THEN InProc = 1 IF TimesThru = 2 THEN ITERATE sWork = MID$(LineStr,18) sWork = TRIM$(sWork) ' Remove Leading Space sWork = EXTRACT$(sWork, Any " (") ' Get Only Sub Name INCR iFuncts REDIM PRESERVE Functs(1:iFuncts) AS InfoStruct Functs(iFuncts).zName = sWork Functs(iFuncts).InFile = CurrFile Functs(iFuncts).LineNum = CurrLine InWhich = sWork ITERATE END IF IF LEFT$(LineStr, 4) = "SUB " THEN InProc = 1 IF TimesThru = 2 THEN ITERATE INCR iSubs REDIM PRESERVE Subs(1:iSubs) AS InfoStruct sWork = MID$(LineStr,4) sWork = TRIM$(sWork) ' Remove Leading Space sWork = EXTRACT$(sWork, Any " (") ' Get Only Sub Name Subs(iSubs).zName = sWork Subs(iSubs).InFile = CurrFile Subs(iSubs).LineNum = CurrLine InWhich = sWork ITERATE END IF IF TimesThru = 1 THEN ITERATE ' We only want Subs & Functs on the first pass IF LEFT$(LineStr, 4) = "DIM " THEN ' Local Variable Processing IF InProc = 0 THEN ITERATE sWork = MID$(LineStr,4) sWork = EXTRACT$(sWork,"REM") sWork = EXTRACT$(sWork,"'") FOR i = 1 TO PARSECOUNT(sWork,",") INCR iVars REDIM PRESERVE Vars(1:iVars) AS InfoStruct sTemp = PARSE$(sWork,",",i) sTemp = TRIM$(sTemp) sTemp = EXTRACT$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = INSTR(sTemp, Any "&%@!#$?") IF CurrPos > 1 THEN sTemp = LEFT$(sTemp, CurrPos-1) END IF Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich NEXT i ITERATE END IF IF LEFT$(LineStr, 7) = "STATIC " THEN ' Static Variable Processing IF InProc = 0 THEN ITERATE sWork = MID$(LineStr,7) sWork = EXTRACT$(sWork,"REM") sWork = EXTRACT$(sWork,"'") FOR i = 1 TO PARSECOUNT(sWork,",") INCR iVars REDIM PRESERVE Vars(1:iVars) AS InfoStruct sTemp = PARSE$(sWork,",",i) sTemp = TRIM$(sTemp) sTemp = EXTRACT$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = INSTR(sTemp, Any "&%@!#$?") IF CurrPos > 1 THEN sTemp = LEFT$(sTemp, CurrPos-1) END IF Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich NEXT i ITERATE END IF IF LEFT$(LineStr, 6) = "LOCAL " THEN ' Local Variable Processing IF InProc = 0 THEN ITERATE sWork = MID$(LineStr,6) sWork = EXTRACT$(sWork,"REM") sWork = EXTRACT$(sWork,"'") FOR i = 1 TO PARSECOUNT(sWork,",") INCR iVars REDIM PRESERVE Vars(1:iVars) AS InfoStruct sTemp = PARSE$(sWork,",",i) sTemp = TRIM$(sTemp) sTemp = EXTRACT$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = INSTR(sTemp, Any "&%@!#$?") IF CurrPos > 1 THEN sTemp = LEFT$(sTemp, CurrPos-1) END IF Vars(iVars).zName = sTemp Vars(iVars).InFile = CurrFile Vars(iVars).LineNum = CurrLine Vars(iVars).InProc = InWhich NEXT i ITERATE END IF IF LEFT$(LineStr, 7) = "GLOBAL " THEN ' Global Variable Processing IF InProc = 1 THEN ITERATE sWork = MID$(LineStr,7) sWork = EXTRACT$(sWork,"REM") sWork = EXTRACT$(sWork,"'") FOR i = 1 TO PARSECOUNT(sWork,",") INCR igVars REDIM PRESERVE gVars(1:igVars) AS InfoStruct sTemp = PARSE$(sWork,",",i) sTemp = TRIM$(sTemp) sTemp = EXTRACT$(sTemp, Any " (") 'Chop off AS LONG etc. CurrPos = INSTR(sTemp, Any "&%@!#$?") IF CurrPos > 1 THEN sTemp = LEFT$(sTemp, CurrPos-1) END IF gVars(igVars).zName = sTemp gVars(igVars).InFile = CurrFile gVars(igVars).LineNum = CurrLine NEXT i ITERATE END IF ' Ok, it's a regular line of Code... Process it IF InProc = 0 THEN ITERATE ' Make Sure we are in a SUB for FUNCT sTemp = "" ' Step 1, Remove Quoted Strings zWork = LineStr DblQuote = 0 FOR i = 0 TO LEN(zWork)-1 IF @zWorkPtr[i] = 34 THEN ' Quote Mark IF DblQuote THEN DblQuote = 0 ELSE DblQuote = 1 END IF ELSEIF DblQuote = 0 THEN ' Outside of Quotes sTemp = sTemp + CHR$(@zWorkPtr[i]) END IF NEXT i i = INSTR(sTemp, CHR$(39)) ' Step 2, Remove Comments IF i THEN sTemp = LEFT$(sTemp,i-1) END IF sTemp = EXTRACT$(sTemp, CHR$(39)) sTemp = EXTRACT$(sTemp,"REM") sWork = sTemp FOR i = 1 TO PARSECOUNT(sWork, Any ".()[],=+-*/\: ") ' Step 3, Separate all keywords and varaible/sub/func names sTemp = PARSE$(sWork, Any ".()[],=+-*/\: ",i) sTemp = TRIM$(sTemp) IF VAL(sTemp) > 0 THEN ITERATE ' Skip Numbers IF LEN(sTemp) = 0 THEN ITERATE DO IF LEFT$(sTemp,1) = "@" THEN sTemp = MID$(sTemp,2) ELSE sTemp = EXTRACT$(sTemp, Any "&%@!#$?") EXIT LOOP END IF LOOP FoundIt = 0 ' Check Local Variable's First IF iVars THEN FOR j = 1 TO iVars IF TRIM$(UCASE$(sTemp)) = TRIM$(UCASE$(Vars(j).zName)) THEN INCR Vars(j).IsUsed FoundIt = 1 CONTROL SET TEXT hDlg, 114, "Local" EXIT FOR END IF NEXT j IF FoundIt THEN ITERATE FOR END IF IF igVars THEN ' Next check Global Variables FOR j = 1 TO igVars IF TRIM$(UCASE$(sTemp)) = TRIM$(UCASE$(gVars(j).zName)) THEN INCR gVars(j).IsUsed FoundIt = 1 CONTROL SET TEXT hDlg, 114, "Global" EXIT FOR END IF NEXT j IF FoundIt THEN ITERATE FOR END IF IF iSubs THEN ' Check Sub Names Next FOR j = 1 TO iSubs IF TRIM$(UCASE$(sTemp)) = TRIM$(UCASE$(Subs(j).zName)) THEN INCR Subs(j).IsUsed FoundIt = 1 CONTROL SET TEXT hDlg, 114, "Sub" EXIT FOR END IF NEXT j IF FoundIt THEN ITERATE FOR END IF IF iFuncts THEN ' Last Check Function Names FOR j = 1 TO iFuncts IF TRIM$(UCASE$(sTemp)) = TRIM$(UCASE$(Functs(j).zName)) THEN IF TRIM$(UCASE$(sTemp)) <> TRIM$(UCASE$(InWhich)) THEN ' Make Sure we're not in the current function of the same name... INCR Functs(j).IsUsed CONTROL SET TEXT hDlg, 114, "Function" EXIT FOR END IF END IF NEXT j END IF NEXT i LOOP CLOSE hFile CONTROL SET TEXT hDlg, 114, "Finished" END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤' SUB SaveResults ' Now Prepare a Report of what we've found out! LOCAL i AS LONG, sWork AS STRING, hFile AS LONG DestFile = PARSE$(FileNameStr, any ".", 1)+"LOG.txt" OPEN FilePathStr+DestFile FOR Output AS hFile sWork = STRING$(80,"*") PRINT# hFile, sWork PRINT# hFile, "" PRINT# hFile, "Report of Un-Used Variables, Subs, & Functions for "+FileNameStr PRINT# hFile, "And Its INCLUDE files that were able to be located." PRINT# hFile, "" PRINT# hFile, sWork PRINT# hFile, "" PRINT# hFile, "++++[ UN-USED FUNCTIONS ] +++++" PRINT# hFile, "" IF iFuncts THEN FOR i = 1 TO iFuncts IF Functs(i).IsUsed = 0 THEN PRINT# hFile, "FUNCTION " & Functs(i).zName & " [" & Functs(i).InFile & ":" & _ FORMAT$(Functs(i).LineNum) & "]" NEXT i END IF PRINT# hFile, "" PRINT# hFile, "++++[ UN-USED SUBS ] +++++" PRINT# hFile, "" IF iSubs THEN FOR i = 1 TO iSubs IF Subs(i).IsUsed = 0 THEN PRINT# hFile, "SUB " & Subs(i).zName & " [" & Subs(i).InFile & ":" & _ FORMAT$(Subs(i).LineNum) & "]" NEXT i END IF PRINT# hFile, "" PRINT# hFile, "++++[ UN-USED GLOBAL VARIABLES ] +++++" PRINT# hFile, "" IF igVars THEN FOR i = 1 TO igVars IF gVars(i).IsUsed = 0 THEN PRINT# hFile, gVars(i).zName & " [" & gVars(i).InFile & ":" & _ FORMAT$(gVars(i).LineNum) & "]" NEXT i END IF PRINT# hFile, "" PRINT# hFile, "++++[ UN-USED LOCAL VARIABLES ] +++++" PRINT# hFile, "" IF ilVars THEN FOR i = 1 TO ilVars IF lVars(i).IsUsed = 0 THEN PRINT# hFile, lVars(i).zName & " [" & lVars(i).InFile & ":" & _ FORMAT$(lVars(i).LineNum) & "]" NEXT i END IF PRINT# hFile, "" PRINT# hFile, "" CLOSE hFile SHELLEXECUTE 0, "open", FilePathStr+DestFile, BYVAL 0, BYVAL 0, %SW_SHOWNORMAL ' launch log file END SUB '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤' CALLBACK FUNCTION MainCB() AS LONG SELECT CASE CBMSG CASE %WM_INITDIALOG DIM Files(1), Folders(1) ' Starting condition IF LEN(COMMAND$) THEN CALL GetCommandFiles(COMMAND$, Files(), Folders()) ' Retrieve the contents of the Command String LOCAL sTimer AS LONG sTimer = SETTIMER(CBHNDL, 1, 400, %NULL) ' wait for window to draw ELSE CONTROL SET TEXT hDlg, 114, "DRAG and DROP here" END IF CASE %WM_TIMER KILLTIMER CBHNDL, 1 CALL Process CALL SaveResults CASE %WM_DROPFILES REDIM Files(0) ' Reset Array CALL GetDroppedFiles(CBWPARAM, Files(), Folders()) ' Retrieve the Dropped filenames CALL Process CALL SaveResults CASE %WM_COMMAND SELECT CASE CBCTL CASE 101 CASE 124 ' Quit Done = 1 ' jump out of any loops DIALOG END hDlg ' and QUIT END SELECT END SELECT END FUNCTION FUNCTION PBMAIN Wdth = 130 : Hght = 82 : BtnW = 50 : BtnH = 14 : FrmS = 4 : FrmW = Wdth-2*FrmS : TxtH = 12 DIALOG NEW 0, " Checkit", 330, 60, Wdth, Hght, 0 TO hDlg DRAGACCEPTFILES hDlg, %True CONTROL ADD LABEL, hDlg, 114, "", FrmS, Hght-30, FrmW, TxtH, %SS_CENTER CONTROL ADD BUTTON, hDlg, 124, "&Quit", FrmS, Hght-16, FrmW, BtnH, 1 DIALOG SHOW MODAL hDlg CALL MainCB END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
Have a great weekend all!SUB Process ' Process Source File SF iFuncts = 0 iSubs = 0 iIncl = 0 '.. plus the rest.
DIALOG NEW 0, "Checkit", 330, 60, Wdth, Hght, 0 TO hDlg
SetWindowPos hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
CASE %WM_DESTROY ' reset "always on top"
SetWindowPos CBHNDL, %HWND_NOTOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
Comment