|
Post by xxgeek on Aug 28, 2023 11:01:02 GMT -5
Final Version Posted
-fixed a problem where if a user were to close the main window(#codeTank) before the mirror editor(#textEdM) it crashed.
- fixed an issue where if a user were to try to open another mirror(#textEdM) it would crash.
- changed RUNing of LB Examples to RUN the original file, and not a copy to ensure any support files are available in the same dir. When editing a LB Example it will still be a copy for LB file integrity sake.
- changed the FolderDialog to a 'dialog_modal' window from a 'window'
This will be the final version unless other issues are reported, or found here.
Thanks goes to everyone who helped with CodeTank.
'CodeTank v1.5.0 - 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.5.0" 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 window 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 '
|
|