There weren't any changes to the .inc file.
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' PBcodec, Source Code Checker, v1.5
'-----------------------------------------------------------------------------
' Scans a main source file and all its include files for Un-used Subs,
' Functions, and variables. Version 1.1 also has ability to extract string
' literals, that is, strings withing double-quotes.
'
' PBcodec will save the result in a file ending with --LOG.TXT and also show
' this file in associated texteditor.
'
' This version does not process any Conditional Compiling statements, so far,
' but all files are properly scanned and it even handles "DIM x AS GLOBAL in
' a correct way. Tested on my own projects, all reports so far has been correct.
'
' The output will show the SUB,FUNCT and VAR name followed by [FileName: 565
' where the last number is the line number where the item is declared. It will
' also present a list of all Includes, Global vars, Subs and Functions, this
' part originally written by Wayne Diamond.
'
' Public Domain, this version by Borje Hagsten, July 2001, but main credits
' goes to Scott Slater for showing us it could be done (and how to do it).
' Parts of this program has been copied from his version, but parsing and
' some other things has been totally rewritten, my way..
' Many have been involved, giving many valuable tips and providing code,
' so one could say this is the result of a joined PB community effort.. :)
'
' Tip: Prog launches txt-associated texteditor to show report. Standard is
' NotePad. I have set mine to use Courier New, 9p, which gives nice output..
'
' A few notes: Exported subs/functions, or ones inside "public" include files,
' may have a reference count of zero and still not be un-used, since some other
' program may be using them.
'
' Also, since one of the advantages with the PB language is almost unlimited
' flexibility to do things, there's no guaranties everything will be found,
' or even be 100% correct. It has proved to be successful on my projects,
' but please, use this (and similar) programs with extreme care..
'
' LOG:
' Aug 11, 2003 - added some extrs checks for line wraps, _ to DoProcess
' Jan 23, 2002 - added support for relative include paths, plus optimized
' some for better speed, etc.
' Jan 23, 2002 - added support for relative include paths, plus optimized
' some for better speed, etc.
' Jan 17, 2002 - changed to use IsCharAlphaNumeric in ANSItrim, to include
' leading/trailing digits in string literals. Also had to change
' UCASER function a bit, so all now can be compiled in PBDLL 6.1 too..
' Oct 17, Corrected error in DoSaveResults, where global/local name mix warning
' could end up pointing at wrong file for first local declare.
' Oct 10, added exclude() array to avoid some of the most common include file
' names when extracting string literals. Possible to expand - see WinMain.
' Also set string literal extraction checkbox as checked from start.
' Oct 09, added possibility to extract string literals, that is, text within
' double-quotes. Added AnsiTRIM function for this purpose.
' Aug 01, in DoSaveResults, moved REDIM PRESERVE lVars out from loop in first
' IF/THEN block and reversed loop, because it sometimes GPF'd there.
' Of course it could GPF. Must run such loops backwards, silly me.
' Aug 01, removed AllLocals array and use lVars to store all locals instead.
' Changed report accordingly and now, Global/Local name mix lists
' Line number for local representations too.
' Jul 31, excluded declarations of Subs/Function from usage check
' Jul 31, re-fixed previous stupid fix of GLOBAL DIM, so it works this time..
' Jul 29, fixed code in DoProcess - ExtractLocals, to check DIM more carefully,
' since DIM/REDIM may have been preceeded with a GLOBAL declare of same variable.
' Jul 29, added support for multiple include file paths in WinMain and DoGetIncFiles
' Added check for trailing backslash to fExist, so paths are handled correctly
' Jul 29, added code to DoProcess - ExtractSub, to exclude declares for external
' procedures (in DLL's etc.) from being counted as "declared but un-used".
' Also added code to DoProcess - ExtractLine, to replace colons within
' paranthesis, which could cause weird results when parsing a line for colons.
' Jul 29, added "Scan" button to enable easy rescanning of a file, since I
' have found this useful to do after changes have been made. Also did
' some minor tweaking of the code to enhance performance.
' Jul 28, major trimming of parser, to ensure results and improve performance.
' Sep 22 2009 IsMainFile() will no longer balk at $TAB before #compile - Nathan Maddox
' Sep 26 2009 Added ReadFile() to simplify development going forward
' Sep 26 2009 Added support for #IF %ABC conditional compile (to exclude includes)
' Sep 26 2009 Added support for #IF NOT %ABC conditional compiles (to exclude includes)
' Sep 26 2009 Added Support for #IF %Def(%ABC) conditional compiles (to exclude includes)
' Sep 26 2009 Added Support for #IF NOT %Def(%ABC) conditional compiles (to exclude includes)
' Sep 26 2009 Added support for #ELSE (to exclude includes)
' Sep 26 2009 Added checkbox to control whether or not the
' "Existing Function()'s and Subs()'s that are not Declared Report"
' PB 9.0 eliminated the need for Declaring all Sub()'s and Function()'s
' Jul 06 2010 Cloned Conditional Compile code to work with Subs, Functions, Locals, & Globals
' Jul 07 2010 Added Checkboxes for all reports and Select All and UnSelect All Buttons
' Jul 25 2010 Added Compound Conditional compiler checking code:
' #IF %ABC AND %DDD
' #IF %Def(%ABC) AND %DEF(%DDD)
' #IF NOT %ABC AND NOT %DDD
' #IF NOT %DEF(%ABC) AND NOT %DEF(%DDD)
'
' #IF %ABC OR %DDD
' #IF %Def(%ABC) OR %DEF(%DDD)
' #IF NOT %ABC OR NOT %DDD
' #IF NOT %DEF(%ABC) OR NOT %DEF(%DDD)
' Jul 25 2010 Fixed comment in resulting file that mentions lines scanned per minute.
' Jul 30 2010 Bug fixes - larger dialog - Unused and Reports Button
' Aug 2, 2010 Bug fixes for when Equates were parameters to Functions (functions/subs weren't
' being marked as used when they really were).
' Aug 4, 2010 Pesky line numbers - work now
' Aug 5, 2010 Knocked down some false positives on functions not used.
'
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'#COMPILE EXE "F:\BATCH\PBCODEC.EXE"
#COMPILE EXE
#INCLUDE "PBCODEC.INC" 'Basic Win API definitions
TYPE InfoStruct
uName AS ASCIIZ * 100 'is 100 enough? For me it is, but if not for you, increase..
zName AS ASCIIZ * 100
inFunct AS ASCIIZ * 100
IsUsed AS LONG
iType AS LONG
FileNum AS LONG
LineNum AS LONG
SubEnd AS LONG
Exported AS LONG
END TYPE
TYPE EquateCnsts
EquateName AS STRING * 50
EquateVal AS LONG
END TYPE
TYPE CondCompType
EquateName AS STRING * 50
IncludeIt AS LONG
END TYPE
TYPE StackType
PreNot AS LONG
PreDef AS LONG
EquateName AS STRING * 50
END TYPE
GLOBAL Vars() AS InfoStruct ' All Locals in Current Proc (TEMP)
GLOBAL gVars() AS InfoStruct ' All Globals
GLOBAL gDbl() AS InfoStruct ' Duplicate Global names
GLOBAL gDecl() AS InfoStruct ' Declared Subs/Functions
GLOBAL lVars() AS InfoStruct ' Un-Used Locals
GLOBAL Functs() AS InfoStruct ' All Functions
GLOBAL EqCnst() AS EquateCnsts
GLOBAL CComp() AS CondCompType
GLOBAL CondCompile2() AS CondCompType
GLOBAL EquateConst2() AS EquateCnsts
GLOBAL Files() AS STRING
GLOBAL inFile() AS STRING
GLOBAL sIncDir() AS STRING
GLOBAL sString() AS STRING 'for string literals
GLOBAL exclude() AS STRING 'for exclude strings
GLOBAL getStrings AS LONG, sStrCount AS LONG
GLOBAL NotDecl AS LONG
GLOBAL Do_Includes_Rpt AS LONG
GLOBAL Do_UnusedFxs_Rpt AS LONG
GLOBAL Do_UnusedSubs_Rpt AS LONG
GLOBAL Do_DeclaredButNonExistant_Rpt AS LONG
GLOBAL Do_UnusedGlobals_Rpt AS LONG
GLOBAL Do_UnusedLocals_Rpt AS LONG
GLOBAL Do_GlobalLocalMix_Rpt AS LONG
GLOBAL Do_DupeGlobal_Rpt AS LONG
GLOBAL Do_TotRefCount_Rpt AS LONG
GLOBAL Do_SubRefCount_Rpt AS LONG
GLOBAL Do_GlobalVariableRpt_Rpt AS LONG
GLOBAL Do_StringLiterals_Rpt AS LONG
GLOBAL Do_Constants_Rpt AS LONG
GLOBAL gCountCRLFs AS LONG
'GLOBAL sFlag As Long 'NNM 7/30/2010 (hopefully)
GLOBAL FilePathStr AS STRING, FileNameStr AS STRING, DestFile AS STRING
GLOBAL sWork AS STRING, LineStr AS STRING
GLOBAL Done AS LONG
GLOBAL igDbl AS LONG ' # of Duplicate Globals
GLOBAL iVars AS LONG ' # of Vars
GLOBAL ilVars AS LONG ' # of lVars
GLOBAL igVars AS LONG ' # of gVars
GLOBAL iFuncts AS LONG ' # of Functs
GLOBAL DeclCount AS LONG
GLOBAL gTotLines AS LONG, t AS SINGLE
GLOBAL True, False AS LONG
DECLARE CALLBACK FUNCTION WinMainProc() AS LONG
DECLARE FUNCTION AnsiTRIM(BYVAL txt AS STRING) AS STRING
DECLARE SUB DoGetIncFiles(BYVAL TheFile AS STRING, _
BYREF CCOMP() AS CondCompType, _
BYREF EQCnst() AS EquateCnsts)
DECLARE SUB DoProcess(BYVAL TheFile AS STRING, _
BYVAL fNum AS LONG, _
BYVAL WhatRun AS LONG, _
BYREF CondCompile2() AS CondCompType,_
BYREF EquateConst2() AS EquateCnsts)
DECLARE FUNCTION GetCommandFile(BYVAL CmdStr AS STRING, Fi() AS STRING) AS LONG
DECLARE FUNCTION GetDroppedFile(BYVAL hDrop AS LONG, Fi() AS STRING) AS LONG
DECLARE FUNCTION GetIncludeDir AS STRING
DECLARE FUNCTION IniGetString(BYVAL sSection AS STRING, BYVAL sKey AS STRING, _
BYVAL sDefault AS STRING, BYVAL sFile AS STRING) AS STRING
DECLARE FUNCTION IsFileMain(BYVAL fName AS STRING) AS LONG
DECLARE FUNCTION UCASER(BYVAL st AS STRING) AS STRING
DECLARE SUB DoInitProcess(BYVAL hDlg AS LONG, BYVAL fName AS STRING)
DECLARE SUB DoSaveResults
FUNCTION ReadFile(BYVAL FileName AS STRING, BYREF Arr() AS STRING) AS LONG
LOCAL FileNum AS LONG
LOCAL FileSiz AS LONG
LOCAL COUNT AS LONG
LOCAL Buf AS STRING
Filenum=FREEFILE
OPEN FileName FOR BINARY ACCESS READ SHARED AS #FileNum
FileSiz=LOF(FileNum)
GET$ #FileNum, FileSiz, Buf
CLOSE #FileNum
buf=REMOVE$(buf, ANY $TAB)
buf=UCASE$(buf)
'---- Parse the Records
REPLACE $CRLF WITH $CR IN Buf
COUNT=PARSECOUNT(Buf, $CR)
IF gCountCRLFs>0 THEN gTotLines+=COUNT 'Counting Source code lines processed
REDIM Arr(1:COUNT) AS STRING
PARSE Buf, Arr(), $CR
FOR COUNT=1 TO UBOUND(Arr)
Arr(COUNT)=TRIM$(Arr(COUNT))
DO WHILE INSTR(Arr(COUNT),SPACE$(2))>0 : REPLACE SPACE$(2) WITH $SPC IN Arr(COUNT) : LOOP
NEXT
'---- Set Function Result
FUNCTION=COUNT
END FUNCTION
FUNCTION GetADollarfromDEF(LineStr AS STRING) AS STRING
LOCAL J, K, L, M AS LONG
LOCAL A$
J=INSTR(1,LineStr,"%DEF(") : J+=5
K=INSTR(J,LineStr,")")
L=LEN(LineStr)
M=IIF(K>0,MIN(K,L),L)
A$=MID$(LineStr,J,L-J+1) 'Name of Equate (everything btwn % and ($SPC or end of String)
FUNCTION=REMOVE$(A$,")")
END FUNCTION
FUNCTION GetADollar(BYVAL LineStr AS STRING) AS STRING
LOCAL J, K, L, M AS LONG
LOCAL A$
J=INSTR(1,LineStr,"%")
K=INSTR(J,LineStr," ")
L=LEN(LineStr)
M=IIF(K>0,MIN(K,L),L)
A$=MID$(LineStr,J,L-J+1) 'Name of Equate (everything btwn % and ($SPC or end of String)
A$=REMOVE$(A$,ANY ")")
FUNCTION=A$
END FUNCTION
FUNCTION CheckForCompoundCompDirective(BYVAL Txt AS STRING) AS LONG
FUNCTION=0
SELECT CASE True
CASE INSTR(1, Txt, " OR ")>0
'? "Conditional Compiler Directive Found. Incorrect results may occur"+$CRLF+Txt
FUNCTION=1
CASE INSTR(1, Txt, " AND ")>0
'? "Conditional Compiler Directive Found. Incorrect results may occur"+$CRLF+Txt
FUNCTION=1
END SELECT
END FUNCTION
TYPE StackType
PreNot AS LONG
PreDef AS LONG
EquateName AS STRING * 50
END TYPE
FUNCTION EvalStack(BYVAL Stk AS StackType,_
BYREF TEQCnst() AS EquateCnsts) AS LONG
LOCAL I, Found AS LONG
LOCAL A$, B$
A$=Stk.EquateName : A$=TRIM$(A$)
Found=0
FOR I=1 TO UBOUND(TEqCnst)
B$=TEqCnst(I).EquateName : B$=TRIM$(B$)
IF A$=B$ THEN
Found=I
EXIT FOR
END IF
NEXT
FUNCTION=False
SELECT CASE True
CASE Found=0 AND Stk.PreNot AND Stk.PreDef=1 : FUNCTION=True
CASE Found>0
IF Stk.PreNot=1 AND TEqCnst(Found).EquateVal=0 THEN FUNCTION=True
IF STK.PreDef=1 THEN FUNCTION=True
IF TEqCnst(Found).EquateVal<>0 THEN FUNCTION=True
END SELECT
END FUNCTION
FUNCTION CompoundCompDirective(BYVAL LineStr AS STRING,_
BYREF TCComp() AS CondComptype, _
BYREF TEQCnst() AS EquateCnsts) AS LONG
LOCAL Ands, Ors, AllAnds, AllOrs, Temp AS LONG
LOCAL PVar, PDefVar, PNotVar, PNotDefVar AS LONG
LOCAL What, Tot, I, J AS LONG
LOCAL A$, B$, C$
Ands =TALLY(LineStr," AND ") 'How many And conditions do we have?
Ors =TALLY(LineStr," OR ") 'How many Or Conditions do we have?
Tot =Ands+Ors+1
DIM TStack(Tot) AS StackType
LOCAL Pieces$()
LOCAL TStk AS StackType
AllAnds=IIF(Ors=0,True,False)
AllOrs =IIF(Ands=0,True,False)
I=INSTR(1,LineStr,"#ELSEIF") : IF I>=1 THEN LineStr=REMOVE$(LineStr,"#ELSEIF ")
I=INSTR(1,LineStr,"#IF") : IF I>=1 THEN LineStr=REMOVE$(LineStr,"#IF ")
GOSUB GimmeTheStack 'Parse LineStr into Stack()
SELECT CASE True
CASE AllOrs 'First True = Good To Go
FUNCTION=False
FOR I=1 TO UBOUND(TStack)
IF EvalStack(TStack(I),TEQCnst())=True THEN FUNCTION=True : EXIT FUNCTION
NEXT
CASE AllAnds 'First False = Bad
FUNCTION=True
FOR I=1 TO UBOUND(TStack)
IF EvalStack(TStack(I),TEQCnst())=False THEN FUNCTION=True : EXIT FUNCTION
NEXT
CASE ELSE
? "Mixed AND/OR Compiler Directives Found!"+$CRLF+_
"Code not implemented yet"+$CRLF+_
"LineStr="+LineStr
'FOR I=1 TO UBOUND(TStack)
'NEXT
END SELECT
EXIT FUNCTION
GimmeTheStack:
J=PARSECOUNT(LineStr," ") 'How many words are there?
REDIM Pieces$(J)
PARSE LineStr, Pieces$(), " "
I=1
FOR J=1 TO UBOUND(Pieces$)
SELECT CASE True
CASE Pieces$(I)="NOT"
IF INSTR(1,Pieces$(I+1),"%DEF(")>0 THEN 'NOT %Def(
A$=GetADollarFromDEF(Pieces$(J+1))
TStack(I).PreNot =1
TStack(I).PreDef =1
J+=1
ELSE 'NOT %ABC
A$=Pieces$(J+1)
TStack(I).PreNot =1
TStack(I).PreDef =0
J+=1
END IF
CASE INSTR(1,Pieces$(I),"%DEF(")>0 : '%DEF(
A$=GetADollarFromDEF(Pieces$(J))
TStack(I).PreNot =0
TStack(I).PreDef =1
CASE Pieces$(I)="OR" : ITERATE
CASE Pieces$(I)="AND" : ITERATE
CASE ELSE : '%ABC
A$=Pieces$(J)
TStack(I).PreNot =0
TStack(I).PreDef =0
END SELECT
TStack(I).EquateName=A$
INCR I
NEXT
RETURN
END FUNCTION
FUNCTION SeeIfIncludingIt(BYREF TCComp() AS CondCompType) AS LONG
LOCAL RR, IncludingIt AS LONG
IncludingIt=True
RR=UBOUND(TCComp)
IF RR>=1 THEN
IF TCComp(RR).IncludeIt=False THEN
IncludingIt=False
END IF
END IF
FUNCTION=IncludingIt
END FUNCTION
FUNCTION FindEquate(BYVAL A$, BYREF TEQCnst() AS EquateCnsts) AS LONG
LOCAL QQ1, Found AS LONG
LOCAL B$, C$
Found=0
IF UBOUND(TEqCnst)<=0 THEN FUNCTION=0
FOR QQ1=1 TO UBOUND(TEqCnst)
C$ =SPACE$(50)
LSET C$=TEQCNST(QQ1).EquateName
B$=TRIM$(C$)
IF A$=B$ THEN Found=QQ1 : EXIT FOR
NEXT
FUNCTION=Found
END FUNCTION
SUB GetEquate(LineStr AS STRING, BYREF TEQCnst() AS EquateCnsts)
LOCAL J, K, M, N, O, L, QQ AS LONG
LOCAL A$
J=INSTR(1, LineStr,"%") 'Position of % (important)
K=INSTR(J+1,LineStr,"=") 'Position of = (equal sign)
IF J>=1 AND K>=J THEN
A$=TRIM$(MID$(LineStr,J,K-J)) 'Get Equate Name 'everything btwn % and =
SELECT CASE True
CASE INSTR(1,A$,"(")>0 : 'ie.. IF JulianDate%("01-01-2010)>=5000 THEN
CASE INSTR(1,A$," THEN ")>0 : 'ie.. IF %ABC THEN Function=0
CASE INSTR(1,A$,",")>0 : ' following line continuation %KEY_QUERY_VALUE, hKey) = %ERROR_SUCCESS THEN
CASE A$="%" : '?? nothing
CASE ELSE :
M=LEN(LineStr) 'Length of line
N=INSTR(1,LineStr,":") ': continuation ?
O=IIF(N>0,MIN(N,M),M)
L=UBOUND(TEqCnst)+1 : REDIM PRESERVE TEqCnst(L) AS EquateCnsts
TEqCnst(L).EquateName=A$
QQ =VAL(TRIM$(MID$(LineStr,K+1,M-O-1)))
TEqCnst(L).EquateVal =QQ
IF N>0 AND N<M THEN 'More to come ? ie.. %ABC=1 : %DEF=2 etc
LineStr=RIGHT$(LineStr,M-N)
CALL GetEquate(LineStr, TEqCnst()) 'Recursive Call ****
END IF
END SELECT
END IF
END SUB
FUNCTION CheckEquateElseIfDef(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEqCnst() AS EquateCnsts) AS LONG
LOCAL A$
LOCAL IncludingIt, Found, QQ AS LONG
LOCAL retval AS LONG
QQ=UBOUND(TCComp)
A$=GetADollarfromDef(LineStr) 'A$ has Equate Name in it
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
IF IncludingIt=False THEN
RetVal=CheckForCompoundCompDirective(LineStr)
IF RetVal>0 THEN
TCComp(QQ).IncludeIt=CompoundCompDirective(LineStr, TCComp(), TEQCnst())
ELSE
Found=FindEquate(A$,TEqCnst()) 'Returns Found
IF Found>0 THEN 'If Found then Defined
TCComp(QQ).IncludeIt =True
ELSE
IF QQ>1 THEN '----Nesting
IF TCComp(QQ-1).IncludeIt=True THEN 'One level up is active
TCComp(QQ).IncludeIt=True
ELSE 'One level up is Not Active
TCComp(QQ).IncludeIt=False
END IF
ELSE '----Not nested
TCComp(QQ).IncludeIt =False
END IF
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
FUNCTION=TCComp(QQ).IncludeIt
END FUNCTION
FUNCTION CheckEquateElseIfNotDef(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEQCnst() AS EquateCnsts) AS LONG
LOCAL A$
LOCAL Found, Includingit, QQ AS LONG
LOCAL retval AS LONG
A$=GetADollarfromdEF(LineStr) 'Returns A$ (contains the Equatename)
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
QQ=UBOUND(TCComp)
IF IncludingIt=False THEN
RetVal=CheckForCompoundCompDirective(LineStr)
IF RetVal=True THEN
TCComp(QQ).IncludeIt=IIF(CompoundCompDirective(LineStr, TCComp(), TEQCnst())=True, False, True)
ELSE
Found=FindEquate(A$, TEqCnst()) 'Returns Found
IF Found>0 THEN 'If Found then Defined
TCComp(QQ).IncludeIt =False
ELSE
IF QQ>1 THEN '----Nesting
IF TCComp(QQ-1).IncludeIt=True THEN 'One level up is active
TCComp(QQ).IncludeIt=True
ELSE 'One level up is Not Active
TCComp(QQ).IncludeIt=False
END IF
ELSE '----Not nested
TCComp(QQ).IncludeIt =True
END IF
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
FUNCTION=TCComp(QQ).IncludeIt
END FUNCTION
SUB CheckEquateIfNotDef(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEQCnst() AS EquateCnsts)
LOCAL retval AS LONG
LOCAL A$
LOCAL IncludingIt, Found, QQ AS LONG
A$ =GetADollarfromDEF(LineStr) 'Returns A$ (Equatename in A$)
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
QQ=UBOUND(TCComp)+1 : REDIM PRESERVE TCComp(QQ)
TCComp(QQ).EquateName=A$
IF IncludingIt=True THEN
RetVal=CheckForCompoundCompDirective(LineStr)
IF RetVal=True THEN
TCComp(QQ).IncludeIt=IIF(CompoundCompDirective(LineStr, TCComp(), TEQCnst())=True, False, True)
ELSE
Found=FindEquate(A$,TEqCnst()) 'Returns Found
IF Found>0 THEN 'If Found then Defined
TCComp(QQ).IncludeIt =False
ELSE
IF QQ>1 THEN '----Nesting
IF TCComp(QQ-1).IncludeIt=True THEN 'One level up is active
TCComp(QQ).IncludeIt=True
ELSE 'One level up is Not Active
TCComp(QQ).IncludeIt=False
END IF
ELSE '----Not nested
TCComp(QQ).IncludeIt =True
END IF
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
END SUB
SUB CheckEquateIfDef(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondComptype, _
BYREF TEQCnst() AS EquateCnsts)
LOCAL retval, QQ, Found, IncludingIt AS LONG
LOCAL A$
A$=GetADollarFromDef(LineStr)
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
QQ=UBOUND(TCComp)+1 : REDIM PRESERVE TCComp(QQ)
TCComp(QQ).EquateName=A$
IF IncludingIt=True THEN
RetVal=CheckForCompoundCompDirective(LineStr)
IF RetVal=True THEN
TCComp(QQ).EquateName=LineStr
IF CompoundCompDirective(LineStr, TCComp(), TEQCnst())=True THEN
IF QQ>1 THEN 'We are nesting
IF TCComp(QQ-1).IncludeIt=True THEN
TCComp(QQ).Includeit=True
ELSE
TCComp(QQ).Includeit=False
END IF
ELSE 'Not nesting
TCComp(QQ).IncludeIt =True
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
ELSE
Found=FindEquate(A$,TEQCnst())
IF Found>0 THEN 'If Found then Defined
IF QQ>1 THEN 'We are nesting
IF TCComp(QQ-1).IncludeIt=True THEN
TCComp(QQ).Includeit=True
ELSE
TCComp(QQ).Includeit=False
END IF
ELSE 'Not nesting
TCComp(QQ).IncludeIt =True
END IF
ELSE
TCComp(QQ).IncludeIt =False
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
END SUB
SUB CheckEquateNotIf(BYVAL lineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEqCnst() AS EquateCnsts)
LOCAL retval AS LONG
LOCAL QQ, IncludingIt, Found AS LONG
LOCAL A$
A$=GetADollarFromDEF(LineStr)
QQ=UBOUND(TCComp)+1 : REDIM PRESERVE TCComp(QQ)
TCComp(QQ).EquateName=A$
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
RetVal=CheckForCompoundCompDirective(LineStr)
IF IncludingIt=True THEN
IF RetVal=True THEN
CComp(QQ).EquateName=LineStr
IF CompoundCompDirective(LineStr, TCComp(), TEQCnst())=False THEN
TCComp(QQ).IncludeIt=True
ELSE
TCComp(QQ).IncludeIt=False
END IF
ELSE
Found=FindEquate(A$,TEQCnst())
IF Found>0 THEN
TCComp(QQ).IncludeIt =IIF(TEqCnst(Found).EquateVal<>0,False,True)
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
END SUB
SUB CheckEquateIf(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEqCnst() AS EquateCnsts)
LOCAL QQ, Found, IncludingIt AS LONG
LOCAL A$
LOCAL retval AS LONG
A$=GetADollar(LineStr)
QQ=UBOUND(TCComp)+1 : REDIM PRESERVE TCComp(QQ)
TCComp(QQ).EquateName=A$
IncludingIt=SeeIfIncludingIt(TCComp()) 'Returns IncludingIt (see if nested and including in upper level or not)
IF IncludingIt=True THEN
RetVal =CheckForCompoundCompDirective(LineStr)
IF RetVal>0 THEN
RetVal=compoundcompDirective(LineStr, TCComp(), TEQCnst())
TCComp(QQ).IncludeIt =RetVal
ELSE
Found=FindEquate(A$,TEQCnst())
IF Found>0 THEN
TCComp(QQ).IncludeIt =IIF(TEqCnst(Found).EquateVal<>0,True,False)
END IF
END IF
ELSE
TCComp(QQ).IncludeIt=False
END IF
END SUB
FUNCTION ChkCondCompile(BYVAL LineStr AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEqCnsts() AS EquateCnsts) AS LONG
LOCAL QQ AS LONG
'------ Conditionally compiled code ??
FUNCTION=1
QQ=UBOUND(TCComp) 'UDT Array of conditional compiles
'IF Instr(1,LineStr,"SSNFORMAT")>0 THEN
' ? "LineStr="+LineStr
'END IF
'IF QQ>=1 THEN
SELECT CASE True
CASE INSTR(1,LineStr,"#ELSEIF %DEF(")>0
QQ=CheckEquateElseIfDef( LineStr, TCComp(), TEqCnsts())
FUNCTION=3
CASE INSTR(1,LineStr,"#ELSEIF NOT %DEF(")>0
QQ=CheckEquateElseIfNotDef(LineStr, TCComp(), TEQCnsts())
FUNCTION=3
CASE INSTR(1,LineStr,"#ELSE") >0 :
IF TCComp(QQ).IncludeIt=True THEN 'If you were including... Then now don't
TCComp(QQ).IncludeIt=False
ELSE
IF QQ>1 THEN '----doing nested stuff
IF TCComp(QQ-1).IncludeIt=False THEN 'Weren't doing anything before
'Weren't doing anything before.. still not supposed to include it
ELSE 'Were including
TCComp(QQ).IncludeIt=IIF(TCComp(QQ).IncludeIt=True,False,True) 'Works for Not Nested
END IF
ELSE '----not nested
TCComp(QQ).IncludeIt=IIF(TCComp(QQ).IncludeIt=True,False,True) 'Works for Not Nested
END IF
END IF
'FUNCTION=IIF(QQ>0,TCComp(QQ).IncludeIt,True)
FUNCTION=3
CASE INSTR(1,LineStr,"#ENDIF")>0 :
QQ-=1
REDIM PRESERVE TCComp(QQ)
'IF QQ<0 THEN ? "Err="+STR$(ERR)
'FUNCTION=IIF(QQ>0,TCComp(QQ).IncludeIt,True)
FUNCTION=3
CASE INSTR(1,LineStr,"#IF %DEF(")>0 :
CALL CheckEquateIfDef( LineStr, TCComp(), TEqCnsts())
FUNCTION=3
CASE INSTR(1,LineStr,"#IF %")>0 :
CALL CheckEquateIf( LineStr, TCComp(), TEqCnsts()) 'may change ubound of TCComp()
QQ =UBOUND(TCComp)
'FUNCTION=IIF(QQ>0,TCComp(QQ).IncludeIt,True)
FUNCTION=3
CASE INSTR(1,LineStr,"#IF NOT %DEF")>0 :
CALL CheckEquateIfNotDef( LineStr, TCComp(), TEqCnsts()) 'may change ubound of TCComp()
QQ =UBOUND(TCComp)
'FUNCTION=IIF(QQ>0,TCComp(QQ).IncludeIt,True)
FUNCTION=3
CASE INSTR(1,LineStr,"#IF NOT %")>0 :
CALL CheckEquateNotIF( LineStr, TCComp(), TEqCnsts())
QQ =UBOUND(TCComp)
'FUNCTION=IIF(QQ>0,TCComp(QQ).IncludeIt,True)
FUNCTION=3
CASE ELSE
SELECT CASE True
CASE QQ=0
FUNCTION=True
CASE QQ>0
FUNCTION=TCComp(QQ).IncludeIt
END SELECT
END SELECT
'Else
' Function=1 'Didn't have any comp compiles up to this point
'END IF
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main entrance - create dialog, etc.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION WINMAIN (BYVAL hCurInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpszCmdLine AS ASCIIZ PTR, _
BYVAL nCmdShow AS LONG) AS LONG
LOCAL hDlg AS LONG, iCnt AS LONG, rc AS RECT, tmpIncDir AS STRING, tmpStr AS STRING
LOCAL I AS LONG
REDIM sIncDir(0)
REDIM EqCnst(0) AS EquateCnsts
REDIM CComp(0) AS CondCompType
False=0 : True= NOT False
DIALOG NEW 0, "PBcodec v1.5", , , 200,200, %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU TO hDlg
IF hDlg = 0 THEN EXIT FUNCTION
CONTROL ADD LABEL, hDlg, 114, "", 2, 2, 192, 20, %SS_CENTER, %WS_EX_CLIENTEDGE
CONTROL ADD LABEL, hDlg, 115, " Main file: ", 2, 27, 161, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_UnusedFxs, "Unused Functions", 6, 54, 80, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_UnusedSubs, "Unused Subs ", 6, 64, 80, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_UnusedGlobals, "Unused Globals", 6, 74, 80, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_UnusedLocals, "Unused Locals", 6, 84, 80, 10
CONTROL ADD CHECKBOX, hDlg, %IDC_CheckBox2, "Non-Declared Subs/Fcns", 6,107, 90, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_DeclaredButNonExistant, "Declared but non-existant", 6,117, 94, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_GlobalLocalMix, "Global/Local Mix", 6,127, 80, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_DupeGlobal, "Duplicate Globals", 6,137, 90, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_GlobalVariableRpt, "Global Variable", 102, 54, 75, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_ConstantsRpt, "Constants " , 102, 64, 75, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_Includes, "Includes ", 102, 74, 75, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_StringLiterals, "String Literal ", 102, 84, 75, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_TotRefCount, "Functions ", 102, 94, 75, 10
CONTROL ADD CHECKBOX, hDlg, %CheckBox_SubRefCount, "Subroutines", 102,104, 75, 10
CONTROL ADD FRAME, hDlg, %Frame1, "Options", 2, 36, 193, 145
CONTROL ADD FRAME, hDlg, %Frame2, "Unused", 4, 45, 94, 53
CONTROL ADD FRAME, hDlg, %Frame3, "Reports",100, 45, 80, 75
CONTROL SET CHECK hDlg, %IDC_CheckBox2 , 1
CONTROL SET CHECK hDlg, %CheckBox_Includes , 1
CONTROL SET CHECK hDlg, %CheckBox_UnusedFxs , 1
CONTROL SET CHECK hDlg, %CheckBox_UnusedSubs , 1
CONTROL SET CHECK hDlg, %CheckBox_DeclaredButNonExistant , 1
CONTROL SET CHECK hDlg, %CheckBox_UnusedGlobals , 1
CONTROL SET CHECK hDlg, %CheckBox_UnusedLocals , 1
CONTROL SET CHECK hDlg, %CheckBox_GlobalLocalMix , 1
CONTROL SET CHECK hDlg, %CheckBox_DupeGlobal , 1
CONTROL SET CHECK hDlg, %CheckBox_TotRefCount , 1
CONTROL SET CHECK hDlg, %CheckBox_SubRefCount , 1
CONTROL SET CHECK hDlg, %CheckBox_GlobalVariableRpt , 1
CONTROL SET CHECK hDlg, %CheckBox_StringLiterals , 1
CONTROL SET CHECK hDlg, %CheckBox_ConstantsRpt , 1
CONTROL ADD BUTTON, hDlg, %Btn_Unused, "Unused" , 120, 121, 45, 13
CONTROL ADD BUTTON, hDlg, %Btn_Reports, "Reports" , 120, 135, 45, 13
CONTROL ADD BUTTON, hDlg, %Btn_SelectAll, "Select All", 120, 149, 45, 13
CONTROL ADD BUTTON, hDlg, %Btn_UnSelectAll, "UnSelect All", 50, 149, 45, 13
CONTROL ADD BUTTON, hDlg, 120, " &Browse..", 4,183, 50, 14
CONTROL ADD BUTTON, hDlg, %IDOK, "&Scan", 58,183, 50, 14
CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&Quit", 112,183, 50, 14
CONTROL DISABLE hDlg, %IDOK
tmpIncDir = GetIncludeDir 'grab include path from registry
IF LEN(tmpIncDir) THEN 'if we got anything
IF INSTR(tmpIncDir, ";") THEN 'if it contains multiple paths
FOR I = 1 TO PARSECOUNT(tmpIncDir, ";") 'loop through string
tmpStr = TRIM$(PARSE$(tmpIncDir, ";", I)) 'parse out each path
IF LEN(tmpStr) AND TRIM$(DIR$(tmpStr))<>"" THEN 'if we got a path and it exists
REDIM PRESERVE sIncDir(iCnt) 'prepare array
IF ASC(tmpStr, -1) = 92 THEN 'if a path with trailing backslash
sIncDir(iCnt) = tmpStr 'store path in array element
ELSE 'else
sIncDir(iCnt) = tmpStr + "\" 'make sure it has a trailing backslash
END IF
INCR iCnt 'increase temporary array counter
END IF
NEXT
ELSE 'else, single path was given
IF TRIM$(DIR$(tmpIncDir))<>"" THEN 'if it exists
IF ASC(tmpIncDir, -1) = 92 THEN 'if a path with trailing backslash
sIncDir(0) = tmpIncDir 'store path in first array element
ELSE 'else
sIncDir(0) = tmpIncDir + "\" 'make sure it has a trailing backslash
END IF
END IF
END IF
END IF
SystemParametersInfo %SPI_GETWORKAREA, BYVAL 0, BYVAL VARPTR(rc), 0 'grab desktop cordinates
DIALOG PIXELS hDlg, rc.nRight, rc.nBottom TO UNITS rc.nRight, rc.nBottom 'convert to dialog units
DIALOG SET LOC hDlg, rc.nRight - 220, rc.nBottom - 220 'place dialog bottom, right
SetWindowPos hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE 'set dialog topmost
DragAcceptFiles hDlg, %True 'enable drag&drop
REDIM exclude(24) 'exclude these string literals
exclude(0) = "WIN32API.INC" : exclude(1) = "COMDLG32.INC"
exclude(2) = "COMMCTRL.INC" : exclude(3) = "DDT.INC"
exclude(4) = "MDI32.INC" : exclude(5) = "COMBO32.INC"
exclude(6) = "LISTVIEW.INC" : exclude(7) = "TRVIEW32.INC"
exclude(8) = "RICHEDIT.INC" : exclude(9) = "EDIT32.INC"
exclude(10) = "BUTTON32.INC" : exclude(11) = "MMSYSTEM.INC"
exclude(12) = "WSOCK32.INC" : exclude(13) = "STATIC32.INC"
exclude(14) = "DPMI.INC" : exclude(15) = "LZEXPAND.INC"
exclude(16) = "TOOLHLP.INC" : exclude(17) = "VBAPI.INC"
exclude(18) = "CTL3D.INC" : exclude(19) = "VER.INC"
exclude(20) = "WINAPI.INC" : exclude(21) = "WINSOCK.INC"
exclude(22) = "COMMDLG.INC" : exclude(23) = "PROGRAM"
exclude(24) = "WIN32API.INC"
DIALOG SHOW MODAL hDlg CALL WinMainProc
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION WinMainProc() AS LONG
SELECT CASE CBMSG
CASE %WM_INITDIALOG
REDIM Files(1) ' Reset Array
REDIM infile(1)
IF LEN(COMMAND$) THEN
IF GetCommandFile(COMMAND$, Files()) THEN ' Retrieve the contents of the Command String
LOCAL sTimer AS LONG
sTimer = SETTIMER(CBHNDL, 1, 400, %NULL) ' wait for window to draw
END IF
ELSE
CONTROL SET TEXT CBHNDL, 114, "Drag && Drop a main source file on dialog, " + $CRLF + _
"or use Browse to select a file to Scan.."
END IF
CASE %WM_CTLCOLORSTATIC
IF CBLPARAM = GetDlgItem(CBHNDL, 114) THEN
SetBkColor CBWPARAM, GetSysColor(%COLOR_INFOBK)
FUNCTION = GetSysColorBrush(%COLOR_INFOBK)
END IF
CASE %WM_TIMER
KILLTIMER CBHNDL, 1
CALL DoInitProcess(CBHNDL, Files(0))
CASE %WM_DROPFILES
REDIM Files(1) ' Reset Array
REDIM infile(1)
IF GetDroppedFile(CBWPARAM, Files()) THEN ' Retrieve the Dropped filenames
CALL DoInitProcess(CBHNDL, Files(0))
END IF
CASE %WM_DESTROY
CALL DragAcceptFiles(CBHNDL, 0)
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %BTN_Unused
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedFxs , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedSubs , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedGlobals , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedLocals , 1
CASE %Btn_Reports
CONTROL SET CHECK CBHNDL, %CheckBox_Includes , 1
CONTROL SET CHECK CBHNDL, %CheckBox_TotRefCount , 1
CONTROL SET CHECK CBHNDL, %CheckBox_SubRefCount , 1
CONTROL SET CHECK CBHNDL, %CheckBox_GlobalVariableRpt , 1
CONTROL SET CHECK CBHNDL, %CheckBox_ConstantsRpt , 1
CONTROL SET CHECK CBHNDL, %CheckBox_StringLiterals , 1
CASE %Btn_SelectAll
CONTROL SET CHECK CBHNDL, %IDC_CheckBox2 , 1
CONTROL SET CHECK CBHNDL, %CheckBox_Includes , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedFxs , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedSubs , 1
CONTROL SET CHECK CBHNDL, %CheckBox_DeclaredButNonExistant , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedGlobals , 1
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedLocals , 1
CONTROL SET CHECK CBHNDL, %CheckBox_GlobalLocalMix , 1
CONTROL SET CHECK CBHNDL, %CheckBox_DupeGlobal , 1
CONTROL SET CHECK CBHNDL, %CheckBox_TotRefCount , 1
CONTROL SET CHECK CBHNDL, %CheckBox_SubRefCount , 1
CONTROL SET CHECK CBHNDL, %CheckBox_GlobalVariableRpt , 1
CONTROL SET CHECK CBHNDL, %CheckBox_StringLiterals , 1
CONTROL SET CHECK CBHNDL, %CheckBox_ConstantsRpt , 1
CASE %Btn_UnSelectAll
CONTROL SET CHECK CBHNDL, %IDC_CheckBox2 , 0
CONTROL SET CHECK CBHNDL, %CheckBox_Includes , 0
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedFxs , 0
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedSubs , 0
CONTROL SET CHECK CBHNDL, %CheckBox_DeclaredButNonExistant , 0
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedGlobals , 0
CONTROL SET CHECK CBHNDL, %CheckBox_UnusedLocals , 0
CONTROL SET CHECK CBHNDL, %CheckBox_GlobalLocalMix , 0
CONTROL SET CHECK CBHNDL, %CheckBox_DupeGlobal , 0
CONTROL SET CHECK CBHNDL, %CheckBox_TotRefCount , 0
CONTROL SET CHECK CBHNDL, %CheckBox_SubRefCount , 0
CONTROL SET CHECK CBHNDL, %CheckBox_GlobalVariableRpt , 0
CONTROL SET CHECK CBHNDL, %CheckBox_StringLiterals , 0
CONTROL SET CHECK CBHNDL, %CheckBox_ConstantsRpt , 0
CASE 120 'Browse
LOCAL STYLE AS DWORD, fName AS STRING, Buffer AS STRING, PATH AS STRING
STYLE = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY
fName = "*.BAS"
Buffer = "PB Code files (*.BAS)|*.BAS|"
PATH = CURDIR$
IF OpenFileDialog(CBHNDL, "", fName, PATH, Buffer, "BAS" , STYLE) THEN
REDIM Files(1) ' Reset Array
REDIM infile(1)
Files(0) = fName
fName = MID$(fName, INSTR(-1, fName, "\") + 1)
CONTROL SET TEXT CBHNDL, 115, " Main file: " & UCASER(fName)
CONTROL ENABLE CBHNDL, %IDOK
CALL DoInitProcess(CBHNDL, Files(0)) '<- deactivate, if not to scan directly..
END IF
CASE %IDOK
REDIM PRESERVE Files(1)
CALL DoInitProcess(CBHNDL, Files(0)) 'scan file
CASE %IDCANCEL ' Quit
Done = 1 ' jump out of any loops
DIALOG END CBHNDL ' and QUIT
END SELECT
END SELECT
END FUNCTION
'************************************************************************
' Initiate and run entire process
'************************************************************************
SUB DoInitProcess(BYVAL hDlg AS LONG, BYVAL fName AS STRING)
LOCAL ci AS LONG, mc AS LONG
FOR ci = 1 TO 10 : DIALOG DOEVENTS : NEXT
IF TRIM$(DIR$(fName))<>"" THEN 'make sure it exists
ci = IsFileMain(fName) 'if a #COMPILE statement exists (main source file)
SELECT CASE ci
CASE -3 'if return is -3, file was empty
? "Selected file is empty.",,"Error!"
EXIT SUB
CASE -2 'if return is -2, file could not be opened
? "Selected file could not be opened!",,"Error!"
EXIT SUB
CASE >1 'if return is > 1, file was not a main source file
? "Selected file does not contain a #COMPILE statement.",,"Error!"
EXIT SUB
END SELECT
ELSE 'else, it didn't even exist..
MSGBOX "Could not open this file:" + $CRLF + fName + $CRLF + $CRLF + _
"Please make sure it exists and try again.",,"Error!"
EXIT SUB
END IF
CONTROL GET CHECK hDlg, %CheckBox_StringLiterals TO getStrings 'Extract Strings
CONTROL GET CHECK hDlg, %IDC_CheckBox2 TO NotDecl 'Extract Strings
CONTROL GET CHECK hDlg, %CheckBox_Includes TO Do_Includes_Rpt
CONTROL GET CHECK hDlg, %CheckBox_UnusedFxs TO Do_UnusedFxs_Rpt
CONTROL GET CHECK hDlg, %CheckBox_UnusedSubs TO Do_UnusedSubs_Rpt
CONTROL GET CHECK hDlg, %CheckBox_DeclaredButNonExistant TO Do_DeclaredButNonExistant_Rpt
CONTROL GET CHECK hDlg, %CheckBox_UnusedGlobals TO Do_UnusedGlobals_Rpt
CONTROL GET CHECK hDlg, %CheckBox_UnusedLocals TO Do_UnusedLocals_Rpt
CONTROL GET CHECK hDlg, %CheckBox_GlobalLocalMix TO Do_GlobalLocalMix_Rpt
CONTROL GET CHECK hDlg, %CheckBox_DupeGlobal TO Do_DupeGlobal_Rpt
CONTROL GET CHECK hDlg, %CheckBox_TotRefCount TO Do_TotRefCount_Rpt
CONTROL GET CHECK hDlg, %CheckBox_SubRefCount TO Do_SubRefCount_Rpt
CONTROL GET CHECK hDlg, %CheckBox_GlobalVariableRpt TO Do_GlobalVariableRpt_Rpt
CONTROL GET CHECK hDlg, %CheckBox_StringLiterals TO Do_StringLiterals_Rpt
CONTROL GET CHECK hDlg, %CheckBox_ConstantsRpt TO Do_Constants_Rpt
CONTROL DISABLE hDlg, 120
CONTROL DISABLE hDlg, %IDOK
CONTROL DISABLE hDlg, %IDC_CheckBox2
CONTROL DISABLE hDlg, %CheckBox_Includes
CONTROL DISABLE hDlg, %CheckBox_UnusedFxs
CONTROL DISABLE hDlg, %CheckBox_UnusedSubs
CONTROL DISABLE hDlg, %CheckBox_DeclaredButNonExistant
CONTROL DISABLE hDlg, %CheckBox_UnusedGlobals
CONTROL DISABLE hDlg, %CheckBox_UnusedLocals
CONTROL DISABLE hDlg, %CheckBox_GlobalLocalMix
CONTROL DISABLE hDlg, %CheckBox_DupeGlobal
CONTROL DISABLE hDlg, %CheckBox_TotRefCount
CONTROL DISABLE hDlg, %CheckBox_SubRefCount
CONTROL DISABLE hDlg, %CheckBox_GlobalVariableRpt
CONTROL DISABLE hDlg, %CheckBox_StringLiterals
CONTROL DISABLE hDlg, %CheckBox_ConstantsRpt
FilePathStr = LEFT$(fName, INSTR(-1, fName, "\"))
FileNameStr = MID$(fName, INSTR(-1, fName, "\") + 1)
CONTROL SET TEXT hDlg, 115, " Main file: " & UCASER(FileNameStr)
IF Files(0) = "" THEN Files(0) = fName
CHDRIVE LEFT$(FilePathStr, 2)
CHDIR FilePathStr
CONTROL SET TEXT hDlg, 114, "Collecting include files"
REDIM EqCnst(0)
gCountCRLFs=1 'Turn the count on
CALL DoGetIncFiles(fName, CComp(), EqCnst())
iFuncts = 0 : REDIM Functs(0)
igVars = 0 : REDIM gVars(0)
ilVars = 0 : REDIM lVars(0)
iVars = 0 : REDIM Vars(0)
igDbl = 0 : REDIM gDbl(0)
DeclCount = 0 : REDIM gDecl(0)
sStrCount = 0 : REDIM sString(0)
gTotLines = 0
t = TIMER
REDIM EqCnst(0)
REDIM CComp(0)
REDIM CondCompile2(0)
REDIM EquateConst2(0)
FOR mc = 0 TO 1
IF mc=1 THEN gCountCRLFS=0 'Turn the count off
REDIM CondCompile2(0) AS CondCompType
REDIM EquateConst2(0) AS EquateCnsts
FOR ci = 0 TO UBOUND(Files)
SELECT CASE UCASE$(MID$(Files(ci), INSTR(-1, Files(ci), "\") + 1)) 'ignore these
CASE "WIN32API.INC", "COMDLG32.INC", "COMMCTRL.INC", "COMBO32.INC", _
"DDT.INC", "MDI32.INC", "LISTVIEW.INC", "TRVIEW32.INC", "RICHEDIT.INC", _
"EDIT32.INC", "BUTTON32.INC", "MMSYSTEM.INC", "WSOCK32.INC", _
"STATIC32.INC", "DPMI.INC", "LZEXPAND.INC", "TOOLHLP.INC", "VBAPI.INC", _
"CTL3D.INC", "VER.INC", "WINAPI.INC", "WINSOCK.INC", "COMMDLG.INC"
CASE ELSE
IF mc = 0 THEN
CONTROL SET TEXT hDlg, 114, "Scanning for Local vars, Subs and Functions in: " + _
MID$(Files(ci), INSTR(-1, Files(ci), "\") + 1)
ELSE
CONTROL SET TEXT hDlg, 114, "Scanning for Global vars in: " + _
MID$(Files(ci), INSTR(-1, Files(ci), "\") + 1)
END IF
CALL DoProcess(Files(ci), ci, mc, CondCompile2(), EquateConst2())
END SELECT
NEXT
IF mc = 0 THEN
IF iFuncts THEN REDIM PRESERVE Functs(iFuncts)
IF igVars THEN REDIM PRESERVE gVars(igVars)
IF ilVars THEN REDIM PRESERVE lVars(ilVars)
IF igDbl THEN REDIM PRESERVE gDbl(igDbl)
IF DeclCount THEN REDIM PRESERVE gDecl(DeclCount)
IF sStrCount THEN REDIM PRESERVE sString(sStrCount)
END IF
NEXT
t = TIMER - t
CONTROL ENABLE hDlg, 120
CONTROL ENABLE hDlg, %IDOK
CONTROL ENABLE hDlg, %IDC_CheckBox2
CONTROL ENABLE hDlg, %CheckBox_Includes
CONTROL ENABLE hDlg, %CheckBox_UnusedFxs
CONTROL ENABLE hDlg, %CheckBox_UnusedSubs
CONTROL ENABLE hDlg, %CheckBox_DeclaredButNonExistant
CONTROL ENABLE hDlg, %CheckBox_UnusedGlobals
CONTROL ENABLE hDlg, %CheckBox_UnusedLocals
CONTROL ENABLE hDlg, %CheckBox_GlobalLocalMix
CONTROL ENABLE hDlg, %CheckBox_DupeGlobal
CONTROL ENABLE hDlg, %CheckBox_TotRefCount
CONTROL ENABLE hDlg, %CheckBox_SubRefCount
CONTROL ENABLE hDlg, %CheckBox_GlobalVariableRpt
CONTROL ENABLE hDlg, %CheckBox_StringLiterals
CONTROL ENABLE hDlg, %CheckBox_ConstantsRpt
CONTROL SET TEXT hDlg, 114, "Done! Drag && Drop a main source file on dialog, " + $CRLF + _
"or use Browse to select a file to Scan.."
CALL DoSaveResults
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Get all included files into array
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DoGetIncFiles(BYVAL TheFile AS STRING, _
BYREF TCComp() AS CondCompType, _
BYREF TEqCnst() AS EquateCnsts)
LOCAL ci AS LONG, ii AS LONG, sTemp2 AS STRING
LOCAL A$, B$, C$
LOCAL I, J, K, L, M, N, O, QQ, RR, SS, Found, retval AS LONG
LOCAL IncludingIt AS LONG
REDIM tmpFiles(0) AS STRING
REDIM Arr$(0)
I=ReadFile(TheFile,Arr$()) '----Bas file goes into Arr$()
FOR I=1 TO UBOUND(Arr$)
LineStr=Arr$(I) 'Starting point
LineStr=TRIM$(LineStr)
'----- handle comments started with '
J=INSTR(1,LineStr,"'") 'Any Comments?
IF J>0 THEN
IF J=1 THEN ITERATE FOR '1st char is comment marker
LineStr=LEFT$(LineStr,J-1) 'eliminate comments
END IF
'------ handle comments started with REM
J=INSTR(1,LineStr,"REM ")
SELECT CASE J
CASE 0 : 'No comment
CASE 1 : ITERATE FOR '1st char is comment
CASE ELSE : A$=MID$(LineStr,J-1,1)
IF A$=" " OR A$=":" THEN LineStr=LEFT$(LineStr,MAX(1,J-2)) 'eliminate comments
END SELECT
'--- Didn't work... below
'Replace Any " " With " " in LineStr '#IF %ABC
DO
J=INSTR(1,LineStr," ")
IF J=0 THEN EXIT DO
LineStr=STRDELETE$(LineStr,j,1)
LOOP
IF TRIM$(LineStr)="" THEN ITERATE FOR
RetVal=ChkCondCompile(lineStr, TCComp(), TEqCnst()) 'Returns 0 if we are not taking the code
SELECT CASE RetVal
CASE 0,3 : ITERATE FOR
CASE ELSE 'flow thru
END SELECT
'------- start looking for triggers in source code
SELECT CASE True
CASE INSTR(1,LineStr,"#INCLUDE ")>0
J=UBOUND(TCComp)
SELECT CASE True
CASE J<1
GOSUB GetInclude 'No Nests Then Go Get It
CASE J>0 AND TCComp(J).IncludeIt=True : 'Nested
GOSUB GetInclude
END SELECT
CASE INSTR(1,LineStr,"$INCLUDE ") >0
J=UBOUND(TCComp)
SELECT CASE True
CASE J<1
GOSUB GetInclude 'No Nests Then Go Get It
CASE J>0 AND TCComp(J).IncludeIt=True : 'Nested
GOSUB GetInclude
END SELECT
'CASE INSTR(1,LineStr,"#IF %DEF(") >0 : CALL CheckEquateIfDef(LineStr, CComp(), EqCnst())
'CASE INSTR(1,LineStr,"#IF NOT %DEF(")>0 :
' CALL CheckEquateIfNotDef(LineStr, CComp(), EqCnst())
'CASE INSTR(1,LineStr,"#IF NOT %") >0 : CALL CheckEquateNotIF(LineStr, CComp(), EqCnst())
'CASE INSTR(1,LineStr,"#IF %") >0 : CALL CheckEquateIF(LineStr, CComp(), EqCnst())
CASE LEFT$(LineStr,1)="%"
CALL GetEquate(LineStr,TEQCnst())
END SELECT
NEXT
EXIT SUB
GetInclude:
sWork = PARSE$(LineStr, CHR$(34), 2) 'get filename
IF LEFT$(sWork, 2) = ".\" THEN 'resolve eventual relative paths
sWork = FilePathStr + MID$(sWork, 2)
ELSEIF LEFT$(sWork, 3) = "..\" THEN
sWork = LEFT$(FilePathStr, INSTR(-2, FilePathStr, "\")) + MID$(sWork, 4)
ELSEIF LEFT$(sWork, 4) = "...\" THEN
sTemp2 = LEFT$(FilePathStr, INSTR(-2, FilePathStr, "\"))
sWork = LEFT$(sTemp2, INSTR(-2, sTemp2, "\")) + MID$(sWork, 5)
ELSEIF LEFT$(sWork, 5) = "....\" THEN
sTemp2 = LEFT$(FilePathStr, INSTR(-2, FilePathStr, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sWork = LEFT$(sTemp2, INSTR(-2, sTemp2, "\")) + MID$(sWork, 6)
ELSEIF LEFT$(sWork, 6) = ".....\" THEN
sTemp2 = LEFT$(FilePathStr, INSTR(-2, FilePathStr, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sWork = LEFT$(sTemp2, INSTR(-2, sTemp2, "\")) + MID$(sWork, 7)
ELSEIF LEFT$(sWork, 7) = "......\" THEN
sTemp2 = LEFT$(FilePathStr, INSTR(-2, FilePathStr, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sTemp2 = LEFT$(sTemp2, INSTR(-2, sTemp2, "\"))
sWork = LEFT$(sTemp2, INSTR(-2, sTemp2, "\")) + MID$(sWork, 8)
END IF
IF INSTR(-1, sWork, ".") = 0 THEN 'if no file extension is given,
sWork += ".BAS" 'compiler assumes .BAS file
END IF
'if no path is given, compiler will first look in include dir, so we better start there
IF INSTR(sWork, "\") = 0 THEN 'if no path given
FOR ii = 0 TO UBOUND(sIncDir) 'loop through the ones we have
IF TRIM$(DIR$(sIncDir(ii) + sWork))<>"" THEN 'if file exists
sWork = sIncDir(ii) + sWork 'use it
END IF
NEXT
END IF
IF LEN(FilePathStr) AND TRIM$(DIR$(FilePathStr + sWork))<>"" THEN 'try with current file's path
sWork = FilePathStr + sWork 'if ok, use it
END IF
IF TRIM$(DIR$(sWork))<>"" THEN 'safety check - if we can find what we got..
sWork=UCASE$(sWork) 'store path + name in temporary array
SELECT CASE MID$(Files(ci), INSTR(-1, swork, "\") + 1)
CASE "WIN32API.INC", "COMDLG32.INC","COMMCTRL.INC","COMBO32.INC" , _
"DDT.INC" , "MDI32.INC" ,"LISTVIEW.INC","TRVIEW32.INC", _
"RICHEDIT.INC", "EDIT32.INC" ,"BUTTON32.INC","MMSYSTEM.INC", _
"WSOCK32.INC", "STATIC32.INC","DPMI.INC" ,"LZEXPAND.INC", _
"TOOLHLP.INC", "VBAPI.INC" ,"CTL3D.INC" ,"VER.INC" , _
"WINAPI.INC", "WIN32API.Inc","WINSOCK.INC" ,"COMMDLG.INC" : 'Do nothing
CASE ELSE :
Found=0
ARRAY SCAN Files(),=swork, TO Found '#include once ... laziness
IF Found=0 THEN
QQ=UBOUND(files)
A$=files(QQ) : A$=REMOVE$(A$,ANY CHR$(0))
IF TRIM$(A$)="" THEN
Files(QQ) =swork
InFile(QQ)=MID$(TheFile, INSTR(-1, TheFile, "\") + 1)
ELSE
INCR QQ
REDIM PRESERVE files(QQ) : Files(QQ) =swork
REDIM PRESERVE infile(QQ) : InFile(QQ)=MID$(TheFile, INSTR(-1, TheFile, "\") + 1)
END IF
CALL DoGetIncFiles(swork, TCComp(), TEqCnst()) 'recursive call to get eventual includes in includes
END IF
END SELECT
END IF
RETURN
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Trim away all leading/ending non-letters and digits from a string
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION AnsiTRIM(BYVAL txt AS STRING) AS STRING
LOCAL pos1 AS LONG, pos2 AS LONG
FOR pos1 = 1 TO LEN(txt)
IF IsCharAlphaNumeric(ASC(txt, pos1)) THEN EXIT FOR
NEXT
FOR pos2 = LEN(txt) TO 1 STEP -1
IF IsCharAlphaNumeric(ASC(txt, pos2)) THEN EXIT FOR
NEXT
IF Pos2 > Pos1 THEN FUNCTION = MID$(txt, Pos1, Pos2 - Pos1 + 1)
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Load text from file, extract lines and get all subs, functions and globals
' into arrays.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DoProcess(BYVAL TheFile AS STRING,_
BYVAL fNum AS LONG,_
BYVAL WhatRun AS LONG,_
BYREF CondCompile2() AS CondCompType, _
BYREF EquateConst2() AS EquateCnsts)
IF TRIM$(DIR$(TheFile))="" THEN EXIT SUB 'if file doesn't exist, exit
LOCAL ci AS LONG, I AS LONG, p AS LONG, Letter AS BYTE PTR, Letter2 AS BYTE PTR
LOCAL Ac AS LONG, K AS LONG, sFlag AS LONG, QuotePos AS LONG, QuotePos2 AS LONG, dbl AS LONG, dUscored AS LONG
LOCAL exported AS LONG, x AS LONG, y AS LONG, uscoredGlobal AS LONG, endRout AS LONG, fUscored AS LONG
LOCAL di AS LONG, POS AS LONG, wordFlag AS LONG, StrFlag AS LONG, dFlag AS LONG, inPar AS LONG
LOCAL locX AS LONG, locY AS LONG, locPos AS LONG, uscoredLocal AS LONG, iv AS LONG, isGLOBAL AS LONG
LOCAL MainStr AS STRING, sBuf AS STRING, txt AS STRING, Buf AS STRING, fsName AS STRING, strDump AS STRING
LOCAL Retval, J, II AS LONG
DIM ArrTxt(0) AS STRING
LOCAL A$
II=ReadFile(TheFile,ArrTxt())
IF II<2 THEN EXIT SUB
'--------------------------------------------------------------------
' scan MainStr and extract lines
'--------------------------------------------------------------------
FOR II=1 TO UBOUND(ArrTxt)
Txt=ArrTxt(II)
GOSUB ExtractLine
NEXT
EXIT SUB
'---------------------------------------------------------
' Extract line from main text
'---------------------------------------------------------
ExtractLine:
'--------------------------------------------------------------------
' blank out text within double quotes
'--------------------------------------------------------------------
QuotePos = INSTR(txt, $DQ) 'see if there is any
IF QuotePos THEN
DO 'loop while there is any left
QuotePos2 = INSTR(QuotePos + 1, txt, $DQ) 'look for matching pair
IF QuotePos2 THEN
IF WhatRun = 0 AND getStrings = 1 THEN 'if to extract string literals
strDump = AnsiTRIM(MID$(txt, QuotePos, QuotePos2 - QuotePos + 1))
IF LEN(strDump) THEN
ARRAY SCAN exclude(), FROM 1 TO LEN(strDump), COLLATE UCASE, = strDump, TO Ac
IF Ac = 0 THEN
IF sStrCount MOD 20 = 0 THEN REDIM PRESERVE sString(sStrCount + 20)
'sString(sStrCount) = FORMAT$(fNum) + $TAB + USING$("####", I) + $TAB + strDump
sString(sStrCount) = FORMAT$(fNum) + $TAB + USING$("####", II) + $TAB + strDump
INCR sStrCount
END IF
END IF
END IF
MID$(txt, QuotePos, QuotePos2 - QuotePos + 1) = SPACE$(QuotePos2 - QuotePos + 1)
QuotePos = INSTR(QuotePos2 + 1, txt, $DQ)
IF QuotePos = 0 THEN EXIT DO
ELSE
EXIT DO
END IF
LOOP
END IF
txt = LTRIM$(EXTRACT$(txt, "'")) 'cut off ev. uncommented part and trim away leading spaces
IF ASC(txt) = 82 AND LEFT$(txt, 4) = "REM " THEN RETURN 'if whole line in uncommented
IF INSTR(txt, " REM ") THEN
txt = LEFT$(txt, INSTR(txt, "REM ")) 'same here, if REM was used
END IF
IF INSTR(txt, " _") THEN
txt = LEFT$(txt, INSTR(txt, " _") + 2) 'if line wraps to next, ignore the rest of it
ELSEIF INSTR(txt, ",_ ") THEN
txt = LEFT$(txt, INSTR(txt, ",_ ")) + " _" 'adjust to parser
ELSEIF RIGHT$(txt, 2) = ",_" THEN
txt = LEFT$(txt, LEN(txt) - 2) + " _" 'adjust to parser
END IF
IF ASC(txt, -1) = 32 THEN txt = RTRIM$(txt) 'trim off trailing spaces
IF INSTR(txt, ":") THEN 'colon inside paranthesis must be converted
inPar = 0
FOR Letter2 = STRPTR(txt) TO STRPTR(txt) + LEN(txt)
SELECT CASE @Letter2
CASE 40 : INCR inPar 'left paranthesis (
CASE 41 : DECR inPar 'right paranthesis )
CASE 58 : IF inPar > 0 THEN @Letter2 = 59 'if within paranthesis, convert colon to semicolon (whatever)
END SELECT
NEXT
END IF
RetVal=ChkCondCompile(Txt, CondCompile2(), EquateConst2()) 'Returns 0 if we are not taking the code
SELECT CASE RetVal
CASE 0,3 : RETURN
CASE ELSE 'flow thru
END SELECT
'------- start looking for triggers in source code
IF LEFT$(Txt,1)="%" THEN
CALL GetEquate(Txt,EQuateConst2())
RETURN
END IF
J=UBOUND(CondCompile2)
SELECT CASE True
CASE J<1 : 'No Nests Then Go Get It
CASE J>0 AND CondCompile2(J).IncludeIt=True : 'Nested and OK
CASE J>0 AND CondCompile2(J).IncludeIt=False 'Nested and Not OK
RETURN
END SELECT
IF LEN(txt) > 2 THEN 'now, if line is enough long
IF WhatRun = 0 THEN 'and first run
GOSUB ExtractSub 'send it to sub/function check
GOSUB ExtractGlobal 'send it to global variable check
ELSE
IF LTRIM$(LEFT$(txt, 8)) = "DECLARE " OR dUscored THEN
dUscored = (ASC(TRIM$(txt), -1) = 95)
RETURN
END IF
GOSUB ChkVariables 'second run, calculate globals
END IF
END IF
RETURN
'---------------------------------------------------------
' Get subs and functions, plus get/check local variables (DIM, LOCAL, STATIC)
'---------------------------------------------------------
ExtractSub:
IF sFlag = 0 THEN
Buf = UCASER(txt)
IF LEFT$(Buf, 8) = "DECLARE " THEN 'Declaration
IF INSTR(Buf, " LIB ") THEN RETURN 'external routine - DLL, etc.
txt = LTRIM$(MID$(txt, 9))
Buf = txt : dFlag = 1
IF LEN(RTRIM$(txt)) = 1 AND ASC(txt) = 95 THEN RETURN
END IF
SELECT CASE True
CASE LEFT$(Buf, 9) = "FUNCTION " 'Function start
sFlag = 2 : fsName = LTRIM$(MID$(txt, 10)) : K = I
CASE LEFT$(Buf, 4) = "SUB " 'Sub start
sFlag = 1 : fsName = LTRIM$(MID$(txt, 5)) : K = I
CASE LEFT$(Buf, 18) = "CALLBACK FUNCTION " 'Callback Function start
sFlag = 3 : fsName = LTRIM$(MID$(txt, 19)) : K = I
END SELECT
IF sFlag THEN
IF INSTR(fsName, " EXPORT") THEN exported = 1
Ac = INSTR(fsName, ANY " ('")
IF Ac THEN fsName = TRIM$(LEFT$(fsName, Ac - 1), ANY " &%@!#$?")
END IF
IF LEN(fsName) = 1 AND ASC(fsName) = 95 THEN fUscored = 1
IF dFlag AND fUscored = 0 THEN
GOSUB AddDeclare : RETURN
END IF
ELSE
IF fUscored THEN
IF dFlag AND INSTR(Buf, " LIB ") THEN RETURN 'external routine, DLL
IF fUscored = 1 THEN 'look for name
ac = INSTR(LTRIM$(txt), ANY " (")
IF Ac THEN
fsName = TRIM$(LEFT$(txt, Ac - 1), ANY " &%@!#$?")
ELSE
fsName = TRIM$(txt, ANY " &%@!#$?")
END IF
ELSE
IF INSTR(txt, "EXPORT") THEN exported = 1
END IF
IF ASC(TRIM$(txt), -1) = 95 THEN
fUscored = 2
ELSE
fUscored = 0
END IF
END IF
IF dFlag AND fUscored = 0 THEN 'declaration
GOSUB AddDeclare : RETURN
END IF
SELECT CASE sFlag
CASE 1
IF LEFT$(txt, 7) = "END SUB" THEN
endRout = sFlag
ELSE
GOSUB ExtractLocals
GOSUB ChkVariables
RETURN
END IF
CASE 2, 3
IF LEFT$(txt, 12) = "END FUNCTION" THEN
endRout = sFlag
ELSE
GOSUB ExtractLocals
GOSUB ChkVariables
RETURN
END IF
END SELECT
IF endRout THEN
IF iFuncts MOD 40 = 0 THEN REDIM PRESERVE Functs(iFuncts + 40)
fsName = RTRIM$(fsName)
Functs(iFuncts).zName = fsName
fsName = UCASE$(fsName)
Functs(iFuncts).uName = fsName & CHR$(0)
Functs(iFuncts).iType = endRout
Functs(iFuncts).LineNum = II 'was K
Functs(iFuncts).SubEnd = I
Functs(iFuncts).FileNum = fNum
Functs(iFuncts).Exported = exported
INCR iFuncts
sFlag = 0 : endRout = 0 : exported = 0
IF iVars THEN
REDIM PRESERVE lVars(ilVars + iVars)
FOR iv = 0 TO iVars - 1
lVars(ilVars).zName = Vars(iv).zName
lVars(ilVars).uName = Vars(iv).uName
lVars(ilVars).InFunct = Vars(iv).InFunct
lVars(ilVars).iType = Vars(iv).iType
lVars(ilVars).LineNum = Vars(iv).LineNum
lVars(ilVars).FileNum = Vars(iv).FileNum
lVars(ilVars).IsUsed = Vars(iv).IsUsed
INCR ilVars
NEXT
iVars = 0 : REDIM Vars(0)
END IF
END IF
END IF
RETURN
AddDeclare:
IF DeclCount MOD 40 = 0 THEN REDIM PRESERVE gDecl(DeclCount + 40)
fsName = RTRIM$(fsName)
gDecl(DeclCount).zName = fsName
fsName=UCASE$(fsName)
gDecl(DeclCount).uName = fsName & CHR$(0)
gDecl(DeclCount).iType = sFlag
gDecl(DeclCount).LineNum = II 'was K
gDecl(DeclCount).SubEnd = I
gDecl(DeclCount).FileNum = fNum
gDecl(DeclCount).Exported = exported
INCR DeclCount
sFlag = 0 : endRout = 0 : exported = 0 : dFlag = 0
RETURN
'---------------------------------------------------------
' Get Locals
'---------------------------------------------------------
ExtractLocals:
IF INSTR(txt, "LOCAL ") OR INSTR(txt, "DIM ") OR _
INSTR(txt, "STATIC ") OR uscoredLocal THEN
FOR locX = 1 TO PARSECOUNT(txt, ":")
sWork = TRIM$(PARSE$(txt, ":", locX))
IF LEFT$(sWork, 6) = "LOCAL " OR _
LEFT$(sWork, 4) = "DIM " OR _
LEFT$(sWork, 7) = "STATIC " OR _
uscoredLocal THEN
IF uscoredLocal = 0 THEN
IF LEFT$(sWork, 6) = "LOCAL " THEN
isGLOBAL = 0 : sWork = MID$(sWork, 7)
ELSEIF LEFT$(sWork, 4) = "DIM " THEN
isGLOBAL = 1 : sWork = MID$(sWork, 5) 'start out by assuming global status
ELSEIF LEFT$(sWork, 7) = "STATIC " THEN
isGLOBAL = 0 : sWork = MID$(sWork, 8)
END IF
END IF
FOR locY = 1 TO PARSECOUNT(sWork, ",")
sBuf = TRIM$(PARSE$(sWork, ",", locY))
IF isGLOBAL = 1 THEN 'check if DIM statement really was global
IF INSTR(sBuf, " GLOBAL") THEN 'this can only happen
isGLOBAL = 2 'with "DIM xx AS GLOBAL.."
ELSEIF INSTR(sBuf, " LOCAL") OR _ 'local DIM..
INSTR(sBuf, " STATIC") THEN
isGLOBAL = 0
END IF
END IF
sBuf = EXTRACT$(sBuf, ANY " ()") 'Chop off AS LONG, etc, or if array - (
sBuf = RTRIM$(sBuf, ANY " &%@!#$?")
IF LEN(sBuf) = 1 AND ASC(sBuf) = 95 THEN ITERATE
sBuf = sBuf + CHR$(0)
IF isGLOBAL < 2 THEN
ARRAY SCAN Vars(), FROM 1 TO LEN(sBuf), COLLATE UCASE, = sBuf, TO locPos
IF locPos = 0 THEN
IF iVars MOD 40 = 0 THEN REDIM PRESERVE Vars(iVars + 40)
Vars(iVars).zName = sBuf
Vars(iVars).uName = sBuf
Vars(iVars).InFunct = fsName
Vars(iVars).FileNum = fNum
Vars(iVars).iType = isGlobal
Vars(iVars).LineNum = II 'was I
INCR iVars
END IF
ELSE
ARRAY SCAN gVars(), FROM 1 TO LEN(sBuf), COLLATE UCASE, = sBuf, TO POS
IF POS = 0 THEN 'if not already there, add it (GLOBAL+DIM/REDIM, DIM AS GLOBAL, etc.)
IF igVars MOD 40 = 0 THEN REDIM PRESERVE gVars(igVars + 40)
gVars(igVars).zName = sBuf
gVars(igVars).uName = sBuf
gVars(igVars).FileNum = fNum
gVars(igVars).LineNum = II 'was I
INCR igVars
END IF
END IF
NEXT
END IF
NEXT
uscoredLocal = (RIGHT$(RTRIM$(txt), 2) = " _")
END IF
RETURN
'---------------------------------------------------------
' Get Globals
'---------------------------------------------------------
ExtractGlobal:
IF INSTR(txt, "GLOBAL ") OR uscoredGlobal THEN
FOR x = 1 TO PARSECOUNT(txt, ":")
sWork = TRIM$(PARSE$(txt, ":", x))
isGLOBAL = (LEFT$(sWork, 7) = "GLOBAL ")
IF isGLOBAL = 0 THEN isGLOBAL = uscoredGlobal
IF LEFT$(sWork, 7) = "GLOBAL " OR uscoredGlobal THEN
IF uscoredGlobal = 0 THEN sWork = MID$(sWork, 8)
FOR y = 1 TO PARSECOUNT(sWork, ",")
sBuf = TRIM$(PARSE$(sWork, ",", y))
sBuf = EXTRACT$(sBuf, ANY " ()") 'Chop off AS LONG etc.
sBuf = RTRIM$(sBuf, ANY " &%@!#$?")
IF LEN(sBuf) = 1 AND ASC(sBuf) = 95 THEN ITERATE
sBuf = sBuf + CHR$(0)
IF igVars THEN 'must check for ev. duplicate declarations
ARRAY SCAN gVars(), FROM 1 TO LEN(sBuf), COLLATE UCASE, = sBuf, TO dbl
IF dbl THEN
IF igDbl THEN
ARRAY SCAN gDbl(), FROM 1 TO LEN(sBuf), COLLATE UCASE, = sBuf, TO dbl
IF dbl THEN
INCR gDbl(dbl - 1).IsUsed
ITERATE FOR
END IF
END IF
REDIM PRESERVE gDbl(igDbl)
gDbl(igDbl).zName = sBuf
gDbl(igDbl).uName = sBuf
gDbl(igDbl).FileNum = fNum
gDbl(igDbl).LineNum = II 'was I
INCR igDbl
ITERATE FOR
END IF
END IF
IF igVars MOD 40 = 0 THEN REDIM PRESERVE gVars(igVars + 40)
gVars(igVars).zName = sBuf
gVars(igVars).uName = sBuf
gVars(igVars).FileNum = fNum
gVars(igVars).LineNum = II 'was I
INCR igVars
NEXT
END IF
NEXT
IF isGlobal THEN uscoredGlobal = ( RIGHT$(RTRIM$(txt), 2) = " _" )
END IF
RETURN
'---------------------------------------------------------
' Check variables
'---------------------------------------------------------
ChkVariables:
wordFlag = 0 : StrFlag = 0
Letter2 = STRPTR(txt)
FOR di = 1 TO LEN(txt)
SELECT CASE @Letter2
'a-z, A-Z, 0-9, _, (Single Line Characters?), (Double line characters?)
CASE 97 TO 122, 65 TO 90, 48 TO 57, 95, 192 TO 214, 216 TO 246, 248 TO 255
IF wordFlag = 0 AND @Letter2 <> 95 THEN 'if valid char and no flag, word starts here (not with underscore)
wordFlag = 1 : POS = di 'set wordflag and store position
END IF
CASE ELSE 'we hit something else, like space, dot, etc..
IF wordFlag = 1 THEN 'if flag, then a word is ready
GOSUB ChkWord 'check what we got
wordFlag = 0 'and reset wordflag
END IF
END SELECT
INCR Letter2 'next char
NEXT
IF wordFlag = 1 THEN GOSUB ChkWord 'in case there were letters all the way to the end..
RETURN
ChkWord:
POS = di - POS 'calculate length
sBuf = PEEK$(Letter2 - POS, POS) + CHR$(0) 'grab word
IF WhatRun = 0 THEN 'check local variables
ARRAY SCAN Vars(), FROM 1 TO LEN(sBuf), = sBuf, TO POS
IF POS THEN INCR Vars(POS - 1).IsUsed
'IF InStr(Txt,"FD4972") >0 And InStr(Txt,"TSJ")>0 And InStr(TheFile,"ARTD")>0 THEN
' ? "Txt="+Txt+$CRLF+_
' "Pos="+Str$(Pos)+$CRLF+_
' "Ubound(Vars)="+Str$(UBound(Vars))+$CRLF+_
' "Vars(Pos-1).zName="+Vars(Pos-1).zName+$CRLF+_
' "sBuf="+sBuf
'End IF
ELSE 'check Subs(Functions and Global vars
ARRAY SCAN Functs(), FROM 1 TO LEN(sBuf), = sBuf, TO POS
IF POS THEN INCR Functs(POS - 1).IsUsed
ARRAY SCAN gVars(), FROM 1 TO LEN(sBuf), = sBuf, TO POS
IF POS THEN INCR gVars(POS - 1).IsUsed
END IF
RETURN
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Prepare and save a report of what we've found out!
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB DoSaveResults
LOCAL hFile AS LONG, lRes AS LONG, fDbl AS LONG, cTmp AS LONG, I AS LONG, _
uline AS STRING, fName AS STRING, aStr AS STRING, aStr2 AS STRING
'------------------------------------------------------------------------------
' first look through locals array. if iType = 1, it may be a GLOBAL DIM
'------------------------------------------------------------------------------
IF igVars AND ilVars THEN
FOR I = ilVars - 1 TO 0 STEP -1 '<- must run this backwards through array!
IF lVars(I).iType = 1 THEN
aStr = lVars(I).uName + CHR$(0)
ARRAY SCAN gVars(), FROM 1 TO LEN(aStr), = aStr, TO cTmp
IF cTmp THEN 'if also GLOBAL, remove from local arrays
ARRAY DELETE lVars(I)
DECR ilVars
END IF
END IF
NEXT
END IF
astr="" 'NNM 4/30/2010
REDIM PRESERVE lVars(ilVars)
'------------------------------------------------------------------------------
' now prepare report..
'------------------------------------------------------------------------------
DestFile = PARSE$(FileNameStr, ANY ".", 1)+"LOG.txt"
OPEN FilePathStr + DestFile FOR OUTPUT AS hFile
sWork = STRING$(80,"¤")
uline = STRING$(80,"-")
GOSUB ReportHeader
IF Do_Includes_Rpt THEN GOSUB ReportFiles 'List of Includes processed
IF Do_UnusedFxs_Rpt THEN GOSUB UnusedFunctions 'List of unused Functions
IF Do_UnusedSubs_Rpt THEN GOSUB UnusedSubs 'List of unused Subs
IF Do_DeclaredButNonExistant_Rpt THEN GOSUB DecButNonExistant 'Declared but non Existant
'IF NotDecl THEN
' GOSUB ExistingButNotDecl 'PB 9.00 allows functions without declaring Nathan Maddox
'END IF
IF Do_UnusedGlobals_Rpt THEN GOSUB UnusedGlobals
IF Do_UnusedLocals_Rpt THEN GOSUB UnusedLocals
IF Do_GlobalLocalMix_Rpt THEN GOSUB GlobalLocalMix
IF Do_DupeGlobal_Rpt THEN GOSUB DupeGlobalNames
IF Do_TotRefCount_Rpt THEN GOSUB TotRefCount
IF Do_SubRefCount_Rpt THEN GOSUB SubRefCount
IF Do_GlobalVariableRpt_Rpt THEN GOSUB GlobalVariableRpt
IF Do_StringLiterals_Rpt THEN GOSUB StringLiterals
IF Do_Constants_Rpt THEN GOSUB ConstantsReport '--- for debugging purposes Nathan Maddox 9/29/09
CLOSE hFile
SLEEP 20
'Launch Log file in default Viewer.
ShellExecute 0, "open", FilePathStr + DestFile, BYVAL 0, BYVAL 0, %SW_SHOWNORMAL
EXIT SUB
ConstantsReport:
'------------------------------------------------------------------------------
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " CONSTANTS NAME CONSTANT VALUE "
PRINT# hFile, uline
FOR I = 1 TO UBOUND(EquateConst2)
A$=EquateConst2(I).EquateName + " "+FORMAT$(EquateConst2(i).EquateVal)
PRINT# hFile, A$
NEXT I
RETURN
ReportHeader:
'------------------------------------------------------------------------------
PRINT# hFile, sWork
PRINT# hFile, " PBcodec report: " UCASER(FileNameStr) + " + include files. " & _
"Generated " & DATE$ & ", " & TIME$
PRINT# hFile, STR$(gTotLines) + " lines scanned in " + FORMAT$(t, "0.000") + _
" seconds (" + FORMAT$(gTotLines / t * 60, "0") + " lines/minute)"
PRINT# hFile, sWork
RETURN
ReportFiles:
'------------------------------------------------------------------------------
IF UBOUND(Files) > -1 THEN
PRINT# hFile, " MAIN + INCLUDE FILES"
PRINT# hFile, uline
inFile(0) = "Main source file"
FOR I = 0 TO UBOUND(Files)
PRINT# hFile, " " & LEFT$(Files(I) & aStr & SPACE$(58), 58) & "[" +inFile(I) + "]"
NEXT I
END IF
RETURN
UnUsedFunctions:
'------------------------------------------------------------------------------
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " UN-USED FUNCTIONS (exported, or in incl. files, may be used by other programs)"
PRINT# hFile, uline
IF iFuncts THEN
FOR I = 0 TO iFuncts - 1
IF Functs(I).IsUsed = 1 AND Functs(I).iType > 1 THEN
SELECT CASE Functs(I).zName
CASE "PBMAIN", "WINMAIN", "LIBMAIN", "PBLIBMAIN", "DLLMAIN" 'ignore these
CASE ELSE
fName = Files(Functs(I).FileNum)
aStr = " FUNCTION " : aStr2 = ""
IF Functs(I).iType = 3 THEN aStr = " CALLBACK "
IF Functs(I).Exported THEN aStr2 = " <EXPORT>"
PRINT# hFile, LEFT$(aStr & Functs(i).zName & aStr2 & SPACE$(52), 52) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" STR$(Functs(I).LineNum)
END SELECT
END IF
NEXT I
END IF
RETURN
UnUsedSubs:
'------------------------------------------------------------------------------
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " UN-USED SUBS (exported, or in incl. files, may be used by other programs)"
PRINT# hFile, uline
IF iFuncts THEN
FOR I = 0 TO iFuncts - 1
IF Functs(I).IsUsed = 1 AND Functs(I).iType = 1 THEN
fName = Files(Functs(I).FileNum)
aStr2 = ""
IF Functs(I).Exported THEN aStr2 = " <EXPORT>"
PRINT# hFile, LEFT$(" SUB " & Functs(i).zName & aStr2 & SPACE$(50), 50) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" STR$(Functs(I).LineNum)
END IF
NEXT I
END IF
RETURN
DecButNonExistant:
'------------------------------------------------------------------------------
IF DeclCount THEN
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " DECLARED, BUT NON-EXISTING SUB/FUNCTION(S)"
PRINT# hFile, uline
FOR I = 0 TO DeclCount - 1
IF iFuncts > 0 THEN
aStr = gDecl(I).uName + CHR$(0)
ARRAY SCAN Functs(), FROM 1 TO LEN(aStr), = aStr, TO fDbl
END IF
IF fDbl = 0 THEN
fName = Files(gDecl(I).FileNum)
aStr2 = ""
IF gDecl(I).iType = 1 THEN
aStr = " SUB "
ELSEIF gDecl(I).iType = 2 THEN
aStr = " FUNCTION "
ELSEIF gDecl(I).iType = 3 THEN
aStr = " CALLBACK "
END IF
IF gDecl(I).Exported THEN aStr2 = " <EXPORT>"
PRINT# hFile, LEFT$(aStr & gDecl(I).zName & aStr2 & SPACE$(50), 50) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" STR$(gDecl(I).LineNum)
END IF
NEXT I
END IF
RETURN
ExistingButNotDecl:
'------------------------------------------------------------------------------
IF iFuncts THEN
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " EXISTING, BUT NON-DECLARED SUB/FUNCTION(S)"
PRINT# hFile, uline
FOR I = 0 TO iFuncts - 1
IF DeclCount THEN
aStr = Functs(I).uName + CHR$(0)
ARRAY SCAN gDecl(), FROM 1 TO LEN(aStr), = aStr, TO fDbl
END IF
IF fDbl = 0 THEN
SELECT CASE Functs(I).zName
CASE "PBMAIN", "WINMAIN", "LIBMAIN", "PBLIBMAIN", "DLLMAIN" 'ignore these
CASE ELSE
fName = Files(Functs(I).FileNum)
aStr2 = ""
IF Functs(I).iType = 1 THEN
aStr = " SUB "
ELSEIF Functs(I).iType = 2 THEN
aStr = " FUNCTION "
ELSEIF Functs(I).iType = 3 THEN
aStr = " CALLBACK "
END IF
IF Functs(I).Exported THEN aStr2 = " <EXPORT>"
PRINT# hFile, USING$("####", Functs(I).IsUsed - 1) & _
LEFT$(aStr & Functs(I).zName & aStr2 & SPACE$(45), 45) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" STR$(Functs(I).LineNum)
END SELECT
END IF
NEXT
END IF
RETURN
UnusedGlobals:
'------------------------------------------------------------------------------
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " UN-USED GLOBAL VARIABLES"
PRINT# hFile, uline
IF igVars THEN
FOR I = 0 TO igVars - 1
IF gVars(I).IsUsed = 1 THEN
fName = Files(gVars(I).FileNum)
PRINT# hFile, " " & LEFT$(gVars(i).zName & SPACE$(47), 47) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(gVars(I).LineNum)
END IF
NEXT I
END IF
RETURN
UnusedLocals:
'------------------------------------------------------------------------------
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " UN-USED LOCAL VARIABLES"
PRINT# hFile, uline
IF ilVars THEN
FOR I = 0 TO ilVars - 1
IF lVars(I).IsUsed = 1 THEN
fName = Files(lVars(I).FileNum)
PRINT# hFile, " " & LEFT$(lVars(i).zName & SPACE$(47), 47) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(lVars(I).LineNum)
END IF
NEXT I
END IF
RETURN
GlobalLocalMix:
'------------------------------------------------------------------------------
IF igVars AND ilVars THEN
FOR I = 0 TO igVars - 1
aStr = gVars(I).uName & CHR$(0)
ARRAY SCAN lVars(), FROM 1 TO LEN(aStr), = aStr, TO cTmp
IF cTmp THEN EXIT FOR
NEXT
IF cTmp THEN
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " GLOBAL/LOCAL MIX - WARNING!"
PRINT# hFile, " Following global variable name(s) exist in both global and local"
PRINT# hFile, " form. While the compiler allows this, special care must be taken"
PRINT# hFile, " to avoid hard-to-find errors. Please check them out carefully."
PRINT# hFile, uline
FOR I = 0 TO igVars - 1
aStr = gVars(I).uName & CHR$(0)
ARRAY SCAN lVars(), FROM 1 TO LEN(aStr), = aStr, TO lRes
IF lRes THEN
cTmp = 0 : fDbl = 0
fName = Files(gVars(I).FileNum)
PRINT# hFile, " " & LEFT$(gVars(I).zName & SPACE$(47), 47) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(gVars(I).LineNum)
DO
cTmp = cTmp + lRes
fName = Files(lVars(cTmp - 1).FileNum)
PRINT# hFile, " local in " & _
MID$(fName, INSTR(-1, fName, "\") + 1) & " :" & STR$(lVars(cTmp - 1).LineNum)
ARRAY SCAN lVars(cTmp), FROM 1 TO LEN(aStr), = aStr, TO lRes
LOOP WHILE lRes
END IF
NEXT
END IF
END IF
RETURN
DupeGlobalNames:
'------------------------------------------------------------------------------
IF igDbl THEN
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " DUPLICATE GLOBAL NAMES - WARNING!"
PRINT# hFile, " Following global name(s) exist as both array and varíable."
PRINT# hFile, " While the compiler allows this, special care must be taken"
PRINT# hFile, " avoid hard-to-find errors. Please check them out carefully."
PRINT# hFile, uline
FOR I = 0 TO igDbl - 1
fName = Files(gDbl(I).FileNum)
PRINT# hFile, " " & LEFT$(gDbl(I).zName & SPACE$(47), 47) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(gDbl(I).LineNum)
NEXT
END IF
RETURN
TotRefCount:
'------------------------------------------------------------------------------
'code added by Wayne Diamond, slightly altered by Borje Hagsten
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " TOTAL REFERENCE COUNT - (Count, Name, [declared in File] : at Line number)"
PRINT# hFile, " Lists how many times the following has been called/used (zero = un-used)"
PRINT# hFile, uline
'------------------------------------------------------------------------------
IF iFuncts > 0 THEN
PRINT# hFile, " FUNCTIONS:"
FOR I = 0 TO iFuncts - 1
IF Functs(I).iType > 1 THEN
SELECT CASE Functs(I).zName
CASE "PBMAIN", "WINMAIN", "LIBMAIN", "PBLIBMAIN", "DLLMAIN" 'ignore these
CASE ELSE
fName = Files(Functs(I).FileNum)
aStr = ""
IF Functs(I).Exported THEN aStr = " <EXPORT>"
PRINT# hFile, USING$("####", Functs(I).IsUsed - 1) & " " & _
LEFT$(Functs(I).zName & aStr & SPACE$(43), 43) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(Functs(I).LineNum)
END SELECT
END IF
NEXT I
END IF
RETURN
SubRefCount:
'------------------------------------------------------------------------------
PRINT# hFile, ""
IF iFuncts > 0 THEN
PRINT# hFile, " SUBS:"
FOR I = 0 TO iFuncts - 1
IF Functs(I).iType = 1 THEN
fName = Files(Functs(I).FileNum)
aStr = ""
IF Functs(I).Exported THEN aStr = " <EXPORT>"
PRINT# hFile, USING$("####", Functs(I).IsUsed - 1) & " " & _
LEFT$(Functs(I).zName & aStr & SPACE$(43), 43) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(Functs(I).LineNum)
END IF
NEXT I
END IF
RETURN
GlobalVariableRpt:
'------------------------------------------------------------------------------
PRINT# hFile, ""
IF igVars > 0 THEN
PRINT# hFile, " GLOBAL VARIABLES:"
FOR I = 0 TO igVars - 1
fName = Files(gVars(I).FileNum)
PRINT# hFile, USING$("####", gVars(I).IsUsed - 1) & " " & _
LEFT$(gVars(I).zName & SPACE$(43), 43) & " [" & _
MID$(fName, INSTR(-1, fName, "\") + 1) & "] :" & STR$(gVars(I).LineNum)
NEXT I
END IF
'end of Wayne Diamond code
RETURN
StringLiterals:
IF sStrCount THEN
PRINT# hFile, ""
PRINT# hFile, sWork
PRINT# hFile, " STRING LITERALS"
fName = ""
FOR I = 0 TO sStrCount - 1
aStr = Files(VAL(PARSE$(sString(I), $TAB, 1)))
aStr = MID$(aStr, INSTR(-1, aStr, "\") + 1)
IF aStr <> fName THEN
fName = aStr
PRINT# hFile, ""
IF I THEN PRINT# hFile, uline
PRINT# hFile, " Line Text [" + fName + "]"
PRINT# hFile, uline
END IF
PRINT# hFile, PARSE$(sString(I), $TAB, 2) + " " + _
PARSE$(sString(I), $TAB, 3)
NEXT
END IF
'------------------------------------------------------------------------------
RETURN
END SUB
'************************************************************************
' GetCommandFile - loads a received Path&File name into global array
'************************************************************************
FUNCTION GetCommandFile(BYVAL CmdStr AS STRING, Fi() AS STRING) AS LONG
LOCAL tmpName AS STRING, pStr AS STRING
CmdStr = TRIM$(CmdStr) 'trim away ev. leading/ending spaces
IF LEFT$(CmdStr, 1) = CHR$(34) THEN 'if in double-quotes
CmdStr = MID$(CmdStr, 2) 'remove first quote
pStr = CHR$(34) 'and use DQ as delimiter for PARSE$
ELSE
pStr = " " 'else use space as delimiter
END IF
tmpName = TRIM$(PARSE$(CmdStr, pStr, 1))
IF LEN(tmpName) = 0 THEN EXIT FUNCTION
IF (GETATTR(tmpName) AND 16) = 0 THEN 'make sure it isn't a folder
Fi(0) = tmpName
ELSE
EXIT FUNCTION
END IF
FUNCTION = 1 'return number of collected files
END FUNCTION
'************************************************************************
' GetDroppedFile - Function Loads File/Folder names into the global arrays
'************************************************************************
FUNCTION GetDroppedFile( BYVAL hfInfo AS LONG, Fi() AS STRING) AS LONG
LOCAL COUNT AS LONG, ln AS LONG, tmp AS STRING, fName AS ASCIIZ * %MAX_PATH
COUNT = DragQueryFile(hfInfo, &HFFFFFFFF&, BYVAL %NULL, 0) 'get number of dropped files
IF COUNT THEN 'If we got something
ln = DragQueryFile(hfInfo, 0, fName, %MAX_PATH) 'put FileName into fString And get len
IF ln THEN
tmp = TRIM$(LEFT$(fName, ln))
IF LEN(tmp) AND (GETATTR(tmp) AND 16) = 0 THEN 'make sure it's a file, not a folder
Fi(0) = tmp
FUNCTION = 1
END IF
END IF
END IF
CALL DragFinish(hfInfo)
END FUNCTION
'************************************************************************
' Get PB/DLL 6 compiler's include dir (winapi folder)
'************************************************************************
FUNCTION GetIncludeDir AS STRING
LOCAL lRet AS LONG, hKey AS LONG
LOCAL Buffer AS ASCIIZ * %MAX_PATH, SubKey AS STRING
Buffer = "Software\PowerBASIC\PB/Win\7.00"
SubKey = "Filename"
IF RegOpenKeyEx(%HKEY_LOCAL_MACHINE, Buffer, 0, _
%KEY_QUERY_VALUE, hKey) = %ERROR_SUCCESS THEN
lRet = RegQueryValueEx(hKey, BYVAL STRPTR(SubKey), _
BYVAL 0&, BYVAL 0&, Buffer, SIZEOF(Buffer))
IF LEN(Buffer) THEN FUNCTION = TRIM$(Buffer)
IF hKey THEN RegCloseKey hKey
IF LEN(TRIM$(Buffer)) THEN
Buffer = TRIM$(Buffer)
Buffer = LEFT$(Buffer, INSTR(-1, Buffer, ANY "\/")) ' Compiler path
SubKey = LEFT$(Buffer, INSTR(-1, Buffer, "\Bin\")) + "WinAPI" ' WinAPI path
Buffer = IniGetString("Compiler", "Include0", SubKey, Buffer + "PBWin.ini")
IF LEN(TRIM$(Buffer)) THEN
Buffer = TRIM$(Buffer)
IF RIGHT$(Buffer, 1) <> "\" THEN
IF RIGHT$(Buffer, 1) <> "/" THEN Buffer = Buffer + "\"
END IF
FUNCTION = TRIM$(Buffer)
EXIT FUNCTION
END IF
END IF
END IF
Buffer = "Software\PowerBasic\PB/WIN\9.00\Compiler"
SubKey = "Include"
IF RegOpenKeyEx(%HKEY_CURRENT_USER, Buffer, 0, _
%KEY_QUERY_VALUE, hKey) = %ERROR_SUCCESS THEN
lRet = RegQueryValueEx(hKey, BYVAL STRPTR(SubKey), _
BYVAL 0&, BYVAL 0&, Buffer, SIZEOF(Buffer))
IF LEN(Buffer) THEN FUNCTION = TRIM$(Buffer)
' MSGBOX Buffer
FUNCTION = Buffer
IF hKey THEN RegCloseKey hKey
ELSE
Buffer = "Software\PowerBasic\PB/WIN\9.00\Compiler"
IF RegOpenKeyEx(%HKEY_CURRENT_USER, Buffer, 0, _
%KEY_QUERY_VALUE, hKey) = %ERROR_SUCCESS THEN
lRet = RegQueryValueEx(hKey, BYVAL STRPTR(SubKey), _
BYVAL 0&, BYVAL 0&, Buffer, SIZEOF(Buffer))
IF LEN(Buffer) THEN FUNCTION = TRIM$(Buffer)
IF hKey THEN RegCloseKey hKey
END IF
END IF
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Get string from ini file
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION IniGetString(BYVAL sSection AS STRING, BYVAL sKey AS STRING, _
BYVAL sDefault AS STRING, BYVAL sFile AS STRING) AS STRING
LOCAL RetVal AS LONG, zResult AS ASCIIZ * %MAX_PATH
RetVal = GetPrivateProfileString(BYVAL STRPTR(sSection), _
BYVAL STRPTR(sKey), _
BYVAL STRPTR(sDefault), _
zResult, SIZEOF(zResult), BYVAL STRPTR(sFile))
IF RetVal THEN FUNCTION = TRIM$(LEFT$(zResult, RetVal))
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Check to see if the file has a #COMPILE metastatement
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION IsFileMain(BYVAL fName AS STRING) AS LONG
LOCAL hFile AS LONG, txt AS STRING
hFile = FREEFILE 'get a free file handle
OPEN fName FOR INPUT AS hFile LEN = 16383 'open file
IF ERR THEN 'if it failed
RESET : ERRCLEAR 'reset, clear error
FUNCTION = -2 : EXIT FUNCTION 'return -2 to indicate failure and exit
END IF
IF LOF(hFile) = 0 THEN 'if zero length file
CLOSE hFile 'close it
FUNCTION = -3 : EXIT FUNCTION 'return -3 to indicate empty file and exit
END IF
DO WHILE EOF(hFile) = 0 'loop through file
LINE INPUT# hFile, txt 'line by line
txt=TRIM$(Txt) 'NNM 9/22/09
txt=REMOVE$(Txt, ANY $TAB) 'NNM 9/22/09
txt=UCASE$(Txt)
IF LEN(txt) > 8 THEN 'if enough long
IF (ASC(txt) = 35 OR ASC(txt) = 36) AND MID$(txt, 2, 8) = "COMPILE " THEN
FUNCTION=1
EXIT DO
END IF
IF LEFT$(txt, 9) = "FUNCTION " OR _ 'jump out once we hit a Sub or Function
LEFT$(txt, 4) = "SUB " OR _
LEFT$(txt, 9) = "CALLBACK " OR _
LEFT$(txt, 7) = "STATIC " THEN
FUNCTION = LOF(hFile) 'return length
EXIT DO
END IF
END IF
LOOP
CLOSE hFile
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' UCASER function, returns UCASE string without altering original
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION UCASER(BYVAL st AS STRING) AS STRING
#REGISTER NONE
LOCAL p AS STRING PTR
p = STRPTR(st)
! mov eax, p ; move pointer to string into eax
! mov ecx, [eax-4] ; move length of string into ecx (counter)
! cmp ecx, 0 ; if length is 0, no string length
! je exitUCASER ; then exit
beginUCASER:
! mov dl, [eax] ; move current char into dl
! cmp dl, 97 ; compare against value 97 (a)
! jb nextUCASER ; if dl < 97 then get next character
! cmp dl, 123 ; compare against value 123
! jb makeUCASER ; if dl < 123 it is in 97-122 range, make Uppercase and get next
! cmp dl, 224 ; compare against value 224 (à) - extended ANSI
! jb nextUCASER ; if dl < 224 it is in 123-224 range, do nothing to it
! cmp dl, 247 ; compare against value 247
! jb makeUCASER ; if dl < 247 it is in 224-247 range, make Uppercase and get next
! je nextUCASER ; if dl = 247, do nothing
! cmp dl, 255 ; compare against value 255
! jb makeUCASER ; if dl < 255 it is in 248-255 range, make Uppercase and get next
! jmp nextUCASER ; else, on to next character
makeUCASER:
! sub dl, 32 ; make lowercase by adding 32 to dl's value
! mov [eax], dl ; write changed char back into eax and fall through to nextUCASER
nextUCASER:
! inc eax ; get next character
! dec ecx ; decrease ecx (length) counter
! jnz beginUCASER ; iterate if not zero (end of string)
FUNCTION = st
exitUCASER:
END FUNCTION
Leave a comment: