clea all

* Create/Ready Vis_code.dbf:
IF ! FILE([Vis_code.dbf])
CREATE TABLE Vis_code.dbf ;
(Line C(254), File C(100), ObjName C(100), Line_no N(5,0), MethName C(15))
ELSE
USE Vis_code
ZAP
ENDIF
* Populate main code:
mMainFile =GETFILE('PRG', 'Main Program:', 'Main Program',1)
IF EMPTY(mMainFile)
CLEAR ALL
RETURN
ENDIF
APPEND FROM &mMainFile TYPE SDF
REPLACE ALL File WITH UPPER(mMainFile)
REPLACE ALL Line WITH UPPER(Line)

* Trim the Tabs:
REPLACE Line WITH STRTRAN(Line, CHR(9), []) FOR LEFT(Line,1) =CHR(9)

GO TOP
* Find the executables:
mrec=0
DO WHILE .T.
LOCATE FOR (LEFT(Line,3) =[DO ] OR LEFT(Line,8) =[SET PROC] OR (LEFT(Line,13) =[ON ESCAPE DO ] ;
AND [ IN ] $ Line)) AND RECNO() >mRec AND ! ;
(LEFT(Line,7) =[DO CASE] OR LEFT(Line,8) =[DO WHILE] OR RIGHT(RTRIM(Line),3) =[ TO])
mRec =RECNO()
? mRec
* IF MREC =38651
* SET STEP ON
* ENDIF
WAIT WINDOW [On Record ] +LTRIM(STR(mRec)) +[ of ] +LTRIM(STR(RECCOUNT())) + [ Records] NOWAIT
IF EOF()
EXIT
ENDIF

* Get prg, form, or procedure file name:
DO CASE
CASE LEFT(UPPER(Line),7) =[DO FORM]
mFile =RTRIM(SUBSTR(Line, 9, 100)) +[.SCX]
mType =[FORM]
CASE LEFT(UPPER(Line),8) =[SET PROC]
mLeft =AT([TO], Line) +3
mFile =RTRIM(SUBSTR(Line, mLeft, 100)) +[.PRG]
mType =[PROCEDURE]
CASE [ IN ] $ UPPER(Line)
mFile =RIGHT(RTRIM(Line), LEN(RTRIM(Line)) -RAT([ IN ],RTRIM(Line)) -3)
IF RIGHT(RTRIM(UPPER(Line)),4) <>[.PRG]
mFile =mFile +[.PRG]
ENDIF
OTHERWISE && This is a DO prg or function/procedure
mFile =RTRIM(SUBSTR(Line, 3, 100)) +[.PRG]
mType =[PROGRAM]
ENDCASE
* Fix it if it's a "DO FORM MYFORM TO MYVAR" program:
mFile =UPPER(mFile)
IF [ TO ] $ mFile
mLeft =AT([ TO ],mFile)
mExt =RIGHT(mFile,4)
mFile =STUFF(mFile,mLeft,LEN(mFile),[]) +mExt
ENDIF
* Fix it if it's a "DO FORM MYFORM WITH " program:
IF [ WITH ] $ mFile
mLeft =AT([ WITH ],mFile)
mExt =RIGHT(mFile,4)
mFile =STUFF(mFile,mLeft,LEN(mFile),[]) +mExt
ENDIF
IF LEFT(mFile,1) =[&]
mFile =STRTRAN(mFile,[.PRG],[])
mFile =STRTRAN(mFile,[.SCX],[])
mVarName=STUFF(mFile,1,1,[])
mDoName =File
LOCATE FOR File =mDoName AND mVarName $Line
IF ! EOF()
IF LEFT(Line,4) =[STOR] && This is a STORE mVar TO line
mLeft =AT([TO], Line) +3
ELSE && This is an mVar = line
mLeft =AT([=], Line) +1
ENDIF
mFile =ALLTRIM(SUBSTR(Line, mLeft, 100))
IF RIGHT(mFile,4) <>[.SCX] AND RIGHT(mFile,4) <>[.PRG]
mExtension =IIF(mType =[FORM],[.SCX],[.PRG])
mFile =mFile +mExtension
ENDIF
ELSE
mVar =mFile && This will trigger the prg to tell the user that the
mFile =[] && file can't be found
ENDIF
GOTO mRec
ENDIF
IF EMPTY(mFile)
mMsgText ="The memory variable " +RTRIM(mVar) +" is mentioned as an " +;
" executable but is not defined in the calling program, " +RTRIM(File) +;
". Please investigate. Vis_code will continue."
mMsgTitle ="Action!"
mAnswer =MESSAGEBOX(mMsgText, 0, mMsgTitle)
ELSE
* Check to see it's not already in Vis_code
LOCATE FOR RTRIM(File) =RTRIM(mFile)
IF EOF()
IF RIGHT(mFile,4) =[.PRG] && It's a Prg
IF FILE(mFile) && This guards against trying to use procedures as files
APPEND FROM &mFile TYPE SDF
LOCATE FOR EMPTY(File)
mNo =1
DO WHILE ! EOF()
REPLACE File WITH mFile
REPLACE Line_no WITH mNo
mNo =mNo +1
CONTINUE
ENDDO
ENDIF
ELSE && It's an SCX
IF FILE(mFile)
SELECT 0
USE &mFile ALIAS aForm
LOCATE FOR ! EMPTY(Methods) OR ! EMPTY(Properties)
DO WHILE ! EOF()
SELECT Vis_code
APPEND BLANK
REPLACE ObjName WITH aForm.ObjName
REPLACE File WITH mFile
REPLACE Line WITH UPPER([* Class =] +ALLTRIM(aForm.Class) +;
[; Parent =] +ALLTRIM(aForm.Parent))
mMemLines =MEMLINES(aForm.Properties)
mNo =1
DO WHILE mNo <=mMemLines
APPEND BLANK
REPLACE ObjName WITH aForm.ObjName
REPLACE File WITH mFile
REPLACE MethName WITH [Property]
REPLACE Line WITH UPPER(MLINE(aForm.Properties, mNo))
* Trim the Tabs:
IF LEFT(Line,1) =CHR(9)
REPLACE Line WITH STRTRAN(Line, CHR(9), [])
ENDIF
mNo =mNo +1
ENDDO
mMemLines =MEMLINES(aForm.Methods)
mNo =1
mLine_no =1
DO WHILE mNo <=mMemLines
APPEND BLANK
IF LEFT(MLINE(aForm.Methods, mNo), 10) =[PROCEDURE ]
mMethName =STUFF(MLINE(aForm.Methods, mNo), 1, 10, [])
mLine_no =1
ENDIF
REPLACE ObjName WITH aForm.ObjName
REPLACE File WITH mFile
REPLACE MethName WITH mMethName
REPLACE Line WITH UPPER(MLINE(aForm.Methods, mNo))
* Trim the Tabs:
IF LEFT(Line,1) =CHR(9)
REPLACE Line WITH STRTRAN(Line, CHR(9), [])
ENDIF
REPLACE Line_no WITH mLine_no
mLine_no =mLine_no +1
mNo =mNo +1
ENDDO
SELECT aForm
CONTINUE
ENDDO
USE
ENDIF
ENDIF
ENDIF
ENDIF
SELECT Vis_code
ENDDO