|
|
Post by mknarr on Sept 14, 2019 12:18:03 GMT -5
Here is a program that will do that and more.
'Liberty Basic Reader
'Works with any LB 4.5 and lower.
'Copyright 2013 by Jim Brossman
curversion$="12.2" '6/10/2016
dim info$(10,10)
dim DataArray$(50000)'This contains all the extracted data. Labels, Handles etc.
dim DisplayBox$(2500)'Used to display page numbers in the JumpTo window.
dim RecentArray$(8)
dir$=DefaultDir$+"\"
files DefaultDir$,"recent.ini",info$(
if val(info$(0,0))=0 then 'If the recent.ini file doesn't exist
open DefaultDir$+"\recent.ini" for output as #1
for x=1 to 8 'then fill it with blank spaces.
print #1, ""
next
close #1
end if
call GetIni 'Now get the existing recent files and fill the RecentArray$.
nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
UpperLeftX= 0
UpperLeftY=0
BackgroundColor$ = "white"
ForegroundColor$ = "black"
loadbmp "lb", dir$+"LBReader.bmp"
loadbmp "lastbut",dir$+"lastbut.bmp"
loadbmp "dbttn", dir$+"dbttn.bmp"
loadbmp "ubttn", dir$+"ubttn.bmp"
loadbmp "firstbut", dir$+"firstbut.bmp"
loadbmp "jumpto", dir$+"jumpto.bmp"
loadbmp "print", dir$+"print.bmp"
menu #main, "&File","&Open File && Run", [OpenBasFile],|,"&1. ",[recent1],_
"&2. ",[recent2],"&3.",[recent3],"&4.",[recent4],"&5.",[recent5],"&6.",[recent6],"&7.",[recent7],_
"&8. ",[recent8],|, "E&xit", [Quit]
menu #main, "&Display", "&Arrays", [ArrayDisplay],"&File Names",[FileNameDisplay],"&Handles", [HandleDisplay],_
"&Labels", [LabelDisplay],"&Numeric Variables",[NumericDisplay], "&String Variables", [StringDisplay],_
"Gosub Labels", [GosubDisplay], "GoTo Labels",[GotoDisplay],"Subs and &Functions",[SubDisplay],"&Working File",[WorkingFile],_
"Number of Working Lines", [ActualLines]
menu #main, "&Help", "&Help",[Help],"&About LB Reader", [About]
stylebits #main.st0, _SS_BITMAP, 0, 0, 0
statictext #main.st0, "", int(WindowWidth/2)-175, int(WindowHeight/2)-200, 1, 1
open "LB Reader v"+curversion$ for window as #main
hMain=HWnd(#main) 'Handle of main window.
calldll #user32, "GetMenu",hMain as ulong,hMenu as ulong 'Get handle of the menu.
calldll #user32, "GetSubMenu",hMenu as ulong,0 as long,hfile as ulong 'Get handle of file menu.
'Get info for each recent menu line and modify the menu.
for x=1 to 8
a$=RecentArray$(x)
calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong 'Get the ID number of the file menu.
call MenuMod hfile, hfileid,a$,x 'Modify the recent menu items.
next
'And draw the menu bar.
calldll #user32, "DrawMenuBar", hMain as ulong, result as boolean 'Redraw the menu.
#main, "trapclose [Quit]" 'Handle of main window.
callDLL #user32, "ShowWindow",hMain As uLong,_SW_MAXIMIZE As Long, r As Boolean
hst0 = hwnd(#main.st0) 'Required for staticimage.
hB0 = hbmp("lb") 'Required for staticimage.
Call staticImage hst0, hB0 'Required for staticimage.
[MainLoop]
wait
[Quit] 'End the program.
unloadbmp "lb"
unloadbmp "lastbut"
unloadbmp "dbttn"
unloadbmp "ubttn"
unloadbmp "firstbut"
unloadbmp "jumpto"
unloadbmp "print"
close #main
end
[ArrayDisplay] 'Will display and optionally print the list of arrays.
displayfile$="ArrayFile.txt"
gosub [FindFiles]
goto [MainLoop]
[FileNameDisplay] 'Will display the list of file names.
displayfile$="FileName.txt"
gosub [FindFiles]
goto [MainLoop]
[HandleDisplay] 'Will display and optionally print the list of handles.
displayfile$="HandleFile.txt"
gosub [FindFiles]
goto [MainLoop]
[LabelDisplay] 'Will display and optionally print the list of labels.
displayfile$="LabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[NumericDisplay] 'Will display and optionally print the list of numeric variables.
displayfile$="NumericFile.txt"
gosub [FindFiles]
goto [MainLoop]
[StringDisplay] 'Will display and optionally print the list of string variables.
displayfile$="StringFile.txt"
gosub [FindFiles]
goto [MainLoop]
[SubDisplay] 'Will display and optionally print the list of Subs and Functions.
displayfile$="SubFile.txt"
gosub [FindFiles]
goto [MainLoop]
[GosubDisplay]
displayfile$="GosubLabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[GotoDisplay]
displayfile$="GoToLabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[WorkingFile] 'Will display and optionally print the remaining lines in the working file.
displayfile$="WorkingFile.txt"
gosub [FindFiles]
goto [MainLoop]
[recent1] 'For recent file 1
RecentFile$=RecentArray$(1)
Index=1
goto [OpenRecentFile]
[recent2]
RecentFile$=RecentArray$(2)
Index=2
goto [OpenRecentFile]
[recent3]
RecentFile$=RecentArray$(3)
Index=3
goto [OpenRecentFile]
[recent4]
RecentFile$=RecentArray$(4)
Index=4
goto [OpenRecentFile]
[recent5]
RecentFile$=RecentArray$(5)
Index=5
goto [OpenRecentFile]
[recent6]
RecentFile$=RecentArray$(6)
Index=6
goto [OpenRecentFile]
[recent7]
RecentFile$=RecentArray$(7)
Index=7
goto [OpenRecentFile]
[recent8]
RecentFile$=RecentArray$(8)
Index=8
goto [OpenRecentFile]
[OpenRecentFile] 'Open a file listed in the recent menus.
if RecentFile$="" then 'If the selected menu item does not have a recent file in it.
notice "Notice!"+chr$(13)+"No recent file selected"
wait
end if
'Get the file name and path so the files statement works.
FileName$=SeparateFile$(RecentFile$) 'Get the recent file name.
FilePath$=SeparatePath$(RecentFile$) 'Get the file path.
'and see if the file really exists.
files FilePath$,FileName$,info$(
if val(info$(0,0))=0 then 'The file no longer exists.
Notice "Notice!"+chr$(13)+ "File "+FileName$+" no longer exists."
RecentArray$(Index)="" 'Clear the array element for the file that is missing.
RecentFile$="" 'Clear so [UpdateRecentList] removes the missing file.
NewFile$="" 'Set to "" so [UpdateRecentList] knows what to do.
gosub [UpdateRecentList]
else
gosub [UpdateRecentList] 'RecentFile$ will not be empty.
FileName$=RecentFile$
goto [StartReading]
end if
wait
[OpenBasFile] 'Get a basic file and open it.
'The file dialog and associated functions are code from Alyce Watson
filedialog, "Open Code File","*.bas",NewFile$ 'Call filedialog and select file.
if NewFile$="" then wait 'When no file is selected.
if upper$(right$(NewFile$,3))<>"BAS" then
notice "Error!"+chr$(13)+"The selected file is not a basic file! "
goto [MainLoop]
end if
RecentFile$=""
gosub [UpdateRecentList] 'NewFile$ will not be empty.
FileName$=NewFile$
'Fall through.
[StartReading] 'Open the text file and start reading.
files dir$, "*.txt", info$(
if val(info$(0,0))>0 then
for x=1 to val(info$(0,0))
kill dir$+info$(x,0)
next
end if
ActualLines=0
LinesLeft=0
'This section counts the actual number of working lines not
'including blank and remarked lines. This section removes Blank lines and
'lines that start with ' or rem.
'ActualLines=Actual number of working lines.
open FileName$ for input as #OriginalFile
open dir$+"WorkingFile.txt" for output as #WorkingFile
while not(eof(#OriginalFile))
line input #OriginalFile, a$ 'Input each line.
a$=trim$(a$)
if (a$<>"") and (left$(a$,1)<>"'") and (left$(upper$(a$),3)<>"REM") then 'If the line isn't blank or remarked.
ActualLines= ActualLines+1
LinesLeft=LinesLeft+1 'Number of lines left in the working file. Used in the next section.
print #WorkingFile, a$
end if
wend
close #WorkingFile
close #OriginalFile
'This section opens the working file, reads each line and removes quotes and blank lines.
gosub [ProgressBar]
#progbar.st2, "Removing Quoted Strings - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0 'Reset the number of lines left in the Working File.
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim the line.
while instr(a$,chr$(34))>0 'Find if there is a quote.
a=len(a$) 'Length of a$.
b=instr(a$,chr$(34)) 'Find the first quote.
b$=left$(a$,b-1) 'Get the part before the first quote.
a$=right$(a$,a-b) 'Get the text after the first quote.
b=instr(a$,chr$(34)) 'Find the last quote.
a$=right$(a$,len(a$)-b) 'Get the remainder of the line.
a$=b$+" "+a$ 'Add a space between the parts
wend
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section will remove any remarked lines.
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
#progbar.st2, "Removing Remarked lines - Lines Left ="+str$(LinesLeft)
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
a$=trim$(a$) 'Trim each line.
gosub[ProgMove]
if instr(a$,"'")>0 then 'If ' appears in the line
a=instr(a$,"'") 'then find the location of the ' and
b$=left$(a$,a-1) 'get the left side of the line.
if len(b$)>0 then 'If line is not blank then save un remarked portion.
print #TemporaryFile, " "+trim$(b$)
LinesLeft=LinesLeft+1
end if
else
print #TemporaryFile, " "+trim$(a$) 'If no ' appears in the line then save the line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will find and remove all gosub labels.
redim DataArray$(50000) 'Open up the progress bar.
#progbar.st2, "Retrieving Gosub Labels - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
linecounter=0
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove]
location=1
while instr(upper$(a$),"GOSUB ", location)
location=instr(upper$(a$),"GOSUB")+6
startg=location-6 'Include the gosub.
a=instr(a$,"[", location) 'Start of label.
if a=0 then exit while 'In case the word gosub is in a remark.
b=instr(a$,"]",a) 'End of the label.
d$=mid$(a$,a,b-a+1) 'The gosub [label].
b$=left$(a$,startg) 'Get the start of the remaining string.
c$=right$(a$,len(a$)-b) 'Get the end of the remaining string.
a$=b$+c$ 'The reaming string.
counter=counter+1 'Number of of gosub labels that appear.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName].
wend 'Look for more array names.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Temporary File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section sorts the gosub labels and deletes duplicates.
If counter=0 then [EndGosubLabel] 'In case there were no labels. counter is generated above.
#progbar.st2, "Sorting && Saving Gosub Label names - Lines Left ="+str$(LinesLeft)
open dir$+"GosubLabelFile.txt" for output as #1
print #1, "Gosub Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of Gosub Labels = ";a
close #1
[EndGosubLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
'This section will find and remove all goto labels
'and removes blank lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving GoTo Labels - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove]
location=1
while instr(upper$(a$),"GOTO ", location)
location=instr(upper$(a$),"GOTO")+5
startg=location-6 'Include the goto.
a=instr(a$,"[", location) 'Start of label.
if a=0 then exit while 'In case the word goto is in a remark.
b=instr(a$,"]",a) 'End of the label.
d$=mid$(a$,a,b-a+1) 'The goto [label].
b$=left$(a$,startg) 'Get the start of the remaining string.
c$=right$(a$,len(a$)-b) 'Get the end of the remaining string.
a$=b$+c$ 'The remaining string.
counter=counter+1 'Number of of goto labels that appear.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName].
wend 'Look for more array names.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Temporary File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section sorts the goto labels and deletes duplicates.
If counter=0 then [EndGoToLabel] 'In case there were no labels. counter is generated above.
#progbar.st2, "Sorting && Saving GoTo Label names - Lines Left ="+str$(LinesLeft)
open dir$+"GoToLabelFile.txt" for output as #1
print #1, "GoTo Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of GoTo Labels = ";a
close #1
[EndGoToLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
'This section will remove all labels and place them in LabelFile.txt
'and remove blanks lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving Label names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
linecounter=0
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
[startlabel]
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove] 'Move the progress bar one step.
while instr(a$,"[")>0
a=len(a$)
b=instr(a$,"[")
c=instr(a$,"]")
if c=0 then 'In case there is no ] in the line.
notice "Notice!"+chr$(13)+"There appears to be a missing ] on line "+str$(linecounter)+chr$(13)+a$
goto [startlabel]
end if
b$=left$(a$,b-1)
d$=mid$(a$,b,c-b+1) 'The label.
d=len(d$) 'd$ might equal {LabelName].
e$=trim$(mid$(d$,2,d-2)) 'This is to eliminate any []. e$ should look like LabelName.
if e$<>"" then 'If the line isn't blank.
counter=counter+1 'Number of times a label appears.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal [LabelName].
end if
a$=b$+right$(a$,a-c) 'Get the remainder of a$ and
wend 'look for more labels.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Working File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
'This section sorts the labels and deletes duplicates.
If counter=0 then [EndLabel] 'In case there were no labels. counter is generated above.
open dir$+"LabelFile.txt" for output as #1
print #1, "Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of Labels = ";a
close #1
[EndLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section opens the working file and breaks
'lines with a colon into multiple lines and removes any blank lines.
#progbar.st2, "Removing ':'and breaking lines - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim each line.
while instr(a$,":")>0 'Do until there are no more colons.
a=instr(a$,":") 'Break lines with a colon into multiple lines.
b$=left$(a$,a-1)
print #TemporaryFile, trim$(b$) 'Save leftmost portion of line.
LinesLeft=LinesLeft+1
ActualLines=ActualLines+1 'Remove this line if you don't want lines with a colon counted as extra lines.
a$=right$(a$,len(a$)-a) 'Get the remainder of the line.
wend
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will retrieve all array dim statements
'save them to ArrayFile.txt and removes blank lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving Array names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
redim DataArray$(50000)
open dir$+"ArrayFile.txt" for output as #ArrayFile
print #ArrayFile, "Array List for "+FileName$ 'Title for display window.
counter=0 'Counts how many dim statements.
while not(eof(#WorkingFile)) 'This section finds dim statements.
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim each line.
if left$(upper$(a$),3)="DIM" then
b$=trim$(right$(a$,len(a$)-4)) 'Get the right part of the dim statement.
[morearrays] 'If arrays were dimensioned on the next line with the _ character.
while instr(b$,")")>0 'Look for the ")"
b=len(b$) 'Get the total length of b$
a=instr(b$,")") 'Find the location of the )
c$=left$(b$,a) 'Get the array and size
b$=trim$(right$(b$,b-a)) 'Remove the array name and size
if left$(b$,1)="," then 'Are there any more dimensioned arrays on the line
a=len(b$) 'Get the new length of b$
b$=trim$(right$(b$,a-1)) 'Remove the first comma.
end if
counter=counter+1
print #ArrayFile,c$ 'Save array name and size. c$=arrayname(x,x)
c=instr(c$,"(") 'Find where size starts.
c$=trim$(left$(c$,c)) 'Get 'arrayname(' into data array.
DataArray$(counter)=c$
wend
if trim$(b$)="_" then 'If arrays are dimensioned on the next line.
line input #WorkingFile, a$ 'Input the next line.
gosub [ProgMove]
a$=trim$(a$)
b$=a$
goto [morearrays]
end if
else
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
end if
wend
print #ArrayFile, "Number of arrays = "; counter
close #ArrayFile
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section removes any references to the arrays from the working file and removes blank lines.
#progbar.st2, "Removing Array names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
a$=trim$(a$)
if counter=0 then
print #TemporaryFile, a$ 'If no arrays specified then save the line.
LinesLeft=LinesLeft+1
end if
if counter >0 then 'If arrays labels exist then
for x= 1 to counter 'go thru all labels.
array$=DataArray$(x) 'Get array label from DataArray.
while instr(a$,array$)>0
a=len(a$) 'Find length of line.
b=instr(a$,array$) 'Find start of label.
if b=0 then exit while 'If no more labels in line exit loop.
b$=left$(a$,b-1) 'Get left part of line before label.
a$=right$(a$,a-b+1) 'Get right part of line including label.
b=instr(a$,"(") 'Find ( to right of label.
a$=right$(a$,len(a$)-b) 'Get right part of line after label.
if len(a$)>0 then
a$=b$+" "+a$
else
a$=b$+" "+a$
end if
wend
next
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will find all subs and functions and passed variables and removes them.
#progbar.st2, "Retrieving Subs && Functions - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
open dir$+"SubFile.txt" for output as #SubFile 'Title for display window.
print #SubFile, "Subroutine & Function List for "+FileName$
counter=0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
select case
case instr(upper$(a$),"CALL")>0
a$=trim$(a$) 'Remove start and ending spaces.
Index=0
cfound=0
name$=""
token$="dx31b"
while token$ <>""
Index=Index+1
token$=word$(a$,Index)
if cfound=1 then
name$=token$
cfound=0
end if
if upper$(token$)="CALL" then cfound=1
wend
a=len(a$)
b=instr(upper$(a$),"CALL")
c=len(name$)
b$=left$(a$,b-1)
d=a-(b+c+4)
c$=right$(a$,d)
a$=trim$(b$+c$)
if a$<>"" then
#TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
case instr(upper$(a$),"SUB ")>0 or instr(upper$(a$),"FUNCTION ")>0
counter=counter+1
print #SubFile,trim$(a$)
case else
#TemporaryFile, a$
LinesLeft=LinesLeft+1
end select
wend
print #SubFile, "Number of Subs and Functions = "; counter
close #SubFile
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section removes the punctuation defined in the first data line and replaces with a space.
'Periods are not removed since they may be used in variables.
redim DataArray$(50000)
#progbar.st2, "Removing punctuation - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 13 'Get first 13 punctuation items into array.
read character$
DataArray$(x)=character$
next
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
for x=1 to 13
character$=DataArray$(x)
while instr(a$,character$)>0
a=len(a$)
b=instr(a$,character$) 'Find location of character.
b$=right$(a$,a-b) 'Get right side of line.
a$=left$(a$,b-1) 'Get left side of line.
a$=a$+" "+b$ 'Replace character with a space.
wend
next
if trim$(a$)>"" then
print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds file names
redim DataArray$(50000)
#progbar.st2, "Retrieving File names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
if instr(upper$(a$),"INPUT AS")>0 or instr(upper$(a$),"OUTPUT AS")>0 or instr(upper$(a$),"RANDOM AS")>0 then
a=instr(a$,"#")
b=instr(a$," ",a)
b$=trim$(mid$(a$,a,b-a))
a$=left$(a$,a-1)
counter=counter+1
DataArray$(counter)=b$
end if
if trim$(a$)>"" then
print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts and counts the file names.
if counter=0 then [EndFileName] 'In case there were no handles.
#progbar.st2, "Sorting and Saving File names - Lines Left ="+str$(LinesLeft)
open dir$+"FileName.txt" for output as #1
print #1, "File List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of File Names = ";a
close #1
[EndFileName] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section finds the handle names and
'removes from line and fills the data array.
redim DataArray$(50000)
#progbar.st2, "Retrieving Handles names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
while instr(a$,"#")>0 'Loop while '#' exists in line.
a=len(a$)
b=instr(a$,"#") 'Find location of '#'.
c=instr(a$," ",b) 'Find space at end of the handle.
b$=left$(a$,b-1) 'Get left side of line.
counter =counter +1
DataArray$(counter)=mid$(a$,b,c-b) 'Get handle from line and save in array.
a$=b$+" "+right$(a$,a-c) 'Add space where handle was so next section works.
wend
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts, finds duplicate Handle names and
'and saves to HandleFile.txt.
if counter=0 then [EndHandle] 'In case there were no handles.
#progbar.st2, "Sorting and Saving Handle names - Lines Left ="+str$(LinesLeft)
open dir$+"HandleFile.txt" for output as #1
print #1, "Handle List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of Handles = ";a
close #1
[EndHandle] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This fills the data array with keyword strings
'and removes them from the working file.
#progbar.st2, "Removing String Keywords - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 37 'There are currently 37 string keywords in LB4.5 and 29 in LB 4.04.
read a$
DataArray$(x)=a$
next
start=1:last=37 'Last = number of keyword$.
gosub [RemoveKeywords]
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds String Variables and removes them from the file.
redim DataArray$(50000)
#progbar.st2, "Retrieving String variables - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
do while instr(a$,"$")>0 'Loop while '$' exists in line.
a=len(a$)
b=instr(a$,"$") 'Find the location of the $.
for x= b-1 to 1 step -1 'Step backwards until a space is found.
b$=mid$(a$,x,1) 'x= location of space.
if b$=" " then exit for 'When a space is found exit loop.
next
b$=right$(a$,a-b) 'Get right side of line.
counter = counter +1
DataArray$(counter)=mid$(a$,x+1,b-x)'Get string variable from line and save in array.
a$=b$+left$(a$,x-1) 'Get left side of line.
loop
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts the strings and deletes duplicates and saves.
if counter=0 then [EndStrings] 'In case there were no string variables.
#progbar.st2, "Sorting and Saving String variables - Lines Left ="+str$(LinesLeft)
open dir$+"StringFile.txt" for output as #1
print #1, "String Variable List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of String variables = ";a
close #1
[EndStrings] 'Skip to here if counter = 0
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This fills the data array with keywords and removes them from the working file.
redim DataArray$(50000)
#progbar.st2, "Removing Keywords - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 171 'There are currently 171 keywords.
read a$
DataArray$(x)=a$
next
start=1:last=171
gosub [RemoveKeywords]
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds numeric variables.
redim DataArray$(50000)
#progbar.st2, "Retrieving Numeric variables - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
a$=trim$(a$)+" "
gosub [ProgMove]
a=len(a$)
for x = 1 to a
if (asc(mid$(a$,x,1))>64) and (asc(mid$(a$,x,1))<123) then 'Look for an alpha character in the line.
b=instr(a$," ",x) 'Find a space after numeric variable.
b$=mid$(a$,x,b-x) 'numeric variable.
c=len(b$) 'Get length of numeric variable.
if left$(b$,1)="_" and len(b$)>1 then goto [skip] 'Remove stylebit commands.
if b$="_" goto [skip] 'Remove any line continuations.
if instr(b$,"_")>1 then [skip] 'Remove any commands xxx_xxx.
counter=counter+1
DataArray$(counter)=b$
[skip]
b$=right$(a$,a-b+1) 'Get right side of line.
a$=left$(a$,x-1)+space$(c)+b$ 'Replace numeric variable with equal number of spaces.
end if
next
if trim$(a$)>"" then
print #TemporaryFile,trim$(a$)
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts, finds duplicate numeric variables and
'and saves to NumericFile.txt.
if counter=0 then [EndNumeric] 'In case there are no numeric variables.
#progbar.st2, "Sorting && Saving Numeric Variables - Lines Left ="+str$(LinesLeft)
open dir$+"NumericFile.txt" for output as #1
print #1, "Numeric Variable List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of Numeric variables = ";a
close #1
[EndNumeric] 'Skip to here if counter=0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section removes all the numbers and remaining periods from the working file.
#progbar.st2, "Cleaning Working File - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
print #TemporaryFile, "Working File for "+FileName$ 'Title for display window.
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
for x=0 to 9 'Remove numbers 0 through 9.
while instr(a$,str$(x))<>0
a$=ReplaceMultipleString$(a$, str$(x), " ") 'And replace with a space.
wend
next
a$=trim$(a$)
if (a$<>"") and (instr(a$,".")=0) then 'Remove blank lines and lines containing periods
print #TemporaryFile,trim$(a$) 'and leaves only missed things.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
[EndJob]
close #progbar
restore
open dir$+"NumberLines.txt" for output as #NumbLines
print #NumbLines,str$(ActualLines)+" for basic program "+FileName$
close #NumbLines
notice "Job Complete!" + chr$(13) + "Use the Display menu to see results."+Chr$(13)+"Actual working lines = "+str$(ActualLines)_
+Chr$(13)+"Lines Left in Working File = "+str$(LinesLeft)
goto [MainLoop]
[ActualLines] 'Displays the number of actual working lines.
open dir$+"NumberLines.txt" for input as #NumbLines
input #NumbLines,ActualLines
close #NumbLines
notice "Number of Working lines = ";str$(ActualLines)
wait
'Please do not remove this section.
'You may modify the version number if you wish and add your name.
[About] 'About LB Reader.
WindowWidth = 250
WindowHeight = 220
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
button #helpabout.bmp1, " OK ", [haclick1], UL, 84, 155
statictext #helpabout, "LB Reader", 80, 10, 220, 20
statictext #helpabout, "Version "+curversion$, 85, 30, 90, 20
statictext #helpabout, "Written in Liberty Basic 4.04", 40, 50, 170, 20
statictext #helpabout, "jbross@sisna.com",70,90,150,20
statictext #helpabout, "Copyright 2014", 75, 110, 150,20
stylebits #helpabout, _DS_CENTER,0,0,0
open "About..." for dialog_modal as #helpabout
print #helpabout, "font arial 10"
print #helpabout, "trapclose [haclick1]"
wait
[haclick1] 'Close
close #helpabout
goto [MainLoop]
[Help] 'Display the help window.
WindowWidth = 800
WindowHeight = 600
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
button #help.default, "enter", [helpok],UL,-400,-400
button #help.b1," OK ",[helpok],UL,360,525
bmpbutton #help.b2, dir$+"print.bmp", [helpprint], UL, 745, 528
stylebits #help, _DS_CENTER,0,0,0
open "LB Reader Help" For dialog_modal As #help
#help.b1,"!setfocus"
#help, "trapclose [helpok]"
#help, "font arial 10 bold"
hTip=CreateTooltip(hwnd(#help))
call AddToolTip Hwnd(#help.b1),hTip, "Close Help "
call AddToolTip Hwnd(#help.b2),hTip, "Print Help window "
open "RICHED32.DLL" for dll as #re
calldll #comctl32, "InitCommonControlsEx",result as void
hlpT=CreateTextEdit(hWnd(#help), 10,10,775,WindowHeight-97)
File$=dir$+"help.rtf"
open File$ for input as #TempText
txt$=input$(#TempText,lof(#TempText))
close #TempText
call SetWindowText hlpT,txt$
wait
[helpprint] 'Print help.
run "write.exe "+chr$(34)+File$+chr$(34)+" /p",hide
wait
[helpok] 'Close Help.
close #help
close #re
goto [MainLoop]
data ";","/","-","+","*","|",",","=","<",">","^","(",")" '13 entries
'These data items require a space in front and the end so that key words can be found and deleted
'and not variables which may contain the keyword.
data " BACKGROUNDCOLOR$ "," CHR$ "," COMBOBOXCOLOR$ "," DATE$ "," DECHEX$ "," DEFAULTDIR$ "," DRIVE$ ",_
" LISTBOXCOLOR$ "," SPACE$ "," STR$ " '10 entries
data " FOREGROUNDCOLOR$ "," INKEY$ "," INPUT$ "," KILL$ "," LEFT$ "," LOWER$ "," MID$ "," PRINTERNAME$ ",_
" PLATFORM$ "," WORD$ " '10 entries
data " RIGHT$ "," TEXTBOXCOLOR$ "," TEXTEDITORCOLOR$ "," TIME$ "," TRIM$ "," UPPER$ "," COMMANDLINE$ ",_
" VERSION$ "," EVAL$ ", " STARTUPDIR$ " '10 entries
data " HTTPGET$ ", " UPTO$ ", " AFTER$ ", " AFTERLAST$ ", "ENDSWITH$ ", " REMCHAR$ "," REPLSTR$ " '7 entries
data " FOR "," TO "," NEXT "," EXIT "," WHILE "," WEND "," IF "," THEN "," ELSE "," END " '10 entries
data " SELECT "," CASE "," PRINT "," LPRINT "," DUMP "," OPEN "," CLOSE "," INPUT "," LINE "," AS " '10 entries
data " WAIT "," CALL "," CALLDLL "," GOTO "," RETURN "," GET "," GETTRIM "," PUT "," OUT "," OUTPUT " '10 entries
data " GOSUB "," READ "," RESTORE "," REDIM "," LEN "," VAL "," INT "," INSTR "," NAME "," SUB " '10 entries
data " BMPBUTTON "," BUTTON "," CHECKBOX "," COMBOBOX "," GRAPHICBOX "," GROUPBOX "," LISTBOX ",_
" NOMAINWIN "," RADIOBUTTON "," TEXTBOX " '10 entries
data " TEXTEDITOR "," DISPLAYWIDTH "," DISPLAYHEIGHT "," UPPERLEFTX "," UPPERLEFTY ",_
" WINDOWWIDTH "," WINDOWHEIGHT "," FUNCTION "," EOF "," FIELD " '10 entries
data " COLORDIALOG "," FONTDIALOG "," FILEDIALOG "," PRINTERDIALOG "," STATICTEXT "," DIALOG "," GRAPHICS ",_
" TEXT "," WINDOW "," CONFIRM " '10 entries
data " MENU "," FS "," NF "," NSB "," INS "," POPUP "," MODAL "," FILES "," LOF "," LET " '10 entries
data " ABS "," ASC "," AND "," ASC "," ASN "," BEEP "," BINARY "," BMPSAVE "," BOOLEAN "," CALLBACK " '10 entries
data " CLS "," COS "," CURSOR "," DATA "," DOUBLE "," DWORD "," EXP "," HBMP "," HEXDEC "," HWND ", '10 entries
data " INP "," INPUTTO "," LOADBMP "," LOC "," LOG "," LONG "," MAINWIN "," MAX "," MKDIR "," MIN " '10 entries
data " NOT "," NOTICE "," ONCOMERROR "," OPEN "," OR "," PLAYWAVE "," POPUPMENU "," PRINTCOLLATE ",_
" PRINTCOPIES "," PROMPT " '10 entries
data " RMDIR "," RND "," RUN "," SCAN "," SEEK "," SHORT "," SIN "," STOP "," RANDOM "," STRUCT " '10 entries
data " TAN "," TIMER "," TITLEBAR "," TRACE "," ULONG "," UNLOADBMP "," USHORT "," USING "," VOID ",_
" WINSTRING " '10 entries
data " WORD "," XOR "," UL "," DLL "," KILL "," BOLD "," ITALIC "," UNDERLINE "," NORMAL "," TAB " '10 entries
data " GLOBAL "," BYREF "," MAPHANDLE "," EVAL "," DO "," LOOP "," ON ERROR "," RESUME "," PLAYMIDI ",_
" MIDIPOS " '10 entries
data " SORT "," STOPMIDI "," STYLEBITS "," SQR "," STEP "," UNTIL "," MOD "," INPUTCSV "," FIND "," FINDBACK "'10 entries
data " RESETFIND" '1 entry
[Subs_&_Functions] 'Subs and Functions below.
[RemoveKeywords] 'Remove both keywords and string keywords.
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Get a line.
gosub[ProgMove]
temp$=upper$(a$+" ") 'Change to upper case to make sure the keyword is found.
for x=start to last 'Go through all keywords
if a$="" then exit for
keyword$=DataArray$(x)
c=len(keyword$)
while instr(temp$,keyword$)>0 'Is the keyword in the line.
a=len(a$)
b=instr(temp$,keyword$) 'Find location of keyword.
b$=right$(a$,(a+1)-(b+c)) 'Get right side of line.
a$=left$(a$,b-1) 'Get left side of line.
a$=" "+a$+" "+b$+" " 'Replace keyword with a space.
temp$=upper$(a$)
wend
next
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
return
[OpenFiles] 'Open the working and temporary files.
open dir$+"WorkingFile.txt" for input as #WorkingFile
open dir$+"Tempory.txt" for output as #TemporaryFile
return
[CloseFiles] 'Close files and clear the progress bar.
close #TemporaryFile
close #WorkingFile
kill dir$+"WorkingFile.txt" 'Delete the working file
name dir$+"Tempory.txt" as dir$+"WorkingFile.txt" 'and name the temporary file to the working file.
#progbar.graphicbox1,"cls" 'Clears the Progress Bar graphic box.
return
[Display] 'Display various files
WindowWidth= 800
WindowHeight=600
BackgroundColor$ = "white"
ForegroundColor$ = "black"
statictext #display.st1, "", 15, 50, 780, 20
statictext #display.st2, "", 15, 70, 780, 20
statictext #display.st3, "", 15, 90, 780, 20
statictext #display.st4, "", 15, 110, 780, 20
statictext #display.st5, "", 15, 130, 780, 20
statictext #display.st6, "", 15, 150, 780, 20
statictext #display.st7, "", 15, 170, 780, 20
statictext #display.st8, "", 15, 190, 780, 20
statictext #display.st9, "", 15, 210, 780, 20
statictext #display.st10, "", 15, 230, 780, 20
statictext #display.st11, "", 15, 250, 780, 20
statictext #display.st12, "", 15, 270, 780, 20
statictext #display.st13, "", 15, 290, 780, 20
statictext #display.st14, "", 15, 310, 780, 20
statictext #display.st15, "", 15, 330, 780, 20
statictext #display.st16, "", 15, 350, 780, 20
statictext #display.st17, "", 15, 370, 780, 20
statictext #display.st18, "", 15, 390, 780, 20
statictext #display.st19, "", 15, 410 , 780, 20
statictext #display.st20, "", 15, 430, 780, 20
statictext #display.st21, "", 15, 450, 780, 20
statictext #display.st22, "", 15, 470, 780, 20
statictext #display.st23, "", 15, 490, 780, 20
statictext #display.st24, "", 15, 510, 780, 20
statictext #display.st25, "", 15, 530, 780, 20
statictext #display.st26, "", 500, 0 ,140, 25
button #display.default, "enter", [displayquit],UL,-400,-400
button #display.b1, "",[lastpage], UL, 651, 0 ,25, 25 'lastbut
stylebits #display.b1, _BS_BITMAP, 0, 0, 0
button #display.b2, "", [pagedown], UL, 675, 0, 25, 25 'dbttn
stylebits #display.b2, _BS_BITMAP, 0, 0, 0
button #display.b3, "", [pageup], UL, 699, 0, 25, 25 'ubttn
stylebits #display.b3, _BS_BITMAP, 0, 0, 0
button #display.b4, "", [firstpage], UL, 723 ,0, 25, 25 'firstbut
stylebits #display.b4, _BS_BITMAP, 0, 0, 0
button #display.b5, "",[displayjump], UL, 747, 0, 25, 25 'jumpto
stylebits #display.b5, _BS_BITMAP, 0, 0, 0
button #display.b6, "", [displayprint], UL, 770, 0, 25, 25 'print
stylebits #display.b6, _BS_BITMAP, 0, 0, 0
stylebits #display, _DS_CENTER,0,0,0
open Title$ for dialog_modal as #display
#display, "font courier new 12 bold"
#display, "trapclose [displayquit]"
hParent = hwnd(#display)
hTip=CreateTooltip(hParent)
call AddToolTip Hwnd(#display.b1),hTip, "Last Page "
call AddToolTip Hwnd(#display.b2),hTip, "Next Page "
call AddToolTip Hwnd(#display.b3),hTip, "Previous Page "
call AddToolTip Hwnd(#display.b4),hTip, "First Page "
call AddToolTip Hwnd(#display.b5),hTip, "Jump to Page "
call AddToolTip Hwnd(#display.b6),hTip, "Print Display "
Call BitmapButton Hwnd(#display.b1), HBmp("lastbut")
Call BitmapButton Hwnd(#display.b2), HBmp("dbttn")
Call BitmapButton Hwnd(#display.b3), HBmp("ubttn")
Call BitmapButton Hwnd(#display.b4), HBmp("firstbut")
Call BitmapButton Hwnd(#display.b5), HBmp("jumpto")
Call BitmapButton Hwnd(#display.b6), HBmp("print")
for hv=1 to 26
var$="#display.st"+str$(hv)
#var$ FontVariable$
next
Index=1
pagenumb=1
numbpages=int(RecNum/25)
if numbpages<1 then numbpages=1
if RecNum/25>numbpages then numbpages=numbpages+1
[nextpage]
#display.st26, "Page ";pagenumb;" of ";numbpages
for hv=1 to 25
var$="#display.st"+str$(hv)
#var$ DataArray$(Index+hv-1)
next
wait
[displayjump]'Jump to page number.
redim DisplayBox$(200)
for x=1 to numbpages
DisplayBox$(x)=str$(x)
next
jumpH=25*numbpages
if jumpH>400 then jumpH=400
WindowWidth = 150
WindowHeight= 90+jumpH
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
ListboxColor$ = "white"
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
statictext #jumpto, "Jump to Page",25,3,100,20
listbox #jumpto.lb1, DisplayBox$(, [jumptoselect],45,25,50,jumpH
stylebits #jumpto, _DS_CENTER,0,0,0
open "" for dialog_modal as #jumpto
#jumpto, "font arial 10 bold"
#jumpto.lb1, "reload"
#jumpto, "trapclose [jumptoclose]"
#jumpto.lb1,"singleclickselect"
hParent = hwnd(#jumpto)
hTip=CreateTooltip(hParent)
call AddToolTip Hwnd(#jumpto.lb1),hTip, "Click to select a page "
wait
[jumptoselect] 'Select a page to jump to
#jumpto.lb1, "selectionindex? pagenumb"
Index=(pagenumb-1)*25+1
[jumptoclose] 'Close jump to window
close #jumpto
goto [nextpage]
[lastpage]'Go to last page
if RecNum=0 then [nextpage]
Index = (numbpages-1)*25+1
pagenumb=numbpages
goto [nextpage]
[pagedown]'Page down
Index=Index+25
pagenumb=pagenumb+1
if pagenumb>numbpages then Index=Index-25:pagenumb=pagenumb-1
goto [nextpage]
[pageup]'Page up
Index=Index-25
pagenumb=pagenumb-1
if pagenumb<1 then Index=Index+25:pagenumb=pagenumb+1
goto [nextpage]
[firstpage]'Go to first page
Index=1
pagenumb=1
goto [nextpage]
[displayprint]'Print the file.
PrinterFont$="font arial 12"
lprint Title$
lprint
for x=1 to RecNum
lprint DataArray$(x)
next
dump
wait
[displayquit]'Close the display window.
a=ReleaseTooltipMemory(hTip)
close #display
return
[FindFiles] 'See if the file exists.
files dir$, displayfile$, info$(
If (val(info$(0, 0)) =0) then 'File doesn't exist.
notice "Error!"+chr$(13)+"File not created yet. "
return
end if
If (val(info$(1, 1)) =0) then 'File exists but is empty.
notice "Error!"+chr$(13)+"The File is empty. "
return
end if
redim DataArray$(50000)
open dir$+displayfile$ for input as #File
RecNum=0
line input #File, Title$
while not(eof(#File))
line input #File, a$
RecNum=RecNum+1
DataArray$(RecNum)=a$
wend
close #File
gosub [Display]
return
[ProgressBar] 'Create Progress Bar.
WindowWidth = 500
WindowHeight = 165
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
statictext #progbar.st1, "",428,54,50,25 'Percent complete.
statictext #progbar.st2, "",20,100,450,25 'File Name.
groupbox #progbar.gb1, " Please Wait - Working ",5,5,485,125
graphicbox #progbar.graphicbox1, 20, 55, 400, 25
stylebits #progbar, _DS_CENTER,0,0,0
open "Please Wait" for dialog_popup as #progbar
#progbar, "font arial 14 bold"
#progbar.st2, "!font arial 12 bold"
#progbar.graphicbox1,"down; backcolor green"
progx=ProgStep
return
[ProgMove] 'Move Progess Bar.
percent=int((progx/400)*100)
if percent>100 then percent=100
#progbar.st1,str$(percent)+"%"
#progbar.graphicbox1,"discard place 0 0"
#progbar.graphicbox1,"boxfilled ";int(progx);" 25"
progx=progx+ProgStep
return
[ProcessDataArray] 'Sort, count and remove duplicates.
ProgStep=400/counter
progx=ProgStep
sort DataArray$(),1,counter
for x=1 to counter 'Find duplicates and mark with **.
gosub [ProgMove] 'Move the progress bar one step progx
if DataArray$(x)<>"**" then 'As array elements are marked with ** then skip. Makes the routine go faster.
NumberofOccurence=1
variable$=DataArray$(x)
DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")"
for y=x+1 to counter
if variable$=DataArray$(y) then
DataArray$(y)="**"
NumberofOccurence=NumberofOccurence+1
DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")"
end if
next
end if
next
a=0 'Number of remaining items.
for x=1 to counter 'Save ritems excluding **.
if DataArray$(x)<>"**" then
print #1, DataArray$(x)
a=a+1
end if
next
return
[UpdateRecentList]
flag=0 'Set to 1 if the selected new file is already in the recent list.
If NewFile$<>"" then 'A new file has been selected.
for x=1 to 8 'Does it already exist in the recent list.
if RecentArray$(x)="" then exit for 'If an array element is empty exit the for/next.
if NewFile$=RecentArray$(x) then 'If it exists in the recent list then
flag=1 'set the flag to 1 and
exit for 'exit the for/next.
end if
next
if flag=1 then [skipupdate] 'End the update.
for x=8 to 2 step-1 'The new file does not exist in the recent list
RecentArray$(x)=RecentArray$(x-1) 'then move each recent file down one element
next
RecentArray$(1)=NewFile$ 'and put the new recent file in element 1.
goto [skipupdate]
end if
if RecentFile$ ="" then 'The recent file selected no longer exists.
for x=Index to 7
RecentArray$(x)=RecentArray$(x+1)
if RecentArray$(x)="" then exit for
next
RecentArray$(8)=""
else 'The recent file exists so move it to #1 element.
a$=RecentArray$(Index)
for x=Index to 2 step -1
RecentArray$(x)=RecentArray$(x-1)
next
RecentArray$(1)=a$
end if
[skipupdate] 'Finaly refil the ini file and update the recent menus.
open DefaultDir$+"\recent.ini" for output as #1
for x=1 to 8
a$=RecentArray$(x)
print #1,a$
calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong
call MenuMod hfile, hfileid, a$, x 'Modify the recent menu items.
next
close #1
return
sub BitmapButton hButton, hBitmap
CallDLL #user32, "SendMessageA", _
hButton as uLong, _
_BM_SETIMAGE as Long, _
_IMAGE_BITMAP as Long, _
hBitmap As uLong, _
result as Long
end Sub
sub GetIni 'Open the recent.ini file and fill the array.
open DefaultDir$+"\recent.ini" for input as #1
for x=1 to 8
input #1, RecentArray$(x)
next
close #1
end sub
sub MenuMod hmainmenu, position,pointer$,Index 'Used to modify the Main Window Recent Menus.
pointer$="&"+str$(Index)+". "+pointer$ 'The menu will be "1. C:\folder\filename".
'In this demo, the start of the recent file menus is at 2.
'So a 1 must be added to the position.
position=position+1 'in this demo, the first recent menu is at position 2 through 9.
flags=_MF_STRING or _MF_BYCOMMAND
calldll #user32, "ModifyMenuA",_
hmainmenu as ulong,_
position as ulong,_
flags as long,_
position as ulong,_
pointer$ as ptr,_
r as boolean
end sub
sub AddToolTip cHndl, hWnd, text$
TOOLINFO.uId.struct = cHndl
TOOLINFO.lpszText.struct = text$
CallDLL #user32, "SendMessageA",_
hWnd As ulong, _
1028 As long, _
0 As long, _
TOOLINFO as ptr, _
result as long
end sub
sub SetWindowText hWnd, txt$ 'Places text in the Help window.
callDLL #user32, "SetWindowTextA",hWnd As ulong,txt$ As ptr,result As void
end sub
Sub staticImage hSt, hB 'Code from Janet
Calldll #user32, "SendMessageA", _
hSt as long, _
_STM_SETIMAGE as long, _
_IMAGE_BITMAP as long, _
hB as long, r as ulong
End Sub
FUNCTION CreateTextEdit(hWin, x, y, w, h)
style = _WS_CHILDWINDOW OR _WS_BORDER OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL or _ES_READONLY
hInst=GetWindowLong(hWin, _GWL_HINSTANCE)
callDLL #user32,"CreateWindowExA",_
0 As long,"RichEdit" As ptr,_
"" As ptr, style As long,_
x As long,y As long,w As long,h As long,_
hWin As ulong, 0 As long, hInst As ulong,_
0 As long, CreateTextEdit As long
END FUNCTION
FUNCTION CreateTooltip(hMain)
Struct TOOLINFO, _
cbSize As long, _
uFlags As long, _
hwnd As ulong, _
uId As long, _
rectLeft As long, _
rectTop As long, _
rectRight As long, _
rectBottom As long, _
hinst As ulong, _
lpszText As ptr
CallDLL #comctl32,"InitCommonControlsEx", _
result as void
TOOLINFO.cbSize.struct = Len(TOOLINFO.struct)
TOOLINFO.uFlags.struct = flags Or 17 'TTF_IDISHWND Or TTF_SUBCLASS
TOOLINFO.hwnd.struct = hMain
CallDLL #user32,"CreateWindowExA",_
0 As long, _
"tooltips_class32" As ptr, _
0 As long, style As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
hMain As ulong, _
0 As long, _
0 as long, _
0 As long, _
CreateTooltip As Long
END FUNCTION
FUNCTION GetWindowLong(hWin, type)
callDLL #user32, "GetWindowLongA", hWin As ulong, type As long, GetWindowLong As long
END FUNCTION
'The next two functions are from Alyce Watson's web site.
Function SeparateFile$(f$)
fileindex=len(f$)
filelength=len(f$)
while mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
wend
SeparateFile$=right$(f$,filelength-fileindex)
end function
Function SeparatePath$(f$)
fileindex=len(f$)
filelength=len(f$)
while mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
wend
SeparatePath$=left$(f$,fileindex)
end function
FUNCTION ReleaseTooltipMemory(hTip)
CallDLL #user32, "DestroyWindow",_
hTip As ulong, _
result As long
END FUNCTION
function ReplaceMultipleString$(st$, tg$, rp$) 'Replace multiple occurences.
targetlength = len(tg$) 'Find length of target$.
nextpos=1 'Start at position 1.
while instr(st$,tg$,nextpos)>0 'Do while target$ exists.
startlength = len(st$) 'Find length of start$.
startposition = instr(st$,tg$,nextpos) 'Find position of target$.
LeftofString$ = left$(st$,startposition-1) 'Get left of start$ to target$.
nextpos=startposition+targetlength 'Get right of start$ after target$.
RightofString$ = Right$(st$,startlength-(nextpos-1))
ReplaceMultipleString$=LeftofString$+rp$+RightofString$ 'Add replace$ to final$.
st$=ReplaceMultipleString$ 'Set st$ to final$ so the while loop works.
wend
end function
|
|
|
|
Post by pandawdy on Sept 14, 2019 18:42:37 GMT -5
Here is a program that will do that and more. 'Liberty Basic Reader
'Works with any LB 4.5 and lower.
'Copyright 2013 by Jim Brossman
curversion$="12.2" '6/10/2016
dim info$(10,10)
dim DataArray$(50000)'This contains all the extracted data. Labels, Handles etc.
dim DisplayBox$(2500)'Used to display page numbers in the JumpTo window.
dim RecentArray$(8)
dir$=DefaultDir$+"\"
files DefaultDir$,"recent.ini",info$(
if val(info$(0,0))=0 then 'If the recent.ini file doesn't exist
open DefaultDir$+"\recent.ini" for output as #1
for x=1 to 8 'then fill it with blank spaces.
print #1, ""
next
close #1
end if
call GetIni 'Now get the existing recent files and fill the RecentArray$.
nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
UpperLeftX= 0
UpperLeftY=0
BackgroundColor$ = "white"
ForegroundColor$ = "black"
loadbmp "lb", dir$+"LBReader.bmp"
loadbmp "lastbut",dir$+"lastbut.bmp"
loadbmp "dbttn", dir$+"dbttn.bmp"
loadbmp "ubttn", dir$+"ubttn.bmp"
loadbmp "firstbut", dir$+"firstbut.bmp"
loadbmp "jumpto", dir$+"jumpto.bmp"
loadbmp "print", dir$+"print.bmp"
menu #main, "&File","&Open File && Run", [OpenBasFile],|,"&1. ",[recent1],_
"&2. ",[recent2],"&3.",[recent3],"&4.",[recent4],"&5.",[recent5],"&6.",[recent6],"&7.",[recent7],_
"&8. ",[recent8],|, "E&xit", [Quit]
menu #main, "&Display", "&Arrays", [ArrayDisplay],"&File Names",[FileNameDisplay],"&Handles", [HandleDisplay],_
"&Labels", [LabelDisplay],"&Numeric Variables",[NumericDisplay], "&String Variables", [StringDisplay],_
"Gosub Labels", [GosubDisplay], "GoTo Labels",[GotoDisplay],"Subs and &Functions",[SubDisplay],"&Working File",[WorkingFile],_
"Number of Working Lines", [ActualLines]
menu #main, "&Help", "&Help",[Help],"&About LB Reader", [About]
stylebits #main.st0, _SS_BITMAP, 0, 0, 0
statictext #main.st0, "", int(WindowWidth/2)-175, int(WindowHeight/2)-200, 1, 1
open "LB Reader v"+curversion$ for window as #main
hMain=HWnd(#main) 'Handle of main window.
calldll #user32, "GetMenu",hMain as ulong,hMenu as ulong 'Get handle of the menu.
calldll #user32, "GetSubMenu",hMenu as ulong,0 as long,hfile as ulong 'Get handle of file menu.
'Get info for each recent menu line and modify the menu.
for x=1 to 8
a$=RecentArray$(x)
calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong 'Get the ID number of the file menu.
call MenuMod hfile, hfileid,a$,x 'Modify the recent menu items.
next
'And draw the menu bar.
calldll #user32, "DrawMenuBar", hMain as ulong, result as boolean 'Redraw the menu.
#main, "trapclose [Quit]" 'Handle of main window.
callDLL #user32, "ShowWindow",hMain As uLong,_SW_MAXIMIZE As Long, r As Boolean
hst0 = hwnd(#main.st0) 'Required for staticimage.
hB0 = hbmp("lb") 'Required for staticimage.
Call staticImage hst0, hB0 'Required for staticimage.
[MainLoop]
wait
[Quit] 'End the program.
unloadbmp "lb"
unloadbmp "lastbut"
unloadbmp "dbttn"
unloadbmp "ubttn"
unloadbmp "firstbut"
unloadbmp "jumpto"
unloadbmp "print"
close #main
end
[ArrayDisplay] 'Will display and optionally print the list of arrays.
displayfile$="ArrayFile.txt"
gosub [FindFiles]
goto [MainLoop]
[FileNameDisplay] 'Will display the list of file names.
displayfile$="FileName.txt"
gosub [FindFiles]
goto [MainLoop]
[HandleDisplay] 'Will display and optionally print the list of handles.
displayfile$="HandleFile.txt"
gosub [FindFiles]
goto [MainLoop]
[LabelDisplay] 'Will display and optionally print the list of labels.
displayfile$="LabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[NumericDisplay] 'Will display and optionally print the list of numeric variables.
displayfile$="NumericFile.txt"
gosub [FindFiles]
goto [MainLoop]
[StringDisplay] 'Will display and optionally print the list of string variables.
displayfile$="StringFile.txt"
gosub [FindFiles]
goto [MainLoop]
[SubDisplay] 'Will display and optionally print the list of Subs and Functions.
displayfile$="SubFile.txt"
gosub [FindFiles]
goto [MainLoop]
[GosubDisplay]
displayfile$="GosubLabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[GotoDisplay]
displayfile$="GoToLabelFile.txt"
gosub [FindFiles]
goto [MainLoop]
[WorkingFile] 'Will display and optionally print the remaining lines in the working file.
displayfile$="WorkingFile.txt"
gosub [FindFiles]
goto [MainLoop]
[recent1] 'For recent file 1
RecentFile$=RecentArray$(1)
Index=1
goto [OpenRecentFile]
[recent2]
RecentFile$=RecentArray$(2)
Index=2
goto [OpenRecentFile]
[recent3]
RecentFile$=RecentArray$(3)
Index=3
goto [OpenRecentFile]
[recent4]
RecentFile$=RecentArray$(4)
Index=4
goto [OpenRecentFile]
[recent5]
RecentFile$=RecentArray$(5)
Index=5
goto [OpenRecentFile]
[recent6]
RecentFile$=RecentArray$(6)
Index=6
goto [OpenRecentFile]
[recent7]
RecentFile$=RecentArray$(7)
Index=7
goto [OpenRecentFile]
[recent8]
RecentFile$=RecentArray$(8)
Index=8
goto [OpenRecentFile]
[OpenRecentFile] 'Open a file listed in the recent menus.
if RecentFile$="" then 'If the selected menu item does not have a recent file in it.
notice "Notice!"+chr$(13)+"No recent file selected"
wait
end if
'Get the file name and path so the files statement works.
FileName$=SeparateFile$(RecentFile$) 'Get the recent file name.
FilePath$=SeparatePath$(RecentFile$) 'Get the file path.
'and see if the file really exists.
files FilePath$,FileName$,info$(
if val(info$(0,0))=0 then 'The file no longer exists.
Notice "Notice!"+chr$(13)+ "File "+FileName$+" no longer exists."
RecentArray$(Index)="" 'Clear the array element for the file that is missing.
RecentFile$="" 'Clear so [UpdateRecentList] removes the missing file.
NewFile$="" 'Set to "" so [UpdateRecentList] knows what to do.
gosub [UpdateRecentList]
else
gosub [UpdateRecentList] 'RecentFile$ will not be empty.
FileName$=RecentFile$
goto [StartReading]
end if
wait
[OpenBasFile] 'Get a basic file and open it.
'The file dialog and associated functions are code from Alyce Watson
filedialog, "Open Code File","*.bas",NewFile$ 'Call filedialog and select file.
if NewFile$="" then wait 'When no file is selected.
if upper$(right$(NewFile$,3))<>"BAS" then
notice "Error!"+chr$(13)+"The selected file is not a basic file! "
goto [MainLoop]
end if
RecentFile$=""
gosub [UpdateRecentList] 'NewFile$ will not be empty.
FileName$=NewFile$
'Fall through.
[StartReading] 'Open the text file and start reading.
files dir$, "*.txt", info$(
if val(info$(0,0))>0 then
for x=1 to val(info$(0,0))
kill dir$+info$(x,0)
next
end if
ActualLines=0
LinesLeft=0
'This section counts the actual number of working lines not
'including blank and remarked lines. This section removes Blank lines and
'lines that start with ' or rem.
'ActualLines=Actual number of working lines.
open FileName$ for input as #OriginalFile
open dir$+"WorkingFile.txt" for output as #WorkingFile
while not(eof(#OriginalFile))
line input #OriginalFile, a$ 'Input each line.
a$=trim$(a$)
if (a$<>"") and (left$(a$,1)<>"'") and (left$(upper$(a$),3)<>"REM") then 'If the line isn't blank or remarked.
ActualLines= ActualLines+1
LinesLeft=LinesLeft+1 'Number of lines left in the working file. Used in the next section.
print #WorkingFile, a$
end if
wend
close #WorkingFile
close #OriginalFile
'This section opens the working file, reads each line and removes quotes and blank lines.
gosub [ProgressBar]
#progbar.st2, "Removing Quoted Strings - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0 'Reset the number of lines left in the Working File.
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim the line.
while instr(a$,chr$(34))>0 'Find if there is a quote.
a=len(a$) 'Length of a$.
b=instr(a$,chr$(34)) 'Find the first quote.
b$=left$(a$,b-1) 'Get the part before the first quote.
a$=right$(a$,a-b) 'Get the text after the first quote.
b=instr(a$,chr$(34)) 'Find the last quote.
a$=right$(a$,len(a$)-b) 'Get the remainder of the line.
a$=b$+" "+a$ 'Add a space between the parts
wend
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section will remove any remarked lines.
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
#progbar.st2, "Removing Remarked lines - Lines Left ="+str$(LinesLeft)
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
a$=trim$(a$) 'Trim each line.
gosub[ProgMove]
if instr(a$,"'")>0 then 'If ' appears in the line
a=instr(a$,"'") 'then find the location of the ' and
b$=left$(a$,a-1) 'get the left side of the line.
if len(b$)>0 then 'If line is not blank then save un remarked portion.
print #TemporaryFile, " "+trim$(b$)
LinesLeft=LinesLeft+1
end if
else
print #TemporaryFile, " "+trim$(a$) 'If no ' appears in the line then save the line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will find and remove all gosub labels.
redim DataArray$(50000) 'Open up the progress bar.
#progbar.st2, "Retrieving Gosub Labels - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
linecounter=0
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove]
location=1
while instr(upper$(a$),"GOSUB ", location)
location=instr(upper$(a$),"GOSUB")+6
startg=location-6 'Include the gosub.
a=instr(a$,"[", location) 'Start of label.
if a=0 then exit while 'In case the word gosub is in a remark.
b=instr(a$,"]",a) 'End of the label.
d$=mid$(a$,a,b-a+1) 'The gosub [label].
b$=left$(a$,startg) 'Get the start of the remaining string.
c$=right$(a$,len(a$)-b) 'Get the end of the remaining string.
a$=b$+c$ 'The reaming string.
counter=counter+1 'Number of of gosub labels that appear.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName].
wend 'Look for more array names.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Temporary File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section sorts the gosub labels and deletes duplicates.
If counter=0 then [EndGosubLabel] 'In case there were no labels. counter is generated above.
#progbar.st2, "Sorting && Saving Gosub Label names - Lines Left ="+str$(LinesLeft)
open dir$+"GosubLabelFile.txt" for output as #1
print #1, "Gosub Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of Gosub Labels = ";a
close #1
[EndGosubLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
'This section will find and remove all goto labels
'and removes blank lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving GoTo Labels - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove]
location=1
while instr(upper$(a$),"GOTO ", location)
location=instr(upper$(a$),"GOTO")+5
startg=location-6 'Include the goto.
a=instr(a$,"[", location) 'Start of label.
if a=0 then exit while 'In case the word goto is in a remark.
b=instr(a$,"]",a) 'End of the label.
d$=mid$(a$,a,b-a+1) 'The goto [label].
b$=left$(a$,startg) 'Get the start of the remaining string.
c$=right$(a$,len(a$)-b) 'Get the end of the remaining string.
a$=b$+c$ 'The remaining string.
counter=counter+1 'Number of of goto labels that appear.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal gosub [LabelName].
wend 'Look for more array names.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Temporary File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section sorts the goto labels and deletes duplicates.
If counter=0 then [EndGoToLabel] 'In case there were no labels. counter is generated above.
#progbar.st2, "Sorting && Saving GoTo Label names - Lines Left ="+str$(LinesLeft)
open dir$+"GoToLabelFile.txt" for output as #1
print #1, "GoTo Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of GoTo Labels = ";a
close #1
[EndGoToLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
'This section will remove all labels and place them in LabelFile.txt
'and remove blanks lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving Label names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft 'Calculate the length of each progress bar movement.
progx=ProgStep 'Set so the progress bar starts at 0%.
LinesLeft=0 'Number of lines left in the Working File.
linecounter=0
gosub [OpenFiles]
counter=0 'How many actual items are saved.
while not(eof(#WorkingFile)) 'This section removes label names from the working file.
[startlabel]
line input #WorkingFile, a$ 'Input each line.
linecounter=linecounter +1
gosub [ProgMove] 'Move the progress bar one step.
while instr(a$,"[")>0
a=len(a$)
b=instr(a$,"[")
c=instr(a$,"]")
if c=0 then 'In case there is no ] in the line.
notice "Notice!"+chr$(13)+"There appears to be a missing ] on line "+str$(linecounter)+chr$(13)+a$
goto [startlabel]
end if
b$=left$(a$,b-1)
d$=mid$(a$,b,c-b+1) 'The label.
d=len(d$) 'd$ might equal {LabelName].
e$=trim$(mid$(d$,2,d-2)) 'This is to eliminate any []. e$ should look like LabelName.
if e$<>"" then 'If the line isn't blank.
counter=counter+1 'Number of times a label appears.
DataArray$(counter)=d$ 'So DataArray$(counter) will equal [LabelName].
end if
a$=b$+right$(a$,a-c) 'Get the remainder of a$ and
wend 'look for more labels.
if trim$(a$)>"" then 'If the line isn't empty
print #TemporaryFile,a$ 'put it in the Working File
LinesLeft=LinesLeft+1 'and increase the line count.
end if
wend
gosub [CloseFiles]
'This section sorts the labels and deletes duplicates.
If counter=0 then [EndLabel] 'In case there were no labels. counter is generated above.
open dir$+"LabelFile.txt" for output as #1
print #1, "Label List for "+FileName$ 'Title for the display window.
gosub [ProcessDataArray]
print #1, "Number of Labels = ";a
close #1
[EndLabel] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section opens the working file and breaks
'lines with a colon into multiple lines and removes any blank lines.
#progbar.st2, "Removing ':'and breaking lines - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim each line.
while instr(a$,":")>0 'Do until there are no more colons.
a=instr(a$,":") 'Break lines with a colon into multiple lines.
b$=left$(a$,a-1)
print #TemporaryFile, trim$(b$) 'Save leftmost portion of line.
LinesLeft=LinesLeft+1
ActualLines=ActualLines+1 'Remove this line if you don't want lines with a colon counted as extra lines.
a$=right$(a$,len(a$)-a) 'Get the remainder of the line.
wend
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will retrieve all array dim statements
'save them to ArrayFile.txt and removes blank lines.
redim DataArray$(50000)
#progbar.st2, "Retrieving Array names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
redim DataArray$(50000)
open dir$+"ArrayFile.txt" for output as #ArrayFile
print #ArrayFile, "Array List for "+FileName$ 'Title for display window.
counter=0 'Counts how many dim statements.
while not(eof(#WorkingFile)) 'This section finds dim statements.
line input #WorkingFile, a$ 'Input each line.
gosub [ProgMove]
a$=trim$(a$) 'Trim each line.
if left$(upper$(a$),3)="DIM" then
b$=trim$(right$(a$,len(a$)-4)) 'Get the right part of the dim statement.
[morearrays] 'If arrays were dimensioned on the next line with the _ character.
while instr(b$,")")>0 'Look for the ")"
b=len(b$) 'Get the total length of b$
a=instr(b$,")") 'Find the location of the )
c$=left$(b$,a) 'Get the array and size
b$=trim$(right$(b$,b-a)) 'Remove the array name and size
if left$(b$,1)="," then 'Are there any more dimensioned arrays on the line
a=len(b$) 'Get the new length of b$
b$=trim$(right$(b$,a-1)) 'Remove the first comma.
end if
counter=counter+1
print #ArrayFile,c$ 'Save array name and size. c$=arrayname(x,x)
c=instr(c$,"(") 'Find where size starts.
c$=trim$(left$(c$,c)) 'Get 'arrayname(' into data array.
DataArray$(counter)=c$
wend
if trim$(b$)="_" then 'If arrays are dimensioned on the next line.
line input #WorkingFile, a$ 'Input the next line.
gosub [ProgMove]
a$=trim$(a$)
b$=a$
goto [morearrays]
end if
else
if trim$(a$)>"" then
print #TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
end if
wend
print #ArrayFile, "Number of arrays = "; counter
close #ArrayFile
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section removes any references to the arrays from the working file and removes blank lines.
#progbar.st2, "Removing Array names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
a$=trim$(a$)
if counter=0 then
print #TemporaryFile, a$ 'If no arrays specified then save the line.
LinesLeft=LinesLeft+1
end if
if counter >0 then 'If arrays labels exist then
for x= 1 to counter 'go thru all labels.
array$=DataArray$(x) 'Get array label from DataArray.
while instr(a$,array$)>0
a=len(a$) 'Find length of line.
b=instr(a$,array$) 'Find start of label.
if b=0 then exit while 'If no more labels in line exit loop.
b$=left$(a$,b-1) 'Get left part of line before label.
a$=right$(a$,a-b+1) 'Get right part of line including label.
b=instr(a$,"(") 'Find ( to right of label.
a$=right$(a$,len(a$)-b) 'Get right part of line after label.
if len(a$)>0 then
a$=b$+" "+a$
else
a$=b$+" "+a$
end if
wend
next
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section will find all subs and functions and passed variables and removes them.
#progbar.st2, "Retrieving Subs && Functions - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
open dir$+"SubFile.txt" for output as #SubFile 'Title for display window.
print #SubFile, "Subroutine & Function List for "+FileName$
counter=0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
select case
case instr(upper$(a$),"CALL")>0
a$=trim$(a$) 'Remove start and ending spaces.
Index=0
cfound=0
name$=""
token$="dx31b"
while token$ <>""
Index=Index+1
token$=word$(a$,Index)
if cfound=1 then
name$=token$
cfound=0
end if
if upper$(token$)="CALL" then cfound=1
wend
a=len(a$)
b=instr(upper$(a$),"CALL")
c=len(name$)
b$=left$(a$,b-1)
d=a-(b+c+4)
c$=right$(a$,d)
a$=trim$(b$+c$)
if a$<>"" then
#TemporaryFile, a$
LinesLeft=LinesLeft+1
end if
case instr(upper$(a$),"SUB ")>0 or instr(upper$(a$),"FUNCTION ")>0
counter=counter+1
print #SubFile,trim$(a$)
case else
#TemporaryFile, a$
LinesLeft=LinesLeft+1
end select
wend
print #SubFile, "Number of Subs and Functions = "; counter
close #SubFile
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section removes the punctuation defined in the first data line and replaces with a space.
'Periods are not removed since they may be used in variables.
redim DataArray$(50000)
#progbar.st2, "Removing punctuation - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 13 'Get first 13 punctuation items into array.
read character$
DataArray$(x)=character$
next
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
for x=1 to 13
character$=DataArray$(x)
while instr(a$,character$)>0
a=len(a$)
b=instr(a$,character$) 'Find location of character.
b$=right$(a$,a-b) 'Get right side of line.
a$=left$(a$,b-1) 'Get left side of line.
a$=a$+" "+b$ 'Replace character with a space.
wend
next
if trim$(a$)>"" then
print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds file names
redim DataArray$(50000)
#progbar.st2, "Retrieving File names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
if instr(upper$(a$),"INPUT AS")>0 or instr(upper$(a$),"OUTPUT AS")>0 or instr(upper$(a$),"RANDOM AS")>0 then
a=instr(a$,"#")
b=instr(a$," ",a)
b$=trim$(mid$(a$,a,b-a))
a$=left$(a$,a-1)
counter=counter+1
DataArray$(counter)=b$
end if
if trim$(a$)>"" then
print #TemporaryFile," "+a$+" " 'Add a space at the beginning and end of line.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts and counts the file names.
if counter=0 then [EndFileName] 'In case there were no handles.
#progbar.st2, "Sorting and Saving File names - Lines Left ="+str$(LinesLeft)
open dir$+"FileName.txt" for output as #1
print #1, "File List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of File Names = ";a
close #1
[EndFileName] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section finds the handle names and
'removes from line and fills the data array.
redim DataArray$(50000)
#progbar.st2, "Retrieving Handles names - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
while instr(a$,"#")>0 'Loop while '#' exists in line.
a=len(a$)
b=instr(a$,"#") 'Find location of '#'.
c=instr(a$," ",b) 'Find space at end of the handle.
b$=left$(a$,b-1) 'Get left side of line.
counter =counter +1
DataArray$(counter)=mid$(a$,b,c-b) 'Get handle from line and save in array.
a$=b$+" "+right$(a$,a-c) 'Add space where handle was so next section works.
wend
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts, finds duplicate Handle names and
'and saves to HandleFile.txt.
if counter=0 then [EndHandle] 'In case there were no handles.
#progbar.st2, "Sorting and Saving Handle names - Lines Left ="+str$(LinesLeft)
open dir$+"HandleFile.txt" for output as #1
print #1, "Handle List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of Handles = ";a
close #1
[EndHandle] 'Skip to here if counter =0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This fills the data array with keyword strings
'and removes them from the working file.
#progbar.st2, "Removing String Keywords - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 37 'There are currently 37 string keywords in LB4.5 and 29 in LB 4.04.
read a$
DataArray$(x)=a$
next
start=1:last=37 'Last = number of keyword$.
gosub [RemoveKeywords]
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds String Variables and removes them from the file.
redim DataArray$(50000)
#progbar.st2, "Retrieving String variables - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
do while instr(a$,"$")>0 'Loop while '$' exists in line.
a=len(a$)
b=instr(a$,"$") 'Find the location of the $.
for x= b-1 to 1 step -1 'Step backwards until a space is found.
b$=mid$(a$,x,1) 'x= location of space.
if b$=" " then exit for 'When a space is found exit loop.
next
b$=right$(a$,a-b) 'Get right side of line.
counter = counter +1
DataArray$(counter)=mid$(a$,x+1,b-x)'Get string variable from line and save in array.
a$=b$+left$(a$,x-1) 'Get left side of line.
loop
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts the strings and deletes duplicates and saves.
if counter=0 then [EndStrings] 'In case there were no string variables.
#progbar.st2, "Sorting and Saving String variables - Lines Left ="+str$(LinesLeft)
open dir$+"StringFile.txt" for output as #1
print #1, "String Variable List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of String variables = ";a
close #1
[EndStrings] 'Skip to here if counter = 0
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This fills the data array with keywords and removes them from the working file.
redim DataArray$(50000)
#progbar.st2, "Removing Keywords - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
for x=1 to 171 'There are currently 171 keywords.
read a$
DataArray$(x)=a$
next
start=1:last=171
gosub [RemoveKeywords]
gosub [CloseFiles]
if LinesLeft=0 then [EndJob]
'This section finds numeric variables.
redim DataArray$(50000)
#progbar.st2, "Retrieving Numeric variables - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
counter =0
while not(eof(#WorkingFile))
line input #WorkingFile, a$
a$=trim$(a$)+" "
gosub [ProgMove]
a=len(a$)
for x = 1 to a
if (asc(mid$(a$,x,1))>64) and (asc(mid$(a$,x,1))<123) then 'Look for an alpha character in the line.
b=instr(a$," ",x) 'Find a space after numeric variable.
b$=mid$(a$,x,b-x) 'numeric variable.
c=len(b$) 'Get length of numeric variable.
if left$(b$,1)="_" and len(b$)>1 then goto [skip] 'Remove stylebit commands.
if b$="_" goto [skip] 'Remove any line continuations.
if instr(b$,"_")>1 then [skip] 'Remove any commands xxx_xxx.
counter=counter+1
DataArray$(counter)=b$
[skip]
b$=right$(a$,a-b+1) 'Get right side of line.
a$=left$(a$,x-1)+space$(c)+b$ 'Replace numeric variable with equal number of spaces.
end if
next
if trim$(a$)>"" then
print #TemporaryFile,trim$(a$)
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
'This section sorts, finds duplicate numeric variables and
'and saves to NumericFile.txt.
if counter=0 then [EndNumeric] 'In case there are no numeric variables.
#progbar.st2, "Sorting && Saving Numeric Variables - Lines Left ="+str$(LinesLeft)
open dir$+"NumericFile.txt" for output as #1
print #1, "Numeric Variable List for "+FileName$ 'Title for display window.
gosub [ProcessDataArray]
print #1, "Number of Numeric variables = ";a
close #1
[EndNumeric] 'Skip to here if counter=0.
#progbar.graphicbox1,"cls"
if LinesLeft=0 then [EndJob]
'This section removes all the numbers and remaining periods from the working file.
#progbar.st2, "Cleaning Working File - Lines Left ="+str$(LinesLeft)
ProgStep=400/LinesLeft
progx=ProgStep
LinesLeft=0
gosub [OpenFiles]
print #TemporaryFile, "Working File for "+FileName$ 'Title for display window.
while not(eof(#WorkingFile))
line input #WorkingFile, a$
gosub [ProgMove]
for x=0 to 9 'Remove numbers 0 through 9.
while instr(a$,str$(x))<>0
a$=ReplaceMultipleString$(a$, str$(x), " ") 'And replace with a space.
wend
next
a$=trim$(a$)
if (a$<>"") and (instr(a$,".")=0) then 'Remove blank lines and lines containing periods
print #TemporaryFile,trim$(a$) 'and leaves only missed things.
LinesLeft=LinesLeft+1
end if
wend
gosub [CloseFiles]
[EndJob]
close #progbar
restore
open dir$+"NumberLines.txt" for output as #NumbLines
print #NumbLines,str$(ActualLines)+" for basic program "+FileName$
close #NumbLines
notice "Job Complete!" + chr$(13) + "Use the Display menu to see results."+Chr$(13)+"Actual working lines = "+str$(ActualLines)_
+Chr$(13)+"Lines Left in Working File = "+str$(LinesLeft)
goto [MainLoop]
[ActualLines] 'Displays the number of actual working lines.
open dir$+"NumberLines.txt" for input as #NumbLines
input #NumbLines,ActualLines
close #NumbLines
notice "Number of Working lines = ";str$(ActualLines)
wait
'Please do not remove this section.
'You may modify the version number if you wish and add your name.
[About] 'About LB Reader.
WindowWidth = 250
WindowHeight = 220
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
button #helpabout.bmp1, " OK ", [haclick1], UL, 84, 155
statictext #helpabout, "LB Reader", 80, 10, 220, 20
statictext #helpabout, "Version "+curversion$, 85, 30, 90, 20
statictext #helpabout, "Written in Liberty Basic 4.04", 40, 50, 170, 20
statictext #helpabout, "jbross@sisna.com",70,90,150,20
statictext #helpabout, "Copyright 2014", 75, 110, 150,20
stylebits #helpabout, _DS_CENTER,0,0,0
open "About..." for dialog_modal as #helpabout
print #helpabout, "font arial 10"
print #helpabout, "trapclose [haclick1]"
wait
[haclick1] 'Close
close #helpabout
goto [MainLoop]
[Help] 'Display the help window.
WindowWidth = 800
WindowHeight = 600
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
button #help.default, "enter", [helpok],UL,-400,-400
button #help.b1," OK ",[helpok],UL,360,525
bmpbutton #help.b2, dir$+"print.bmp", [helpprint], UL, 745, 528
stylebits #help, _DS_CENTER,0,0,0
open "LB Reader Help" For dialog_modal As #help
#help.b1,"!setfocus"
#help, "trapclose [helpok]"
#help, "font arial 10 bold"
hTip=CreateTooltip(hwnd(#help))
call AddToolTip Hwnd(#help.b1),hTip, "Close Help "
call AddToolTip Hwnd(#help.b2),hTip, "Print Help window "
open "RICHED32.DLL" for dll as #re
calldll #comctl32, "InitCommonControlsEx",result as void
hlpT=CreateTextEdit(hWnd(#help), 10,10,775,WindowHeight-97)
File$=dir$+"help.rtf"
open File$ for input as #TempText
txt$=input$(#TempText,lof(#TempText))
close #TempText
call SetWindowText hlpT,txt$
wait
[helpprint] 'Print help.
run "write.exe "+chr$(34)+File$+chr$(34)+" /p",hide
wait
[helpok] 'Close Help.
close #help
close #re
goto [MainLoop]
data ";","/","-","+","*","|",",","=","<",">","^","(",")" '13 entries
'These data items require a space in front and the end so that key words can be found and deleted
'and not variables which may contain the keyword.
data " BACKGROUNDCOLOR$ "," CHR$ "," COMBOBOXCOLOR$ "," DATE$ "," DECHEX$ "," DEFAULTDIR$ "," DRIVE$ ",_
" LISTBOXCOLOR$ "," SPACE$ "," STR$ " '10 entries
data " FOREGROUNDCOLOR$ "," INKEY$ "," INPUT$ "," KILL$ "," LEFT$ "," LOWER$ "," MID$ "," PRINTERNAME$ ",_
" PLATFORM$ "," WORD$ " '10 entries
data " RIGHT$ "," TEXTBOXCOLOR$ "," TEXTEDITORCOLOR$ "," TIME$ "," TRIM$ "," UPPER$ "," COMMANDLINE$ ",_
" VERSION$ "," EVAL$ ", " STARTUPDIR$ " '10 entries
data " HTTPGET$ ", " UPTO$ ", " AFTER$ ", " AFTERLAST$ ", "ENDSWITH$ ", " REMCHAR$ "," REPLSTR$ " '7 entries
data " FOR "," TO "," NEXT "," EXIT "," WHILE "," WEND "," IF "," THEN "," ELSE "," END " '10 entries
data " SELECT "," CASE "," PRINT "," LPRINT "," DUMP "," OPEN "," CLOSE "," INPUT "," LINE "," AS " '10 entries
data " WAIT "," CALL "," CALLDLL "," GOTO "," RETURN "," GET "," GETTRIM "," PUT "," OUT "," OUTPUT " '10 entries
data " GOSUB "," READ "," RESTORE "," REDIM "," LEN "," VAL "," INT "," INSTR "," NAME "," SUB " '10 entries
data " BMPBUTTON "," BUTTON "," CHECKBOX "," COMBOBOX "," GRAPHICBOX "," GROUPBOX "," LISTBOX ",_
" NOMAINWIN "," RADIOBUTTON "," TEXTBOX " '10 entries
data " TEXTEDITOR "," DISPLAYWIDTH "," DISPLAYHEIGHT "," UPPERLEFTX "," UPPERLEFTY ",_
" WINDOWWIDTH "," WINDOWHEIGHT "," FUNCTION "," EOF "," FIELD " '10 entries
data " COLORDIALOG "," FONTDIALOG "," FILEDIALOG "," PRINTERDIALOG "," STATICTEXT "," DIALOG "," GRAPHICS ",_
" TEXT "," WINDOW "," CONFIRM " '10 entries
data " MENU "," FS "," NF "," NSB "," INS "," POPUP "," MODAL "," FILES "," LOF "," LET " '10 entries
data " ABS "," ASC "," AND "," ASC "," ASN "," BEEP "," BINARY "," BMPSAVE "," BOOLEAN "," CALLBACK " '10 entries
data " CLS "," COS "," CURSOR "," DATA "," DOUBLE "," DWORD "," EXP "," HBMP "," HEXDEC "," HWND ", '10 entries
data " INP "," INPUTTO "," LOADBMP "," LOC "," LOG "," LONG "," MAINWIN "," MAX "," MKDIR "," MIN " '10 entries
data " NOT "," NOTICE "," ONCOMERROR "," OPEN "," OR "," PLAYWAVE "," POPUPMENU "," PRINTCOLLATE ",_
" PRINTCOPIES "," PROMPT " '10 entries
data " RMDIR "," RND "," RUN "," SCAN "," SEEK "," SHORT "," SIN "," STOP "," RANDOM "," STRUCT " '10 entries
data " TAN "," TIMER "," TITLEBAR "," TRACE "," ULONG "," UNLOADBMP "," USHORT "," USING "," VOID ",_
" WINSTRING " '10 entries
data " WORD "," XOR "," UL "," DLL "," KILL "," BOLD "," ITALIC "," UNDERLINE "," NORMAL "," TAB " '10 entries
data " GLOBAL "," BYREF "," MAPHANDLE "," EVAL "," DO "," LOOP "," ON ERROR "," RESUME "," PLAYMIDI ",_
" MIDIPOS " '10 entries
data " SORT "," STOPMIDI "," STYLEBITS "," SQR "," STEP "," UNTIL "," MOD "," INPUTCSV "," FIND "," FINDBACK "'10 entries
data " RESETFIND" '1 entry
[Subs_&_Functions] 'Subs and Functions below.
[RemoveKeywords] 'Remove both keywords and string keywords.
while not(eof(#WorkingFile))
line input #WorkingFile, a$ 'Get a line.
gosub[ProgMove]
temp$=upper$(a$+" ") 'Change to upper case to make sure the keyword is found.
for x=start to last 'Go through all keywords
if a$="" then exit for
keyword$=DataArray$(x)
c=len(keyword$)
while instr(temp$,keyword$)>0 'Is the keyword in the line.
a=len(a$)
b=instr(temp$,keyword$) 'Find location of keyword.
b$=right$(a$,(a+1)-(b+c)) 'Get right side of line.
a$=left$(a$,b-1) 'Get left side of line.
a$=" "+a$+" "+b$+" " 'Replace keyword with a space.
temp$=upper$(a$)
wend
next
if trim$(a$)>"" then
print #TemporaryFile,a$
LinesLeft=LinesLeft+1
end if
wend
return
[OpenFiles] 'Open the working and temporary files.
open dir$+"WorkingFile.txt" for input as #WorkingFile
open dir$+"Tempory.txt" for output as #TemporaryFile
return
[CloseFiles] 'Close files and clear the progress bar.
close #TemporaryFile
close #WorkingFile
kill dir$+"WorkingFile.txt" 'Delete the working file
name dir$+"Tempory.txt" as dir$+"WorkingFile.txt" 'and name the temporary file to the working file.
#progbar.graphicbox1,"cls" 'Clears the Progress Bar graphic box.
return
[Display] 'Display various files
WindowWidth= 800
WindowHeight=600
BackgroundColor$ = "white"
ForegroundColor$ = "black"
statictext #display.st1, "", 15, 50, 780, 20
statictext #display.st2, "", 15, 70, 780, 20
statictext #display.st3, "", 15, 90, 780, 20
statictext #display.st4, "", 15, 110, 780, 20
statictext #display.st5, "", 15, 130, 780, 20
statictext #display.st6, "", 15, 150, 780, 20
statictext #display.st7, "", 15, 170, 780, 20
statictext #display.st8, "", 15, 190, 780, 20
statictext #display.st9, "", 15, 210, 780, 20
statictext #display.st10, "", 15, 230, 780, 20
statictext #display.st11, "", 15, 250, 780, 20
statictext #display.st12, "", 15, 270, 780, 20
statictext #display.st13, "", 15, 290, 780, 20
statictext #display.st14, "", 15, 310, 780, 20
statictext #display.st15, "", 15, 330, 780, 20
statictext #display.st16, "", 15, 350, 780, 20
statictext #display.st17, "", 15, 370, 780, 20
statictext #display.st18, "", 15, 390, 780, 20
statictext #display.st19, "", 15, 410 , 780, 20
statictext #display.st20, "", 15, 430, 780, 20
statictext #display.st21, "", 15, 450, 780, 20
statictext #display.st22, "", 15, 470, 780, 20
statictext #display.st23, "", 15, 490, 780, 20
statictext #display.st24, "", 15, 510, 780, 20
statictext #display.st25, "", 15, 530, 780, 20
statictext #display.st26, "", 500, 0 ,140, 25
button #display.default, "enter", [displayquit],UL,-400,-400
button #display.b1, "",[lastpage], UL, 651, 0 ,25, 25 'lastbut
stylebits #display.b1, _BS_BITMAP, 0, 0, 0
button #display.b2, "", [pagedown], UL, 675, 0, 25, 25 'dbttn
stylebits #display.b2, _BS_BITMAP, 0, 0, 0
button #display.b3, "", [pageup], UL, 699, 0, 25, 25 'ubttn
stylebits #display.b3, _BS_BITMAP, 0, 0, 0
button #display.b4, "", [firstpage], UL, 723 ,0, 25, 25 'firstbut
stylebits #display.b4, _BS_BITMAP, 0, 0, 0
button #display.b5, "",[displayjump], UL, 747, 0, 25, 25 'jumpto
stylebits #display.b5, _BS_BITMAP, 0, 0, 0
button #display.b6, "", [displayprint], UL, 770, 0, 25, 25 'print
stylebits #display.b6, _BS_BITMAP, 0, 0, 0
stylebits #display, _DS_CENTER,0,0,0
open Title$ for dialog_modal as #display
#display, "font courier new 12 bold"
#display, "trapclose [displayquit]"
hParent = hwnd(#display)
hTip=CreateTooltip(hParent)
call AddToolTip Hwnd(#display.b1),hTip, "Last Page "
call AddToolTip Hwnd(#display.b2),hTip, "Next Page "
call AddToolTip Hwnd(#display.b3),hTip, "Previous Page "
call AddToolTip Hwnd(#display.b4),hTip, "First Page "
call AddToolTip Hwnd(#display.b5),hTip, "Jump to Page "
call AddToolTip Hwnd(#display.b6),hTip, "Print Display "
Call BitmapButton Hwnd(#display.b1), HBmp("lastbut")
Call BitmapButton Hwnd(#display.b2), HBmp("dbttn")
Call BitmapButton Hwnd(#display.b3), HBmp("ubttn")
Call BitmapButton Hwnd(#display.b4), HBmp("firstbut")
Call BitmapButton Hwnd(#display.b5), HBmp("jumpto")
Call BitmapButton Hwnd(#display.b6), HBmp("print")
for hv=1 to 26
var$="#display.st"+str$(hv)
#var$ FontVariable$
next
Index=1
pagenumb=1
numbpages=int(RecNum/25)
if numbpages<1 then numbpages=1
if RecNum/25>numbpages then numbpages=numbpages+1
[nextpage]
#display.st26, "Page ";pagenumb;" of ";numbpages
for hv=1 to 25
var$="#display.st"+str$(hv)
#var$ DataArray$(Index+hv-1)
next
wait
[displayjump]'Jump to page number.
redim DisplayBox$(200)
for x=1 to numbpages
DisplayBox$(x)=str$(x)
next
jumpH=25*numbpages
if jumpH>400 then jumpH=400
WindowWidth = 150
WindowHeight= 90+jumpH
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
ListboxColor$ = "white"
BackgroundColor$ = "buttonface"
ForegroundColor$ = "black"
statictext #jumpto, "Jump to Page",25,3,100,20
listbox #jumpto.lb1, DisplayBox$(, [jumptoselect],45,25,50,jumpH
stylebits #jumpto, _DS_CENTER,0,0,0
open "" for dialog_modal as #jumpto
#jumpto, "font arial 10 bold"
#jumpto.lb1, "reload"
#jumpto, "trapclose [jumptoclose]"
#jumpto.lb1,"singleclickselect"
hParent = hwnd(#jumpto)
hTip=CreateTooltip(hParent)
call AddToolTip Hwnd(#jumpto.lb1),hTip, "Click to select a page "
wait
[jumptoselect] 'Select a page to jump to
#jumpto.lb1, "selectionindex? pagenumb"
Index=(pagenumb-1)*25+1
[jumptoclose] 'Close jump to window
close #jumpto
goto [nextpage]
[lastpage]'Go to last page
if RecNum=0 then [nextpage]
Index = (numbpages-1)*25+1
pagenumb=numbpages
goto [nextpage]
[pagedown]'Page down
Index=Index+25
pagenumb=pagenumb+1
if pagenumb>numbpages then Index=Index-25:pagenumb=pagenumb-1
goto [nextpage]
[pageup]'Page up
Index=Index-25
pagenumb=pagenumb-1
if pagenumb<1 then Index=Index+25:pagenumb=pagenumb+1
goto [nextpage]
[firstpage]'Go to first page
Index=1
pagenumb=1
goto [nextpage]
[displayprint]'Print the file.
PrinterFont$="font arial 12"
lprint Title$
lprint
for x=1 to RecNum
lprint DataArray$(x)
next
dump
wait
[displayquit]'Close the display window.
a=ReleaseTooltipMemory(hTip)
close #display
return
[FindFiles] 'See if the file exists.
files dir$, displayfile$, info$(
If (val(info$(0, 0)) =0) then 'File doesn't exist.
notice "Error!"+chr$(13)+"File not created yet. "
return
end if
If (val(info$(1, 1)) =0) then 'File exists but is empty.
notice "Error!"+chr$(13)+"The File is empty. "
return
end if
redim DataArray$(50000)
open dir$+displayfile$ for input as #File
RecNum=0
line input #File, Title$
while not(eof(#File))
line input #File, a$
RecNum=RecNum+1
DataArray$(RecNum)=a$
wend
close #File
gosub [Display]
return
[ProgressBar] 'Create Progress Bar.
WindowWidth = 500
WindowHeight = 165
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
statictext #progbar.st1, "",428,54,50,25 'Percent complete.
statictext #progbar.st2, "",20,100,450,25 'File Name.
groupbox #progbar.gb1, " Please Wait - Working ",5,5,485,125
graphicbox #progbar.graphicbox1, 20, 55, 400, 25
stylebits #progbar, _DS_CENTER,0,0,0
open "Please Wait" for dialog_popup as #progbar
#progbar, "font arial 14 bold"
#progbar.st2, "!font arial 12 bold"
#progbar.graphicbox1,"down; backcolor green"
progx=ProgStep
return
[ProgMove] 'Move Progess Bar.
percent=int((progx/400)*100)
if percent>100 then percent=100
#progbar.st1,str$(percent)+"%"
#progbar.graphicbox1,"discard place 0 0"
#progbar.graphicbox1,"boxfilled ";int(progx);" 25"
progx=progx+ProgStep
return
[ProcessDataArray] 'Sort, count and remove duplicates.
ProgStep=400/counter
progx=ProgStep
sort DataArray$(),1,counter
for x=1 to counter 'Find duplicates and mark with **.
gosub [ProgMove] 'Move the progress bar one step progx
if DataArray$(x)<>"**" then 'As array elements are marked with ** then skip. Makes the routine go faster.
NumberofOccurence=1
variable$=DataArray$(x)
DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")"
for y=x+1 to counter
if variable$=DataArray$(y) then
DataArray$(y)="**"
NumberofOccurence=NumberofOccurence+1
DataArray$(x)=variable$+" ("+str$(NumberofOccurence)+")"
end if
next
end if
next
a=0 'Number of remaining items.
for x=1 to counter 'Save ritems excluding **.
if DataArray$(x)<>"**" then
print #1, DataArray$(x)
a=a+1
end if
next
return
[UpdateRecentList]
flag=0 'Set to 1 if the selected new file is already in the recent list.
If NewFile$<>"" then 'A new file has been selected.
for x=1 to 8 'Does it already exist in the recent list.
if RecentArray$(x)="" then exit for 'If an array element is empty exit the for/next.
if NewFile$=RecentArray$(x) then 'If it exists in the recent list then
flag=1 'set the flag to 1 and
exit for 'exit the for/next.
end if
next
if flag=1 then [skipupdate] 'End the update.
for x=8 to 2 step-1 'The new file does not exist in the recent list
RecentArray$(x)=RecentArray$(x-1) 'then move each recent file down one element
next
RecentArray$(1)=NewFile$ 'and put the new recent file in element 1.
goto [skipupdate]
end if
if RecentFile$ ="" then 'The recent file selected no longer exists.
for x=Index to 7
RecentArray$(x)=RecentArray$(x+1)
if RecentArray$(x)="" then exit for
next
RecentArray$(8)=""
else 'The recent file exists so move it to #1 element.
a$=RecentArray$(Index)
for x=Index to 2 step -1
RecentArray$(x)=RecentArray$(x-1)
next
RecentArray$(1)=a$
end if
[skipupdate] 'Finaly refil the ini file and update the recent menus.
open DefaultDir$+"\recent.ini" for output as #1
for x=1 to 8
a$=RecentArray$(x)
print #1,a$
calldll #user32, "GetMenuItemID",hfile as ulong,x as long,hfileid as ulong
call MenuMod hfile, hfileid, a$, x 'Modify the recent menu items.
next
close #1
return
sub BitmapButton hButton, hBitmap
CallDLL #user32, "SendMessageA", _
hButton as uLong, _
_BM_SETIMAGE as Long, _
_IMAGE_BITMAP as Long, _
hBitmap As uLong, _
result as Long
end Sub
sub GetIni 'Open the recent.ini file and fill the array.
open DefaultDir$+"\recent.ini" for input as #1
for x=1 to 8
input #1, RecentArray$(x)
next
close #1
end sub
sub MenuMod hmainmenu, position,pointer$,Index 'Used to modify the Main Window Recent Menus.
pointer$="&"+str$(Index)+". "+pointer$ 'The menu will be "1. C:\folder\filename".
'In this demo, the start of the recent file menus is at 2.
'So a 1 must be added to the position.
position=position+1 'in this demo, the first recent menu is at position 2 through 9.
flags=_MF_STRING or _MF_BYCOMMAND
calldll #user32, "ModifyMenuA",_
hmainmenu as ulong,_
position as ulong,_
flags as long,_
position as ulong,_
pointer$ as ptr,_
r as boolean
end sub
sub AddToolTip cHndl, hWnd, text$
TOOLINFO.uId.struct = cHndl
TOOLINFO.lpszText.struct = text$
CallDLL #user32, "SendMessageA",_
hWnd As ulong, _
1028 As long, _
0 As long, _
TOOLINFO as ptr, _
result as long
end sub
sub SetWindowText hWnd, txt$ 'Places text in the Help window.
callDLL #user32, "SetWindowTextA",hWnd As ulong,txt$ As ptr,result As void
end sub
Sub staticImage hSt, hB 'Code from Janet
Calldll #user32, "SendMessageA", _
hSt as long, _
_STM_SETIMAGE as long, _
_IMAGE_BITMAP as long, _
hB as long, r as ulong
End Sub
FUNCTION CreateTextEdit(hWin, x, y, w, h)
style = _WS_CHILDWINDOW OR _WS_BORDER OR _WS_VISIBLE or _ES_MULTILINE or _WS_VSCROLL or _ES_READONLY
hInst=GetWindowLong(hWin, _GWL_HINSTANCE)
callDLL #user32,"CreateWindowExA",_
0 As long,"RichEdit" As ptr,_
"" As ptr, style As long,_
x As long,y As long,w As long,h As long,_
hWin As ulong, 0 As long, hInst As ulong,_
0 As long, CreateTextEdit As long
END FUNCTION
FUNCTION CreateTooltip(hMain)
Struct TOOLINFO, _
cbSize As long, _
uFlags As long, _
hwnd As ulong, _
uId As long, _
rectLeft As long, _
rectTop As long, _
rectRight As long, _
rectBottom As long, _
hinst As ulong, _
lpszText As ptr
CallDLL #comctl32,"InitCommonControlsEx", _
result as void
TOOLINFO.cbSize.struct = Len(TOOLINFO.struct)
TOOLINFO.uFlags.struct = flags Or 17 'TTF_IDISHWND Or TTF_SUBCLASS
TOOLINFO.hwnd.struct = hMain
CallDLL #user32,"CreateWindowExA",_
0 As long, _
"tooltips_class32" As ptr, _
0 As long, style As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
_CW_USEDEFAULT As long, _
hMain As ulong, _
0 As long, _
0 as long, _
0 As long, _
CreateTooltip As Long
END FUNCTION
FUNCTION GetWindowLong(hWin, type)
callDLL #user32, "GetWindowLongA", hWin As ulong, type As long, GetWindowLong As long
END FUNCTION
'The next two functions are from Alyce Watson's web site.
Function SeparateFile$(f$)
fileindex=len(f$)
filelength=len(f$)
while mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
wend
SeparateFile$=right$(f$,filelength-fileindex)
end function
Function SeparatePath$(f$)
fileindex=len(f$)
filelength=len(f$)
while mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
wend
SeparatePath$=left$(f$,fileindex)
end function
FUNCTION ReleaseTooltipMemory(hTip)
CallDLL #user32, "DestroyWindow",_
hTip As ulong, _
result As long
END FUNCTION
function ReplaceMultipleString$(st$, tg$, rp$) 'Replace multiple occurences.
targetlength = len(tg$) 'Find length of target$.
nextpos=1 'Start at position 1.
while instr(st$,tg$,nextpos)>0 'Do while target$ exists.
startlength = len(st$) 'Find length of start$.
startposition = instr(st$,tg$,nextpos) 'Find position of target$.
LeftofString$ = left$(st$,startposition-1) 'Get left of start$ to target$.
nextpos=startposition+targetlength 'Get right of start$ after target$.
RightofString$ = Right$(st$,startlength-(nextpos-1))
ReplaceMultipleString$=LeftofString$+rp$+RightofString$ 'Add replace$ to final$.
st$=ReplaceMultipleString$ 'Set st$ to final$ so the while loop works.
wend
end function
Thanks. The program mentions several bitmap files. Where can I get them? |
|
lastbut.bmp
LBReader.bmp
firstbut.bmp
jumpto.bmp
ubttn.bmp
dbttn.bmp
print.bmp