OK, now I'm proud of this program. I got to thinking that in the
first version, it seemed possible to mess up both the program and
the backup. Now the program is copied to the backup and that is
not touched. From my first post:
Hello,
This isn't rocket science, but I wrote it, use it, and like it.
It scans a program for "Sub"s and "Functions"s and adds those lines
as a summary at the top of the program (removing the old summary).
You need to change:
1) the Const BkupFile to a place where you want to have a backup file.
2) the Const FileName to the program you want processed. A good addition
would be to have a file dialog instead of a Const.
' [re-posted on 16-11-2011 with suggestions from thread]
' ---- sub/function summary
' Sub TBMain()
' Function CkIterate(txt As String) As Long
' Function LFill(s1 As String, pl As Long) As String
' Sub ErrStop(txt As String)
' ---- end of sub/function summary
Uses "Console", "file", "UI" ' by dCromley 11/2011
Const sHeader As String = "' ---- sub/function summary"
Const sFooter As String = "' ---- end of sub/function summary"
Const BkupFile As String = APP_ScriptName + ".BACKUP"
Sub TBMain()
Local fhin, fhout As Long
Local i1 As Long, s1, s1u, s2, sRec As String
Local FileName As String
FileName = Dialog_OpenFile(0, "Select a file", DIR_GetCurrent, _
"TB Files (*.tBasic*)|*.tBasic*|All Files (*.*)|*.*", "", 0)
If FileName = "" Then Exit Sub
' -- copy the file to the backup
If Not FILE_Exists(FileName) Then ErrStop "<" & FileName & "> doesn't exist"
fhout = FILE_Open(BkupFile, "output") ' check the output file
If fhout = 0 Then ErrStop "Open Output " & BkupFile
FILE_Close(fhout)
FILE_Copy(FileName, BkupFile)
PrintL FileName & " copied to " & bkupfile & $CRLF
' -- now output to the original file
fhout = FILE_Open(FileName, "output")
If fhout = 0 Then ErrStop "Open Output " & FileName
' -- pass 1, delete old summary and make new summary
fhin = FILE_Open(BkupFile, "input")
If fhin = 0 Then ErrStop "Open Input " & BkupFile
FILE_LinePrint(fhout, sHeader) ' header
PrintL sHeader
Do While Not FILE_EOF(fhin)
sRec = FILE_LineInput(fhin)
If CkIterate(srec) Then Iterate Do ' bypass old list
s1 = Parse$(srec, " ", 1) ' get "Sub" or "Function" or ..
s1u = Ucase$(s1) ' ensure no case difference
If s1u = "SUB" Or s1u = "FUNCTION" Or s1u = "CALLBACK" Then
i1 = InStr(1, srec, s1) ' get rest of line
s2 = "' " & LFill(s1, 9) & Mid$(srec, Len(s1)+2)
PrintL s2 ' re-constructed line
FILE_LinePrint(fhout, s2)
End If
Loop
FILE_Close(fhin)
FILE_LinePrint(fhout, sFooter) ' footer
PrintL sFooter & $CRLF
FILE_Close(fhin)
' -- pass 2, the rest of the file
fhin = FILE_Open(BkupFile, "input")
If fhin = 0 Then ErrStop "Open Input " & BkupFile
Do While Not FILE_EOF(fhin)
srec = FILE_LineInput(fhin)
If CkIterate(srec) Then Iterate Do ' bypass old list again
FILE_LinePrint(fhout, srec)
Loop
FILE_Close(fhin)
' -- end of pass 2
FILE_Close(fhout)
PrintL "End - reveiw " & FileName
WaitKey
End Sub
Function CkIterate(txt As String) As Long
Static swIterate As Long
' set bypass if header
If txt = sHeader Then swIterate = 1
Function = swIterate
' reset bypass if footer
If txt = sFooter Then swIterate = 0
If LEFT$(txt, 1) <> "'" Then ' safety ck
swIterate = 0
Function = 0
End If
End Function
Function LFill(s1 As String, pl As Long) As String
' Left$, but fill with " "s
Function = LEFT$(s1 & String$(pl, " "), pl)
End Function
Sub ErrStop(txt As String)
MsgBox 0, "Err: " & txt: Stop
End Sub
Bookmarks