Post by xxgeek on Aug 17, 2023 9:20:46 GMT -5
CodeTank Plus v1.0 - formerly named CodeBank - changed due to a past program of the same name.
- Uses Carl Gundel's Dictionary code at it's core.
This is a program I have been working on since my first days with Just Basic about a year and 1/2 ago.
Edited for LB and LB Pro
I use it a lot to save code, and to build and test programs.
Submitted as a Community project to gain ideas for improvement, additions etc.
When ever\where ever I come across some useful code, I save it to the appropriate category.
I have tons of code for both Just Basic and Liberty Basic gathered over the past year and 1/2.
Every function, sub, example, snippet, and program I have come across, or written is in MY CodeTank.
This CodeTank is Empty, ready for you to load it up with the code YOU wish to have at YOUR finger tips.
Basically, there are a few self explaining radiobutton choices.
The top 2 (MyProjects, and MyPrograms) are rather special. Both will automate the creation of the TKN file.
MyProjects will create a folder with all the .dll's, .sll's the .bas file and renamed run451.exe, along with the .TKN file.
MyPrograms will only create the TKN and copy the .bas file to a folder named after the chosen file.
Backups of the .TKN, and the .BAS files are also created with each [New (From File)] selection.
The user can also Manually create entries for each of these, and a few other categories by using [New (copy\paste)]
A prompt will appear to give the entry a name, and then you can paste your code into the texteditor.
No need to save, it's all automated.
While automation is ongoing, it's best to not touch the mouse or keyboard.
Just let it do it's thing.
The files it creates for each category can be shared, and merged with others using this app using the [Merge] button.
MyProjects, and MyPrograms can be reverted back to an earlier version with the [Revert] button.
There is also a button to [Edit in LB IDE] and one to [RUN] the code.
This line was edited (AGAIN)
(YOU CAN NOW edit MyPrograms or MyProjects in the texteditor in order to update the code.)
You can edit the code for your MyProjects, and your MyPrograms by using [Edit in LB IDE] save the .bas file, and then [Update TKN File]
You will notice some buttons get disabled depending on the RadioButton chosen.
This is done to protect certain files from user editing\deleting etc.
When a LB Example file is selected for [Edit in LB IDE] it actually opens an untitled copy and not the original file.
Please feel free to use, edit, suggest, or criticize as desired.
There is one part of this app I am hoping can be changed.
The automation of the TKN file is done by writing a small VB script to send [enter] to the TKN 'save as' dialog.
And another [enter] to the 'Information' window letting the user know where it was saved to.
If anyone knows how this can be done with native code, please post the necessary changes.
Have fun, and please do report any issues.
MAKE SURE - You save this code to a folder of it's own before RUNing. It creates a lot of files, and folders.
Current Version for Pro and non-Pro Liberty Basic v4.5.1
v1.5.0
Updated code will be posted at Code-Share
- Uses Carl Gundel's Dictionary code at it's core.
This is a program I have been working on since my first days with Just Basic about a year and 1/2 ago.
Edited for LB and LB Pro
I use it a lot to save code, and to build and test programs.
Submitted as a Community project to gain ideas for improvement, additions etc.
When ever\where ever I come across some useful code, I save it to the appropriate category.
I have tons of code for both Just Basic and Liberty Basic gathered over the past year and 1/2.
Every function, sub, example, snippet, and program I have come across, or written is in MY CodeTank.
This CodeTank is Empty, ready for you to load it up with the code YOU wish to have at YOUR finger tips.
Basically, there are a few self explaining radiobutton choices.
The top 2 (MyProjects, and MyPrograms) are rather special. Both will automate the creation of the TKN file.
MyProjects will create a folder with all the .dll's, .sll's the .bas file and renamed run451.exe, along with the .TKN file.
MyPrograms will only create the TKN and copy the .bas file to a folder named after the chosen file.
Backups of the .TKN, and the .BAS files are also created with each [New (From File)] selection.
The user can also Manually create entries for each of these, and a few other categories by using [New (copy\paste)]
A prompt will appear to give the entry a name, and then you can paste your code into the texteditor.
No need to save, it's all automated.
While automation is ongoing, it's best to not touch the mouse or keyboard.
Just let it do it's thing.
The files it creates for each category can be shared, and merged with others using this app using the [Merge] button.
MyProjects, and MyPrograms can be reverted back to an earlier version with the [Revert] button.
There is also a button to [Edit in LB IDE] and one to [RUN] the code.
This line was edited (AGAIN)
(YOU CAN NOW edit MyPrograms or MyProjects in the texteditor in order to update the code.)
You can edit the code for your MyProjects, and your MyPrograms by using [Edit in LB IDE] save the .bas file, and then [Update TKN File]
You will notice some buttons get disabled depending on the RadioButton chosen.
This is done to protect certain files from user editing\deleting etc.
When a LB Example file is selected for [Edit in LB IDE] it actually opens an untitled copy and not the original file.
Please feel free to use, edit, suggest, or criticize as desired.
There is one part of this app I am hoping can be changed.
The automation of the TKN file is done by writing a small VB script to send [enter] to the TKN 'save as' dialog.
And another [enter] to the 'Information' window letting the user know where it was saved to.
If anyone knows how this can be done with native code, please post the necessary changes.
Have fun, and please do report any issues.
MAKE SURE - You save this code to a folder of it's own before RUNing. It creates a lot of files, and folders.
Current Version for Pro and non-Pro Liberty Basic v4.5.1
v1.5.0
'CodeTank v1.4.7 - For Liberty Basic v4.5.1 and (Pro)
'created by xxgeek Aug 2023
'This app uses "Dictionary" code, written by Carl Gundel, at it's core - edited to suit this app
'Purposes -
' (1) To create reservoir(s) of code, subs, functions, scripts and example programs with ability to share_
'_ with others each category file, to merge with their own reservoir(s).
' (2) To automate the collection of support dll and sll files along with TKN file creation and renaming_
'_ of the run451.exe
' (3) To create dated\timestamped backups of each .bas file, and a .tkn backup file of each .bas_
'_ file to 'Revert' back if\when needed.
'Use alt +
' Char Button
' m = [Mirror Editor]
' n = [New (Copy\Paste)]
' f = [New From File]
' u = [Update TKN]
' e = [Edit in LB IDE]
' r = [ RUN ]
' s = [Merge Shared File] - on the Mirror window = [Scratch] button
' v = [Revert to Backup]
' d = [Delete]
' + = Increase Font Size [+]
' - = Decrease Font Size [-]
'WARNING - Save to a folder of it's own, it creates files, and folders when used.
' Please Note:
' When selecting a .bas file to create a New Project, or Program.......
' Make sure the .bas file is a known good one, and runs/starts ok in the LB IDE
' If the .bas file cannot pass the compiler's check, it can cause havoc with the automation'
' process, and probably crash CodeTank.
'When RUNing any files be aware that the file you are running 'MAY' be the culprit if a problem arises.
'The LB IDE may stay open, along with a mainwin, and the user must close both manually.
'For help using CodeTank visit the Liberty Basic forums
' @ https://libertybasiccom.proboards.com/
on error goto [abort]
nomainwin
gosub [initiate]
[start]
'dim arrays for key$ and info$
dim key$(1000)
dim info$(500, 500)
'declare variables
q$ = chr$(34)
codebank$ = "#codeTank"
LBruntime$ = "run451.exe"
DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
savedProjects$ = "savedProjects"
MyProjects$ = "MyProjects"
MyBackups$ = "MyBackups"
programs$ = "Programs"
vbs$ = "VBS-Scripts"
cmd$ = "CMD-Scripts"
examples$ = "Examples"
snippets$ = "Snippets"
lbExamples$ = "LB-Examples"
lbBakFiles$ = "LB-BAK-Files"
subroutines$ = "Subroutines"
functions$ = "Functions"
mainFontsize = 10
WinWide = 800 '1000
WinHigh = 600
UserMonitorResx = 1000 '800
UserMonitorResy = 768 '600
IF UserMonitorResx < WinWide THEN
Diff = WinWide - UserMonitorResx
WinWide = WinWide - Diff
END IF
IF UserMonitorResy < WinHigh THEN
Diff = WinHigh - UserMonitorResy
WinHigh = WinHigh - Diff
END IF
RetVal = FN.ScreenCenter(Cx, Cy) '<--- get screen center
RetVal = FN.SetWinPos(Cx - INT(WinWide / 2), Cy - INT(WinHigh / 2)) '<--- set window pos
RetVal = FN.SetWinSize(WinWide, WinHigh) '<--- set window size
BackgroundColor$ = "lightgray"
menu #codeTank, "File" , "Open Liberty Basic", [openlb], "Open a File in Liberty Basic", [openlbFile], "Exit", [quit.codeTank]
menu #codeTank, "Edit"
menu #codeTank, "Browse" , "My Projects", [projectsDir], ".TKN Files", [tknDir], ".BAS Files", [basFiles],"DefaultDir$", [defaultDir],"LB Code Examples", [lbexamplesDir]
menu #codeTank, "Help" , "Liberty Basic Forums", [forumlink], "Help", [codeTankHelp], "About", [about]
texteditor #codeTank.value, 440, 25, 340, 475
listbox #codeTank.keys, keys$(), [keySelected], 100, 25, 340, 370
'category radio buttons
radiobutton #codeTank.savedprojects, "MyProjects", [projs], resetHandler, 5, 75, 95, 20
radiobutton #codeTank.programs, "MyPrograms", [progs], resetHandler, 5, 95, 95, 20
radiobutton #codeTank.backups, "MyBackups", [mybackups], resetHandler, 5, 115, 95, 20
radiobutton #codeTank.examples, "Examples", [exams], resetHandler, 5, 165, 80, 20
radiobutton #codeTank.snippets, "Snippets", [snipps], resetHandler, 5, 185, 95, 20
radiobutton #codeTank.subroutines, "Subroutines", [subroutines], resetHandler, 5, 205, 95, 20
radiobutton #codeTank.functions, "Functions", [functions], resetHandler, 5, 225, 95, 20
radiobutton #codeTank.VBS, "VBS-Scripts", [vbs], resetHandler, 5, 245, 95, 20
radiobutton #codeTank.CMD, "CMD-Scripts", [cmd], resetHandler, 5, 265, 95, 20
radiobutton #codeTank.lbexamples, "LB-Examples", [lbCodeExamples], resetHandler, 5, 315, 95, 20
radiobutton #codeTank.lbbakfiles, "LB-BakFiles", [lbbakfiles], resetHandler, 5, 335, 95, 20
radiobutton #codeTank.folderChoice, "Any Folder", [folderChoice], resetHandler, 5, 375, 95, 20
'Event buttons etc
wh=WinHigh-100
button #codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)), [newKey], LL, 270, wh-415, 165, 25
button #codeTank.fromFile, "New from &File", [makeproject], LL, 105, wh-415, 155, 25
button #codeTank.remakeproject, "&Update TKN File", [remakeproject], LL, 105, wh-465, 155, 25
button #codeTank.runlb, "&Edit in Liberty Basic", [edit_In_LB_IDE], LL, 105, wh-440, 155, 25
button #codeTank.merge, "Merge &Shared File ";categorie$, [mergeFile], LL, 270, wh-465, 165, 25
button #codeTank.runListing, "&Run", [runKey], LL, 270, wh-440, 165, 25
button #codeTank.revert, "Re&vert to Backup", [revert], LL, 105, wh-490, 155, 25
button #codeTank.deleteListing, " &Delete ", [deleteKey], LL, 270, wh-490, 165, 25
textbox #codeTank.filePath, 100, 2, WinWide-120, 22
statictext #codeTank.categories, "Categories", 20, 40, 80, 15
button #codeTank.incFont, "&+", [incFont], UL, 25, 420, 20, 23
button #codeTank.decFont, "&-", [decFont], UL, 50, 420, 20, 23
button #codeTank.mirror, "&Mirror Editor", [textEdMirror], UL, 5, 460, 95, 25
open "CodeTank Plus v1.4.7" for window as #codeTank
#codeTank "trapclose [quit.codeTank]"
#codeTank "font Arial ";mainFontsize
#codeTank.addListing "!disable"
#codeTank.deleteListing "!disable"
#codeTank.remakeproject "!disable"
#codeTank.runListing "!disable"
#codeTank.runlb "!disable"
#codeTank.fromFile "!disable"
#codeTank.merge "!disable"
#codeTank.revert "!disable"
#codeTank.keys "singleclickselect"
#codeTank.value "!autoresize"
#codeTank "resizehandler resized"
codetankOpen = 1
categorie$ = "ScratchPad"
open "ScratchPad" for output as #1 : close #1
wait
[abort]
Notice "An Error Has Occured";chr$(13);"Error #";Err;" ";chr$(13);Err$;" ";chr$(13);"CodeTank will need to Shutdown"
goto [quit.codeTank]
[newKey] 'ask the user for a name for the new listing
call saveValue
newKey$ = ""
if len(left$(categorie$, (len(categorie$) - 1))) < 4 then [notPlural]
prompt "Enter a Name (or Title) for the New " + left$(categorie$,(len(categorie$)-1)); newKey$
if newKey$ <> "" then [continue] else wait
[notPlural]
prompt "Enter a Name (or Title) for the New "+categorie$+" Script"; newKey$
if newKey$ = "" then wait
'if user selects 'New From File' instead of New (copy/paste) to add new Project, or new Program
[continue]
if newKey$ <> "" then
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
#codeTank.value "!cls";
call collectGarbage
call writeDictionary
lastKey$ = newKey$
end if
if tkn = 2 or tkn = 4 then
open fname$ for input as #1
open categorie$ for append as #2
#2 input$(#1, lof(#1));
close #1
close #2
call cleanup
tkn = 0
end if
call saveValue
call readDictionary
call loadKeys
#codeTank.keys "select 0"
#codeTank.value "!setfocus"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[keySelected]
call saveValue
#codeTank.keys "selection? selectedKey$"
if categorie$ = anyFolder$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";anyFolder$;" Section - ";selectedKey$
if categorie$ = examples$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";examples$;" Section - ";selectedKey$
if categorie$ = snippets$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";snippets$;" Section - ";selectedKey$
if categorie$ = cmd$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";cmd$;" Section - ";selectedKey$
if categorie$ = vbs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";vbs$;" Section - ";selectedKey$
if categorie$ = subroutines$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";subroutines$;" Section - ";selectedKey$
if categorie$ = functions$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";functions$;" Section - ";selectedKey$
if categorie$ = MyProjects$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyProjects$;" Section - ";selectedKey$
if categorie$ = programs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";programs$;" Section - ";selectedKey$
if categorie$ = lbExamples$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbExamples$;" File - ";uAppPath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open uAppPath$;"\";selectedKey$;".bas" for input as #1
'code$ = input$(#1, lof(#1))
'#codeTank.value code$
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
wait
end if
if categorie$ = lbBakFiles$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbBakFiles$;" File - ";uAppPath$;"\bak\";selectedKey$;".bak"
#codeTank.value "!cls"
open uAppPath$;"\bak\";selectedKey$;".bak" for input as #1
#codeTank.value, "!contents #1";
'code$ = input$(#1, lof(#1))
close #1
'#codeTank.value code$
#codeTank.value, "!origin 0, 0"
wait
end if
if categorie$ = anyFolder$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";folderChoice$;" File - ";folderpath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open folderpath$;"\";selectedKey$;".bas" for input as #1
code$ = input$(#1, lof(#1))
close #1
#codeTank.value code$
#codeTank.value "!origin 0 0"
wait
end if
if categorie$ = MyBackups$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyBackups$;" File - ";DefaultDir$;"\BAS\";selectedKey$;".bas"
#codeTank.value "!cls"
open DefaultDir$;"\";"BAS\";selectedKey$;".bas" for input as #1
code$ = input$(#1, lof(#1))
close #1
#codeTank.value code$
#codeTank.value, "!origin 0 0"
wait
end if
selectedValue$ = getValue$(selectedKey$)
#codeTank.value "!contents selectedValue$";
lastKey$ = selectedKey$
#codeTank.value, "!origin 0 0"
wait
[deleteKey]
'delete a Listing
gosub [deleteNow]
wait
[deleteNow]
#codeTank.keys "selection? selectedKey$"
if selectedKey$ = "" then notice "Select an item from list, try again" : cursor normal : wait
[deleteOrig]
cursor hourglass
call pleasewait : pleasewaitOpen = 1
#codeTank.filePath "cls" : #codeTank.filePath "Erasing ";selectedKey$;" code from - ";categorie$
#codeTank.value, "!selectall"
#codeTank.value, "!cut"
#pleasewait.fake "!setfocus"
call saveValue
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
open categorie$ for output as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 Pad$
close #1
end if
open categorie$ for input as #1
tempfile$ = "tempfile"
open tempfile$ for output as #2
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
while eof(#1) = 0
line input #1, line$
if line$ = word1$ then [dontSave]
#2, line$
[dontSave]
wend
close #1
close #2
if fileExists(DefaultDir$, categorie$) then kill DefaultDir$;"\";categorie$
name tempfile$ as categorie$
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
#codeTank.keys "select 0"
if pleasewaitOpen = 1 then pleasewaitOpen = 0 : close #pleasewait
cursor normal
if pathExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$) <> 0 and mir = 0 then
folder$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$
text$ = "Title: "+selectedKey$+chr$(13)+" Has been Deleted"+chr$(13)+chr$(13)+"Do you wish to delete the project folder as well?"
a$ = custcon$(text$)
print answer$
if answer$ <> "Yes" then wait
a$ = delete$(folder$)
end if
return
'run selected MyProjects, or MyPrograms
[runKey]
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
text$ = "Warning "+chr$(13)+"RUNing this Code May Leave an IDE Window"+chr$(13)+"and or"+chr$(13)+"Leave Mainwin Open when it Closes";chr$(13)+"It May Not Open at all, or it May Just Flash Open and Close"+chr$(13)+"Run it Anyway ?"
if categorie$ = lbBakFiles$ then
runFile$ = uAppPath$;"\bak\";selectedKey$;".bak"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(code$,"trapclose",1) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bak";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = MyBackups$ then
runFile$ = DefaultDir$;"\BAS\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = anyFolder$ then
runFile$ = FolderDialog$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = lbExamples$ then
runFile$ = uAppPath$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 or instr(lower$(code$),lower$("'nomainwin")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
run LBpath$;"\";LBexe$;" -R -A ";runFile$
wait
end if
if categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".tkn") <> 0 then
runFile$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".exe") <> 0 then
runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") = 0 then
notice "Cannot be RUN"+chr$(13)+"This Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Not created using 'New from File'"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it as the 'Same Name..bas"+chr$(13)+"Select Radio Button "+categorie$+chr$(13)+"Select Button [New from File]"+chr$(13)_
+"Select the .bas file you just saved."+chr$(13)+" It will be available to RUN from then on"
end if
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'open selected listing in just Basic IDE
[edit_In_LB_IDE]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run LBpath$;"\";LBexe$;" ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[mergeFile]
filedialog "Select a ";categorie$ ;" file to merge ",DefaultDir$, mergefile$
if mergefile$ = "" then wait
a$ = GetFilename$(mergefile$)
if a$ <> categorie$ then
answer$ = "yes"
prompt " Categories Don't Match "+chr$(13)+" Merge Anyway?" ; answer$
if answer$ <> "yes" then wait
end if
open mergefile$ for input as #1
line input #1, dataline$ : close #1
mergeCheck$ = chr$(134)+chr$(165)+chr$(134)
if left$(dataline$, 3) <> mergeCheck$ then notice "Merge with ";categorie$+" Issue"+chr$(13)+chr$(13)+"Unable to Merge File named "+chr$(13)+a$+chr$(13)+"The formatting of file "+a$+" is incompatible" : wait
call pleasewait : cursor hourglass
open mergefile$ for input as #1
open DefaultDir$;"\";categorie$ for append as #2
#2 input$(#1, lof(#1));
close #2 : close #1
call readDictionary
call collectGarbage
call writeDictionary
call loadKeys
close #pleasewait
cursor normal
#codeTank.keys "select 0"
wait
[codeTankHelp]
notice "codeTank is curently in development, For Help, please visit the LB forums";chr$(13);chr$(13);"@ https://libertybasiccom.proboards.com/"
wait
[about]
notice "codeTank is curently in development. Please Visit ";chr$(13);chr$(13);"https://libertybasiccom.proboards.com/"
wait
[revert]
revert = 1
'Work starts here
#codeTank.keys "selection? name$"
if name$ = "" then notice "Select an item from list, try again" : wait
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$;"\BAS\*";selectedKey$;"*.bas", fname$
if fname$ = "" then wait
open fname$ for input as #1
fnamenobas$ = word$(fname$, 2, "--") : fnamenobas$ = left$(fnamenobas$, len(fnamenobas$) - 4)
open DefaultDir$;"\";savedProjects$;"\";fnamenobas$;"\";fnamenobas$;".bas" for output as #2
#2 input$(#1, lof(#1)) : close #1 : close #2
goto [remakeproject]
wait
[openlb]
run LBpath$;"\";LBexe$
wait
'top menu "Open File in LB IDE"
[openlbFile]
filedialog "Open \ Select a Liberty Basic Source File (.bas) ", upath$; "\*.bas", openFilename$
if openFilename$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "File Opened in Liberty Basic - ";openFilename$
run LBpath$;"\";LBexe$;" ";openFilename$
wait
[basFiles]
run "explorer.exe ";q$;DefaultDir$;"\";"BAS";q$
wait
'open the following in Windows Explorer
[projectsDir]
run "explorer.exe ";q$;DefaultDir$;"\";"savedProjects";q$
wait
[tknDir]
a$ = DefaultDir$;"\TKN"
run "explorer.exe ";q$;a$;q$
wait
[lbexamplesDir]
if pathExists(uAppPath$) <> 0 then
run "explorer.exe ";q$;uAppPath$;q$
else
if pathExists(uAppPath$) <> 0 then run "explorer.exe ";uAppPath$
end if
wait
[defaultDir]
run "explorer.exe ";q$;DefaultDir$;q$
wait
'radio button selections from MyProjects to Help
[projs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge "!enable"
#codeTank.merge "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyProjects$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
category$ = right$(category$,7)
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[progs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge, "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = programs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.keys "singleclickselect"
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[exams]
#codeTank.runListing, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = examples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[snipps]
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.runListing, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = snippets$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
wait
[subroutines]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = subroutines$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[functions]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = functions$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$= left$(categorie$, (len(categorie$) - 1))
wait
[vbs]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = vbs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[cmd]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = cmd$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[lbCodeExamples]
if fileExists(DefaultDir$, lbExamples$) <> 0 then kill DefaultDir$;"\";lbExamples$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbExamples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim lbExamplesList$(numExamps)
open lbExamples$ for append as #1
x = 0
[skipp]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipp]
lbExamplesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbExamplesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipp]
[lbbakfiles]
if fileExists(DefaultDir$, lbBakFiles$) <> 0 then kill DefaultDir$;"\"; lbBakFiles$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbBakFiles$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$;"\bak\", info$()
numExamps = val(info$(0, 0))
dim lbBakFilesList$(numExamps)
open lbBakFiles$ for append as #1
x = 0
[skipit]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = info$(x, 0)
if right$(filename$, 3) <> "bak" then [skipit]
lbBakFilesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbBakFilesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipit]
[mybackups]
if fileExists(DefaultDir$, MyBackups$) <> 0 then kill DefaultDir$;"\";MyBackups$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyBackups$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
gettingMybackupFiles = 1
dim folderInfo$(1, 1)
files DefaultDir$;"\";"BAS", folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim MyBackupsList$(numExamps)
a$=DefaultDir$;"\";categorie$
open DefaultDir$;"\";categorie$ for append as #1
x = 0
[skiphere]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skiphere]
MyBackupsList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = MyBackupsList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skiphere]
[folderChoice]
folderChoice$ = "folderChoice.txt"
if fileExists(DefaultDir$, folderChoice$) <> 0 then kill DefaultDir$;"\";folderChoice$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
caption$ = "Navigate to, and Select YOUR Liberty Basic (or Pro) Install Dir"
call browser (caption$)
if right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "No Folder Selected" : wait
if len(FolderDialog$) = 2 then notice "Drive ";left$(FolderDialog$, 2);" Selected - You MUST Select a Folder" : goto [folderChoice]
folderpath$ = FolderDialog$
#codeTank.value, "!cls"
categorie$ = folderChoice$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
redim folderInfo$(1, 1)
files folderpath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
redim folderList$(numExamps)
open folderChoice$ for append as #1
x = 0
[skipnow]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : categorie$ = anyFolder$ : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipnow]
folderList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = folderList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipnow]
[forumlink]
run "explorer.exe https://libertybasiccom.proboards.com/"
wait
'resize window font - sets all fonts equal
[incFont]
mainFontsize = mainFontsize + 1
#codeTank "font Arial ";mainFontsize
wait
[decFont]
mainFontsize = mainFontsize - 1
#codeTank "font Arial ";mainFontsize
wait
'create a project and tkn file and add it to the MyProjects List
[makeproject]
call saveValue
#codeTank.filePath "cls" : #codeTank.filePath "Creating Project ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
tkn = 2
if categorie$ <> MyProjects$ then tkn = 4
goto [defaultClick]
[remakeproject]
call saveValue
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
tempCat$=categorie$
if fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$,selectedKey$;".bas") = 0 then
notice "Cannot be Updated - Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Wasn't created using a File"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it using the SAME NAME.bas."+chr$(13)+"Select Radio Button My"+categorie$+chr$(13)+"Select Button [New "+left$(categorie$, len(categorie$)-1);" from File]"+chr$(13)_
+"Select the appropriate .bas file."+chr$(13)+" In Future it Will be Available for Updating"
#codeTank.keys "select 0"
#codeTank.value "!cls"
categorie$ = tempCat$
else
fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
end if
categorie$ = tempCat$
#codeTank.value "!contents? code$"
open fname$ for input as #1
code$ = input$(#1,lof(#1))
close #1
open DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" for output as #1
#1 code$
close #1
tkn = 4
if revert = 1 then fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
#codeTank.filePath "cls" : #codeTank.filePath "Updating ";fname$
if tkn = 4 then [makeTKN]
[defaultClick]
'Checking all paths and file locations for existence (dll's, sll's, lbasic.exe, and lbrun2.exe)
res=fileExists(LBpath$, LBexe$)
if res then a = a + 1 else notice LBexe$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,LBruntime$)
if res then a = a + 1 else notice LBrun$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";LBpath$;" Closing Program": goto [quit.codeTank]
' Use the filedialog function to allow user to select a source file (.bas)
[filediag]
'open file dialog to choose a .bas file for exe conversion, "*.bas;*.bak",.txt
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$, fname$
if fname$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$;" Creating tkn file for - ";fname$
[makeTKN]
call pleasewait : pleasewaitOpen = 1
#pleasewait.fake "!setfocus"
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
'finish separating filename from extension
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[begin]
'define Destpath1$ as LB Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";savedProjects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current created Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
res=pathExists(DestPathU$)
if res then a=a+1 else notice "savedProjects folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
if res then a=a+1 else notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
tknFolder$=DefaultDir$;"\";"TKN"
res=pathExists(tknFolder$)
if res then a=a+1 else notice "TKN Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
basFolder$=DefaultDir$;"\";"BAS"
res=pathExists(basFolder$)
if res then a=a+1 else notice "BAS Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
'copy selected bas file to Projects\current project folder
open fname$ for input as #1
data$ = input$(#1,lof(#1)) : close #1
open DestPath1$;"\";fname0$ for output as #2
#2 data$
close #2
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
if tkn = 4 then [tknOnly] 'bypass for Categorie Programs and Updates - tkn and bas file only needed
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
i = 0
while 1
i = i + 1
runtimeSupportFile$=word$(DllList$,i)
if runtimeSupportFile$ ="" then exit while
sourceFile$=LBpath$;"\";runtimeSupportFile$
destinationFile$=DestPath1$;"\";runtimeSupportFile$
'don't copy runtime files if they already exists
if fileExists(DestPath1$, runtimeSupportFile$) <> 0 then [fileExists]
open sourceFile$ for input as #file
open destinationFile$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[fileExists]
wend
'verify dll's and sll's were copied to new project folder
res=fileExists(DestPath1$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
'remove any left over existing lbrun2.exe from new project before creating new one
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, LBruntime$) <> 0 then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to Current Project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";fnamenobas$;".exe" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": goto [quit.codeTank]
[tknOnly]
call fixtime
call fixdate
'copy selected .bas file to BAS dir and date it
open DestPath1$;"\";fname0$ for input as #file
open DestPath$;"\BAS\";fixeddate$;fixedtime$;"-";fnamenobas$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'remove any existing tkn of same name in TKN dir
if fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then kill DestPath1$;"\";fnamenobas$;".tkn"
'write/run the script to close the "save" dialog, and the follow up "information" notice of creation automatically
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
RUN q$;LBpath$;"\";LBexe$;q$;" -T -A ";DestPath1$;"\";fname0$
'loop until TKN File is verified
while www = 0
if fileExists(DestPath1$,fnamenobas$;".tkn") <> 0 then exit while
scan
wend
call pause 2500
'copy TKN$ file to TKN dir, and date it
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fixeddate$;fixedtime$;"-";fnamenobas$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
if fileExists (DefaultDir$;"\TKN", fixeddate$;fixedtime$;"-";fnamenobas$;".tkn") = 0 then notice fixeddate$;fixedtime$;"-";fnamenobas$;".tkn";" was NOT created in ";DefaultDir$;"\TKN" : wait
[continueOn]
'check what tkn value =, and continue to create the 'new key'
if tkn = 2 or tkn = 4 then newKey$ = fnamenobas$
goto [continue]
[initiate]
global selectedKey$, lastKey$, categorie$, FolderDialog$, dictionary$, q$, codetankOpen, fixeddate$, fixedtime$, folder$, lastKey$
'global 'selectedKey$, fixeddate$, fixedtime$, project, fnamenobas$, DestPath$, DestPath1$, JBexe$,_
'LBpath$, keyCount, q$, lastKey$, selectedpath$, upath$, folder$, folderpath$
'First we need the users home path
CSIDL.PROFILE = 40
upath$ = GetSpecialFolder$(CSIDL.PROFILE)
if fileExists(DefaultDir$, "codetank.ini") then
open DefaultDir$;"\codetank.ini" for input as #1
line input #1, LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
goto [check]
end if
if fileExists(upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1", "freeform404.bas") then
uAppPath$ = upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1"
if fileExists(LBpath$, "lbpro.exe") then
LBexe$ = "lbpro.exe"
goto [check]
end if
end if
if fileExists(upath$;"\Application Data\Liberty Basic v4.5.1", "freeform450.bas") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic v4.5.1"
if fileExists(LBpath$, "liberty.exe") then
LBexe$ = "liberty.exe"
end if
end if
[check]
print LBpath$
print LBexe$
text$ = chr$(13)+" Liberty Basic v4.5.1 was not installed to the default Install folder."+chr$(13)+chr$(13)+"Would you like to Browse to and Select your Liberty Basic 4.5.1"+chr$(13)+"(or Pro)"+chr$(13)+"Install Folder"
'if Liberty Basic v4.5.1 is NOT installed to it's Default Install Dir, get Path from User using folder dialog
if fileExists(LBpath$, LBexe$) <> 0 then [start] else a$ = custcon$(text$)
if answer$ <> "Yes" then end
caption$ = "Navigate to, and Select YOUR Liberty Basic v4.5.1 (or Pro) Install Dir"
call browser, caption$
if right$(FolderDialog$, 1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "Liberty Basic v4.5.1 must be installed to continue" : end
LBpath$ = FolderDialog$
open "codetank.ini" for output as #1
#1 LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
return
sub pleasewait
WindowWidth = 150 : WindowHeight = 150
UpperLeftX=int((DisplayWidth-WindowWidth)/2)'-100
UpperLeftY=int((DisplayHeight-WindowHeight)/2)'-500
statictext #pleasewait.text, "Please Wait", 30, 20, 100, 20
statictext #pleasewait.text2, "This Can", 40, 50, 100, 20
statictext #pleasewait.text3, "Take a While", 25, 80, 100, 20
button #pleasewait.fake, "", [quit.pleasewait], ul, 0, 0, 0, 0
Open "untiltled" for dialog_popup as #pleasewait
#pleasewait "trapclose [quit.pleasewait]"
#pleasewait "font arial 12 bold"
pleasewaitOpen = 1
end sub
sub cleanup
' Delete .vbs files and temp .txt
if fileExists(DefaultDir$,"temp.txt") <> 0 then kill "temp.txt"
if fileExists(DefaultDir$, "FolderDialog.vbs") <> 0 then kill "FolderDialog.vbs"
if fileExists(DefaultDir$,"autoSave.vbs") <> 0 then kill DefaultDir$;"\";"autoSave.vbs"
end sub
sub writeAutoSave
global autoSave$
autoSave$ = "autoSave.vbs"
open autoSave$ for output as #1
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "Do While Not WshShell.AppActivate(";q$;"Save *.TKN File As...";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Do While Not WshShell.AppActivate(";q$;"Information";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(500)"
#1, "WshShell.AppActivate(";q$;"pleasewait";q$;")"
close #1
end sub
'function to retrieve Users Home Path (thanks to Brandon Parker)
Function GetSpecialFolder$(CSIDL)
S.OK = NULL
GetSpecialFolder$ = "Operation Failed"
pszPath$ = Space$(_MAX_PATH);chr$(0)
CallDLL #shell32, "SHGetFolderPathA", _NULL As ulong, _ 'hWnd is RESERVED
CSIDL As long, _ 'CSIDL value
_NULL As ulong, _ 'hToken is set to NULL to check the current token
0 As ulong, _ 'dwFlags is set to NULL to represent SHGFP_TYPE_CURRENT
pszPath$ As ptr, _ 'pszPath is where the path string will be stored upon return
ret As long
If (ret = S.OK) Then GetSpecialFolder$ = Trim$(pszPath$)
End Function
'edit date$() return for use in filenames
sub fixdate
fixDate$ = Date$() 'set up a date format that works with a filename(remove the /)
fix1$ =word$(fixDate$, 1, " ") ' = Month,
fix2$ = word$(fixDate$, 2, " ") ' = Month
fix2$ = left$(fix2$, len(fix2$)-1) ' = Number of day
fix3$ = word$(fixDate$, 3 ," ") ' = Year - 4 digits
fix3$ = right$(fix3$, 2) ' = Year - 2 digits
fixeddate$ = fix1$;"-";fix2$;"-";fix3$ ' = Month-NumberOfDay-Year
end sub
'edit Time$() return for use in filenames
sub fixtime
fixTime$ = Time$() 'set up a time format that works with a filename(remove the /)
fix1$ = word$(fixTime$, 1, ":")' - remove the "." 's
fix2$ = word$(fixTime$, 2 ,":")
fixedtime$ = "-";fix1$;"-";fix2$;"-"' ' add dashes -
end sub
sub resetRadioOptions
dictionary$ = "" : keyCount = 0 : lastKey$ = "" : selectedKey$ = ""
call readDictionary
call loadKeys
#codeTank.value, "!origin 0, 0 "
#codeTank.keys "select 0"
end sub
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
'function for checking folder existence
function pathExists(path$)
pathExists = (mkdir(path$)=183)
end function
[textEdMirror]
if textedMOpen = 1 then #textedM.edMirror "!setfocus" : wait
WindowWidth = DisplayWidth : WindowHeight = DisplayHeight
texteditor #textedM.edMirror, 20, 20, WindowWidth-40, WindowHeight-40
button #textedM..incFont, "&+", [incEdFont], UL, DisplayWidth/2, 0, 20, 23
button #textedM.decFont, "&-", [decEdFont], UL, DisplayWidth/2+25, 0, 20, 23
button #textedM.mirror, "&ScratchPad", [scratch], UL, DisplayWidth/2-200, 0, 140, 23
open "TextEditor Mirror" for Window as #textedM
#textedM "trapclose [quit.textedM]"
#codeTank.value "!contents? code$"
#textedM.edMirror code$
#textedM "Font Arial 12"
EdMirFont = 12
#textedM.edMirror, "!setfocus"
#textedM.edMirror "!origin 0 0"
textedMOpen = 1
if selectedKey$ = "" then [setCatScratch]
wait
[scratch]
#codeTank.savedprojects "reset"
#textedM.edMirror "!contents? code$"
#codeTank.value "!cls"
#codeTank.value code$
call saveValue
mir = 1 : gosub [deleteOrig]
mir = 0
[setCatScratch]
newKey$ = selectedKey$
if categorie$ = "" or selectedKey$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
call setValueByName newKey$, ""
call loadKeys
'#codeTank.keys "select "; newKey$
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
categorie$ = "ScratchPad"
selectedKey$ = "Scratch"
#textedM.edMirror "!cls"
#textedM.edMirror, "!setfocus"
#textedM.edMirror, "!origin 0 0"
wait
[incEdFont]
EdMirFont = EdMirFont + 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[decEdFont]
EdMirFont = EdMirFont - 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[quit.pleasewait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[quit.textedM]
call saveValue
#textedM.edMirror "!contents? code$"
close #textedM : textedMOpen = 0
#codeTank.value "!cls"
#codeTank.value code$
#codeTank.value "!origin 0 0"
mir = 1 : gosub [deleteOrig]
mir = 0
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'quit program
[quit.codeTank]
if textedMOpen = 1 then
text$ = "Quiting will close the Editor Mirror"+chr$(13)+chr$(13)
text$ = text$+"Quit Anyway?"+chr$(13)
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
end if
call saveValue
call cleanup
if textedMOpen = 1 then close #textedM : textedMOpen = 0
if pleasewaitOpen = 1 then close #pleasewait : pleasewait = 0
if codetankOpen = 1 then close #codeTank : codetankOpen = 0
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
end
'sub to create pauses in program
sub pause mil
t=time$("ms")+mil
while time$("ms")<t
scan
wend
end sub
'sub to save current Dictionary Listings and text in texeditor
sub saveValue 'if the value is changed, save it
if lastKey$ <> "" then
#codeTank.value "!modified? modified$";
if modified$ = "true" then
#codeTank.value "!contents? saveThisValue$";
call setValueByName lastKey$, saveThisValue$
call collectGarbage
call writeDictionary
end if
end if
end sub
'function to get selected Listing
function getKeys$(delimiter$)
global keyCount
pointer = 1
while pointer <> 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
getKeys$ = getKeys$ + key$ + delimiter$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$
keyCount = keyCount + 1
end if
end if
wend
end function
'sub to write each Listing to corresponding file
sub writeDictionary
if categorie$ = "" then categorie$ = "ScratchPad"
open DefaultDir$;"\";categorie$ for output as #writeDict
#writeDict, dictionary$
close #writeDict
end sub
'sub to read each Listing from corresponding file
sub readDictionary
if categorie$ = "" then
categorie$ = "ScratchPad"
open categorie$ for output as #1
close #1
end if
if fileExists(DefaultDir$, categorie$) <> 0 then
open categorie$ for input as #readDict
length = lof(#readDict)
dictionary$ = input$(#readDict, length)
close #readDict
else
end if
end sub
'sub to cleanup any mess in the dictionary text
sub collectGarbage
pointer = 1
while pointer > 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
value$ = getValue$(key$)
newDictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) + value$ + newDictionary$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
end if
end if
wend
dictionary$ = newDictionary$
end sub
sub setValueByName key$, value$
dictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134);key$;chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)+value$+dictionary$
end sub
'function to get info from selected Listing
function getValue$(key$)
getValue$ = chr$(0)
keyPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+key$+chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134))
if keyPosition > 0 then
keyPosition = keyPosition + 9 'skip over key tag
valuePosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), keyPosition)
if valuePosition > 0 then
valuePosition = valuePosition + 11 'skip over value tag
endPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), valuePosition)
if endPosition > 0 then
getValue$ = mid$(dictionary$, valuePosition, endPosition - valuePosition)
else
getValue$ = mid$(dictionary$, valuePosition)
end if
end if
end if
end function
'sub to load selected categorie List
sub loadKeys
keyList$ = getKeys$(chr$(134);chr$(165);chr$(134))
redim keys$(keyCount)
for item = 1 to keyCount
keys$(item-1) = word$(keyList$, item, chr$(134);chr$(165);chr$(134))
next item
sort keys$(), 0, keyCount
#codeTank.keys "reload"
keyCount = 0
end sub
'function to separate filename from full path to file
function GetFilename$(fileName$)
i = len(fileName$)
while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
i = i-1
wend
GetFilename$ = mid$(fileName$, i+1)
end function
'function to delete entire folder (including sub folders and files)
function delete$(folder$)
run "cmd.exe /c rd /s /q ";q$;folder$;q$, HIDE
end function
'function makes customized confirmation window
function custcon$(text$)
global text$, customconfirmOpen, a$, answer$, fault
WindowWidth = 540 : WindowHeight = 300
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
statictext #customconfirm.header "Notice to User", 190, 10, 130, 30
statictext #customconfirm.text text$, 40, 60, 490, 120
button #customconfirm.default "&OK", [confirmYes], ul, 220, 200, 80, 35
button #customconfirm.yes "&Yes", [confirmYes], ul, 100, 200, 120, 35
button #customconfirm.no "&No", [confirmNo], ul, 320, 200, 120, 35
open "Confirmation Required" for dialog_modal as #customconfirm
#customconfirm "trapclose [confirmNo]"
#customconfirm "font arial 12"
customconfirmOpen = 1
#customconfirm.default "!hide"
wait
[confirmNo]
answer$ = "No"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
goto [endFunction]
[confirmYes]
answer$ = "Yes"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
[endFunction]
end function
FUNCTION FN.Screen(BYREF Szx, BYREF Szy)
Szx = DisplayWidth
Szy = DisplayHeight
FN.Display = Szx * Szy
END FUNCTION
FUNCTION FN.PercentScreen(PercentX, PercentY, BYREF Szx, BYREF Szy)
Szx = INT(DisplayWidth * PercentX)
Szy = INT(DisplayHeight * PercentY)
FN.PercentScreen = Szx * Szy
END FUNCTION
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5)
Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy
END FUNCTION
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX
UpperLeftY = PosY
FN.SetWinPos = PosX * PosY
END FUNCTION
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx
WindowHeight = Szy
FN.SetWinSize = Szx * Szy
END FUNCTION
sub resized handle$
'print handle$, WindowWidth, WindowHeight
TxbUx = 100 '<--- location and size of text box
TxbUy = 2
Txbsx = 685
Txbsy = 22
Txbsx = WindowWidth - TxbUx - 20 '<--- resize text box
#codeTank.filePath, "!LOCATE ";TxbUx;" ";TxbUy;" ";Txbsx+15;" ";Txbsy
#codeTank.keys, "LOCATE ";100;" ";25;" ";340;" ";WindowHeight-600+60+370
#codeTank, "REFRESH"
end sub
'sub to make folder dialog window
sub browser caption$
dim info$(0, 0)
dim folderInfo$(0, 0)
' fs = 10
WindowWidth = 700
WindowHeight = 500'670
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
gosub [FolderDlgGetDrives]
statictext #folderdlg.selection, "Selection >> ", 40, 505, 95, 15
statictext #folderdlg.caption, caption$, 150, 20, 525, 35
listbox #folderdlg.filelist, fileList$(, [fileSelect], 350, 50, 320, 310
listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 15, 50, 320, 310
button #folderdlg.default, "OK", [FolderDlgOk], UL, 220, 410, 75, 25
button #folderdlg.back, "< < <", [FolderDlgBack], UL, 10, 10, 60, 30
button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 395, 410, 75, 25
button #folderdlg.plusfont, "+", [plusFont], UL, 75, 10, 30, 30
button #folderdlg.minusfont, "-", [minusFont], UL, 110, 10, 30, 30
textbox #folderdlg.text, 15, 360, 655, 25
BackgroundColor$ = "lightgray"
open "Just Basic File Browser" for dialog_modal as #folderdlg
#folderdlg, "trapclose [FolderDlgCancel]"
#folderdlg.text, "Selected (Drive \ Folder \ File) Path Appears Here"
#folderdlg, "font Arial 12 bold"
#folderdlg.filelist, "singleclickselect"
#folderdlg.list, "singleclickselect"
fontsize = 12
wait
[minusFont]
fontsize = fontsize - 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[plusFont]
fontsize = fontsize + 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[FolderDlgSelect]
#folderdlg.list, "selection? temp$"
if temp$ <> "" then
level = level+1
folder$ = folder$; temp$; "\"
#folderdlg.text, folder$
gosub [FolderDlgGetDir]
#folderdlg.list, "reload"
#folderdlg.list, "select 0"
#folderdlg.default "!setfocus"
end if
wait
[FolderDlgBack]
if level > 0 then
level = level-1
if level = 0 then
folder$ = ""
gosub [FolderDlgGetDrives]
else
i = len(folder$)-1
while mid$(folder$, i, 1) <> "\" and mid$(folder$, i, 1) <> ""
i = i-1
wend
folder$ = left$(folder$, i)
gosub [FolderDlgGetDir]
end if
#folderdlg.text, folder$
fileList$(0) = " F I L E S"
#folderdlg.list, "reload"
#folderdlg.filelist, "reload"
end if
wait
[FolderDlgGetDrives]
c = 1
while word$(Drives$, c) <> ""
c = c+1
wend
redim FolderList$(c)
FolderList$(0) = " D R I V E S"
for i = 1 to c
FolderList$(i) = word$(Drives$, i)
next i
redim fileList$(0)
return
[FolderDlgGetDir]
files folder$, info$(
s = val(info$(0,0))
t = val(info$(0,1))
redim FolderList$(t)
FolderList$(0) = " F O L D E R S"
for i = 1 to t
FolderList$(i) = info$(i+s, 1)
next i
[filesBack]
files folder$, "*.*", folderInfo$()
numFiles = val(folderInfo$(0, 0))
redim fileList$(numFiles)
for x = 1 to numFiles
filename$ = folderInfo$(x, 0)
fileList$(x) = filename$
next x
fileList$(0) = " F I L E S"
sort fileList$(), 0 , numFiles
#folderdlg.filelist, "reload"
return
[fileSelect]
#folderdlg.filelist "selection? file$"
#folderdlg.text, folder$;file$
wait
[FolderDlgOk]
#folderdlg.text, "!contents? FolderDialog$"
If right$(FolderDialog$,1) = "\" then
if right$(FolderDialog$, 2) = ":\" then [goAround]
FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1)
else
[goAround]
notice "The Selection was Not a Folder" : close #folderdlg : wait
end if
[FolderDlgCancel]
close #folderdlg
end sub
'
Updated code will be posted at Code-Share
