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




Reply With Quote
Bookmarks