Post by xxgeek on Jul 12, 2021 19:24:01 GMT
It works on my Win 10 Pro, but no way for me to test it in other OS's
Place in it's own folder , since it makes a couple of temp files, and NOW creates an EXE dir for the exe files.
Can add password to the exe file.
The 32bit, and 64bit does make an exe file, but whether or not they are actually 32bit or 64 I don't know until I getr feedback from those who run differrent versions of windows
'BAS2EXE Version v1.4
'Date = July 2021
'Title - BAS2EXE
'Author - xxgeek, a member of the justbasiccom.proboards.com/ forums
'Purpose - To automate bas file to exe file (self extracting exe) creation
'Place this bas file in it's own folder as it will create some files, and folders
'Choose 32bit exe or 64 bit exe - defaults to 64 bit if no selection made
'Option to password the EXE file.
' Then bas2exe opens a filedialog to choose a bas file
'choose a bas file that is a good working bas file (or there will be trouble with the debugger)
'hit [ENTER]
'Save tkn window and info dialog close automaticlly and save the tkn file to where it is needed.
'The next window is a Prompt to keep the project folder - or not
' If you keep the project folder you will have a "projects" folder with each saved project which
'includes the dll, sll files and jbrun2.exe(renamed), and the tkn file.
'The EXE File is saved to the EXE folder in the same folder as this program is located.
' Next Window to choose to Run the EXE or choose to view the EXE Files Created by this Program
'
'Note - For standalone bas files only with no dependent files or folders - at this time
'If it runs in the IDE the EXE will be made. If there are programming runtime errors your EXE
'could still crash at some point (Not BAS2EXE's fault)
'IMPORTANT INFORMATION
'To make an EXE of THIS BAS file, make a copy of it, and select that copy when you run THIS BAS file.
'Keep in mind that when you make an exe of THIS bas file and run the exe it will put the exe file
'in the same folder it is run from. That means it is running from YOUR temp folder in a folder
'named IXP000.TMP This temp folder is where it also unpacks the dll's,sll's, the renamed jbrun file
'the tkn file, and the EXE file created (Only when you run the EXE you create of THIS bas file or a copy)
'To keep the exe file created using the exe you create with this bas file you MUST click the
'View EXE button, and then copy and save it before closing or it get's deleted from the temp folder
'Again, the temp folder is where YOUR Windows Temp files are located in a folder named
'IXP000.tmp (or very similar, like IXP001.tmp etc)
'OR
'Better off using JB>Run>Make TKN and then add the tkn to the EXTERNAL PROGRAMS
' under Setup>Externals in JB IDE. That way there's no need to deal with the temp dir BS
'The EXE Folder, and Projects Folder will be in the same dir as the tkn file is run from.
'Don't put the tkn in a folder protected by Windows security.
'Enjoy
titlebar$ = "BAS2EXE v1.2"
'[checkjbpath]
'check Just Basic v2.0 Default Install Dir for existence
JBpath$ = "c:\Program Files (x86)\Just Basic v2.0"
res=pathExists(JBpath$)
'if Just Basic v2.0 is NOT installed to it's Default Install Dir, get Path from User
if res then [go] else notice " Just Basic v2.0 was not installed to the default install folder."+chr$(13)+"Hit [ok], then Select the Folder Just Basic v2.0 is Installed"
JBpath$ = FolderDialog$("Select the Folder Where You Installed JB - Named Just Basic v2.0")
if JBpath$ = "" then notice "No path given - closing BAS2EXE" : end
[go]
' setup a Window for User to Select a .bas File to Make a Project with
nomainwin
WindowWidth = 600
WindowHeight = 320
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
'add some text ,some buttons, and a menu to the Window
statictext #pick.header, "BAS <2> EXE", 190, 30, 590, 45
checkbox #pick.password, "Password this EXE File", [yespass], [nopass], 200, 170, 160, 20
checkbox #pick.bit32, "Make 32 bit EXE", [bit32], [nobit32], 120, 140, 160, 20
checkbox #pick.bit64, "Make 64bit EXE", [bit64], [nobit64], 290, 140, 160, 20
statictext #pick.info, "Select a working Just Basic Source Code File (.bas)", 30, 95, 590, 40
statictext #pick.jbforums, "Visit the Just Basic Forums @ https://justbasiccom.proboards.com/", 125, 270, 590, 20
button #pick.default, "Select File", [defaultClick],UL 140, 215, 135, 35
button #pick.32, "Cancel", [cancel],UL 320, 215, 135, 35
'open the Window, and set some Fonts for each statictext, and buttons
open "BAS2EXE v1.2" for window_nf as #pick
#pick, "trapclose [quit.pick]"
#pick, "font Arial 10 bold"
#pick.header, "!font Arial 24 bold"
#pick.password, "font Arial 12 bold"
#pick.info, "!font Arial 16 bold"
#pick.jbforums "!font Arial 8 bold"
#pick.32, "!font Arial 12 bold"
#pick.bit64, "font Arial 12 bold"
#pick.bit32, "font Arial 12 bold"
#pick.default, "!font Arial 12 bold"
#pick.default, "!setfocus"
wait
[yespass]
p=1
wait
[nopass]
p=0
wait
[bit32]
bit=32
#pick.bit64, "hide"
wait
[bit64]
bit=64
#pick.bit32, "hide"
wait
[nobit32]
bit=0
#pick.bit64, "show"
wait
[nobit64]
bit=0
#pick.bit32, "show"
wait
[defaultClick]
close #pick
'check existence and JBPath$
res=pathExists(JBpath$)
if res then a = a + 1 else notice " Just Basic v2.0 was not was not found in ";JBpath$;" Restart BAS2EXE - Try Again":end
' Just Basic 2 is installed - continue on
'define some variables
p=0 'passorded exe = false
JBexe$ = "jbasic.exe"
JBruntime$ = "jbrun2.exe"
DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
projects$ = "projects"
'Checking all paths and file locations for existence (dll's, sll's, jbasic.exe, and jbrun2.exe)
res=fileExists(JBpath$,JBexe$)
if res then a = a + 1 else notice JBexe$;" Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,JBruntime$)
if res then a = a + 1 else notice JBrun$;" Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";JBpath$;" Closing BAS2EXE" : end
res=fileExists(JBpath$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";JBpath$;" BAS2EXE" : end
res=fileExists(JBpath$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";JBpath$;" BAS2EXE" : end
res=fileExists(JBpath$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";JBpath$;" BAS2EXE" : end
res=fileExists(JBpath$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";JBpath$;" Closing BAS2EXE":end
' all needed files accounted for
' Use the filedialog function to allow user to select a source file (.bas)
'prompt user for a password to start the created EXE File
if p=0 then [filediag]
if p= 1 then Prompt "TYPE PASSWORD for EXE File"+chr$(13)+"(no spaces)";passwerd$
'if passwerd$ = "" then wait
[filediag]
'open file dialog to choose a .bas file for exe conversion
filedialog "Open \ Select a Just Basic Source File (.bas) ", DefaultDir$; "\*.bas", fname$
if fname$ = "" then notice "No file selected, BAS2EXE will now close" : end
'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)
'remove any spaces from filename
dim s$(250)
for x = len(fname0$) to 1 step -1
s$(x) = mid$(fname0$,x, 1)
s$=s$(x)
if s$ <> " " then s2$ = s$;s2$
s$=s2$
next x
fname0$ = s$
'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
'delete temporay file used for saving fname0 while removing spaces in filename
[begin]
DestPath$=DefaultDir$
DestPathU$ = DestPath$;"\";projects$
'define Destpath1$ as JB Projects\Current Project Folder
DestPath1$=DestPathU$;"\";fnamenobas$
'Make Folders for Just Basic Projects and Current ProjectName
res = mkdir(DestPathU$)
res = mkdir( DestPath1$)
res =mkdir(DefaultDir$;"\";"EXE")
'make sure Folders were actually created
res=pathExists(DestPathU$)
if res then a = a + 1 else notice "Just Basic Projects folder was NOT Created in ";DestPath$:close #main : end
res=pathExists(DestPath1$)
if res then a = a + 1 else notice "New Folder";fnamenobas$;" was NOT Created in ";DestPath1$:close #main : end
if fileExists(DestPath1$, fname0$) then kill DestPath1$;"\";fname0$
'Copy the needed DLL and SLL files from Just Basic dir to projects\projectname Dir
w$ = ""
i = 0
while 1
i = i + 1
w$=word$(DllList$,i)
if w$="" then exit while
from$=JBpath$;"\";w$
to$=DestPath1$;"\";w$
if fileExists(DestPath1$,w$) then kill DestPath1$;"\";w$
open from$ for input as #file
open to$ for output as #1
print #1, input$(#file, lof(#file));
close #file
close #1
wend
'verify dll's sll's and 'jbrun2.exe' were copied to temp folder, and jbrun2.exe renamed
if res then a = a + 1 else notice " jbrun2.exe Does not exist on the given path -> ";JBpath$;"\";JBruntime$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end
res=fileExists(DestPath1$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end
if fileExists(DestPath1$, JBruntime$) then kill DestPath1$;"\"; JBruntime$
'copy jbrun2.exe to Temporary Folder
open JBpath$;"\";JBruntime$ for input as #file
open DestPath1$;"\";JBruntime$ for output as #1
print #1, input$(#file, lof(#file));
close #file
close #1
'Just Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, fnamenobas$ + ".exe") then kill DestPath1$;"\";fnamenobas$ + ".exe"
'rename jbrun2.exe to name of User Selected .bas File - .bas +.exe
name DestPath1$;"\";JBruntime$ as DestPath1$;"\";fnamenobas$ + ".exe"
'copy the project .bas file to this projects dir
q$= chr$(34)
open fname$ for input as #fname
fnameTemp$="tempBas.bas"
open fnameTemp$ for output as #2
'add a password prompt to the begining of the temp bas file(to be added to the exe)
if p=0 then [nopasswerd]
print #2, "prompt ";q$;"Enter the Password";q$;";";"passwerd$"
print #2, "if passwerd$ <> ";q$;passwerd$;q$;" then end"
[nopasswerd]
print #2, input$(#fname, lof(#fname));
close #fname
close #2
'make a temp.bas file
open fnameTemp$ for input as #fnameTemp
open DestPath1$;"\";fname0$ for output as #1
print #1, input$(#fnameTemp, lof(#fnameTemp));
close #1
close #fnameTemp
'check if the current project .bas file was copied to new dir
res=fileExists(DestPath1$,fname0$)
if res then a = a + 1 else notice fname0$; " Was not copied to ";DestPath1$;" P.O. will now close" : close #main : end
'check for tkn existence, delete if true
res=fileExists(DestPath$,fnamenobas$;".tkn")
if res then kill DestPath$;"\";fnamenobas$;".tkn"
'#######################################################################
[makeSed]
q$=chr$(34) ' quotes to be printed around files and paths in sed file text"
sedfile$=fnamenobas$;".sed"
open sedfile$ for output as #sed
#sed "[Version]"
#sed "Class=IEXPRESS"
#sed "SEDVersion=3"
#sed "[Options]"
#sed "PackagePurpose=InstallApp"
#sed "ShowInstallProgramWindow=1"
#sed "HideExtractAnimation=1"
#sed "UseLongFileName=1"
#sed "InsideCompressed=0"
#sed "CAB_FixedSize=0"
#sed "CAB_ResvCodeSigning=0"
#sed "RebootMode=N"
#sed "InstallPrompt=%InstallPrompt%"
#sed "DisplayLicense=%DisplayLicense%"
#sed "FinishMessage=%FinishMessage%"
#sed "TargetName=%TargetName%"
#sed "FriendlyName=%FriendlyName%"
#sed "AppLaunched=%AppLaunched%"
#sed "PostInstallCmd=%PostInstallCmd%"
#sed "AdminQuietInstCmd=%AdminQuietInstCmd%"
#sed "UserQuietInstCmd=%UserQuietInstCmd%"
#sed "SourceFiles=SourceFiles"
#sed "[Strings]"
#sed "InstallPrompt="
#sed "DisplayLicense="
#sed "FinishMessage="
exe$=fnamenobas$;".exe"
#sed "TargetName=";q$;DefaultDir$;"\EXE\";exe$;q$
#sed "FriendlyName=";q$;fnamenobas$;q$
#sed "AppLaunched=";q$;exe$;q$
#sed "PostInstallCmd=<None>"
#sed "AdminQuietInstCmd="
#sed "UserQuietInstCmd="
#sed "FILE0=";q$;exe$;q$
sedtkn$=fnamenobas$;".tkn"
#sed "FILE1=";q$;sedtkn$;q$
sll1$="vbas31w.sll"
sll2$="vgui31w.sll"
sll3$="voflr31w.sll"
dll1$="vthk31w.dll"
dll2$="vtk1631w.dll"
dll3$="vtk3231w.dll"
dll4$="vvm31w.dll"
dll5$="vvmt31w.dll"
#sed "FILE2=";q$;sll1$;q$
#sed "FILE3=";q$;sll2$;q$
#sed "FILE4=";q$;sll3$;q$
#sed "FILE5=";q$;dll1$;q$
#sed "FILE6=";q$;dll2$;q$
#sed "FILE7=";q$;dll3$;q$
#sed "FILE8=";q$;dll4$;q$
#sed "FILE9=";q$;dll5$;q$
#sed "[SourceFiles]"
#sed "SourceFiles0=";q$;DestPath1$;q$
#sed "[SourceFiles0]"
#sed "%FILE0%="
#sed "%FILE1%="
#sed "%FILE2%="
#sed "%FILE3%="
#sed "%FILE4%="
#sed "%FILE5%="
#sed "%FILE6%="
#sed "%FILE7%="
#sed "%FILE8%="
#sed "%FILE9%="
close #sed
'#######################################################################
'Create the TKN file.
RUN JBpath$;"\";JBexe$;" -T -A ";DestPath1$;"\";fname0$
'give time for the save TKN window to appear
for x = 1 to 800000
next x
'#######################################################################
'Write script to a .vbs file (Visual Basic Script)
open "autoSave.vbs" for output as #1
print #1, "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "WshShell.AppActivate ";q$;"Save *.TKN File As...";q$
'#1, "Wscript.Sleep(200)" - keeping for testing
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(800)"
#1, "WshShell.AppActivate ";q$;"saved as";q$
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
close #1
'#######################################################################
run "cscript /nologo ";"autoSave.vbs" '- nologo helps a little to hide script window
'#######################################################################
'loop until TKN File is verified saved
do
res = fileExists(DestPath1$,fnamenobas$;".tkn")
if res then exit do
scan
loop until res
'check new exe (renamed jbrun2.exe) and tkn files for existence in Temp Folder )
res=fileExists(DestPath1$,fnamenobas$;".exe")
if res then a=a+1 else notice "jbrun2.exe not copied or renamed - EXITING ": end
'Check if iexpress.exe is installed (a built in Windows Install Maker = Self Extracting exe File)
[makeinst]
res=fileExists("c:\windows\system32","iexpress.exe")
if res then [makeexe] else notice "Cannot find file --> iexpress.exe in c:\windows\system32"+chr$(13)+"Known issue for users of WINE in Linux"+chr$(13)+"Check WINE Tricks for Adding IExpress(after each update)"
wait
[makeexe]
'loop till tkn is verified
do
x=x+1
if x = 50 then exit do '- if it takes too long exit loop, maybe stuck so exit to delete temp files and dir
res = fileExists(DestPath1$,fnamenobas$;".tkn")
if res then exit do
scan
loop until res
'makes 64 bit exe
if bit=32 then [do32bit]
'run iexpress commandline using the sed file created (sort of like an ini file)
express64$ = "c:\Windows\System32"
res=fileExists(express64$,"iexpress.exe")
if res then run "iexpress /N /q ";sedfile$ else noiex=1 : goto [noiex]
'makes 32 bit exe
[do32bit]
if bit <>32 then [verifyEXE]
express32$ = "c:\Windows\SysWOW64"
res=fileExists(express32$,"iexpress.exe")
if res then run "iexpress /N /q ";sedfile$ else noiex=1 : goto [noiex]
'slight delay
for x = 1 to 5000
next x
[verifyEXE]
'verify the exe file was created loop until it exists
exefile$=fnamenobas$;".exe"
do
res = fileExists(DestPath$;"\EXE",exefile$)
if res then exit do
scan
loop until res
[noiex]
'delete .sed .vbs and .bas temp files
res=fileExists(DefaultDir$,sedfile$)
if res then kill sedfile$
res=fileExists(DefaultDir$,autoSave$)
if res then kill autoSave$
res=fileExists(DefaultDir$,fnameTemp$)
if res then kill fnameTemp$
res=fileExists(DefaultDir$,"temp.txt")
if res then kill "temp.txt"
if noiex=1 then [remdir]
'choice for user to keep or delete the temp files(saved projects folder)
confirm exefile$+" was created in"+chr$(13)+DestPath$+chr$(13) +chr$(13)+"Would you like to keep the Project Folder ";choice$
if choice$="no" then [remdir]
if choice$ <> "no" then [main]
'delete all the temp files (copied bas file, tkn file, sll,dll, jbrun2.exe(renamed file) and the sed file
[remdir]
kill DestPath1$;"\";"vbas31w.sll"
kill DestPath1$;"\";"vgui31w.sll"
kill DestPath1$;"\";"voflr31w.sll"
kill DestPath1$;"\";"vthk31w.dll"
kill DestPath1$;"\";"vtk1631w.dll"
kill DestPath1$;"\";"vtk3231w.dll"
kill DestPath1$;"\";"vvm31w.dll"
kill DestPath1$;"\";"vvmt31w.dll"
kill DestPath1$;"\";exe$
kill DestPath1$;"\";sedtkn$
kill DestPath1$;"\";fname0$
'delete the temp dir's
dirname$=DestPath$;"\";projects$;"\";fnamenobas$
dirname2$=DestPath$;"\";projects$
deldir = rmdir(dirname$)
deldir2=rmdir(dirname2$)
if noiex=1 then [quit.pick]
'create a window with 2 buttons for options to view or run the new exe file.
[main]
nomainwin
WindowWidth = 400
WindowHeight = 320
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
statictext #main.jbforums, "Visit https://justbasiccom.proboards.com/", 70, 240, 450, 35
button #main.browseN, "View EXE Files", [browseN],UL 120, 100, 150, 35
button #main.run, "Run EXE File", [progrun],UL 120, 160, 150, 35
'Set Font's for this window, statictext, and buttons
open "Two Options" for window_nf as #main
#main, "trapclose [quit.main]"
#main, "font Arial 10 bold"
#main.browseN, "!font Arial 12 bold"
#main.run, "!font Arial 12 bold"
wait
'open Windows explorer to the EXE Files
[browseN]
run "explorer.exe ";DestPath$;"\EXE"
wait
'Run the created exe file
[progrun]
newfile$=fnamenobas$;".exe"
res=fileExists(DestPath$;"\EXE",newfile$)
if res then run DestPath$;"\EXE\";newfile$ else notice newfile$;" Does Not Exist in ";DestPath$;"\EXE"
wait
[quit.main]
close #main
end
[quit.pick]
close #pick
end
[cancel]
close #pick
end
'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
'functions for making the folder dialog window
function FolderDialog$(caption$)
WindowWidth = 600
WindowHeight = 370
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
gosub [FolderDlgGetDrives]
statictext #folderdlg.S, "Note: - Only Drives and Folders Appear Below - No Files Appear", 45, 15, 550, 25
statictext #folderdlg.S, "Select a Drive or a Folder From the List", 175, 40, 300, 25
statictext #folderdlg.D, " (Double Click Drive Letters and Folders to Select or Navigate)", 85, 70, 395, 15
listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 22, 90, 550, 130
button #folderdlg.default, "Ok", [FolderDlgOk], UL, 190, 293, 85, 35
button #folderdlg.B, "Back", [FolderDlgBack], UL, 490, 45, 80, 30
button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 290, 293, 85, 35
textbox #folderdlg.text, 42, 225, 510, 30
statictext #folderdlg.path, "Selected Drive or Folder Path Appears Here", 130, 258, 400, 20
open caption$ for dialog_modal as #folderdlg
#folderdlg, "trapclose [FolderDlgCancel]"
#folderdlg.default, "!font Arial 10 bold"
#folderdlg, "font Arial 10 bold"
#folderdlg.S, "!font Arial 10 bold"
#folderdlg.path, "!font Arial 10 bold"
#folderdlg.list, "font Arial 10 bold"
#folderdlg.C, "!font Arial 10 bold"
#folderdlg.D, "!font Arial 8 bold"
#folderdlg.text, "!font Arial 10 bold"
wait
[FolderDlgSelect]
#folderdlg.list, "selection? temp$"
if temp$ <> "" then
level = level+1
folder$ = folder$; temp$; "\"
#folderdlg.text, folder$
gosub [FolderDlgGetDir]
#folderdlg.list, "reload"
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$
#folderdlg.list, "reload"
end if
wait
[FolderDlgGetDrives]
c = 1
while word$(Drives$, c) <> ""
c = c+1
wend
redim FolderList$(c)
for i = 1 to c
FolderList$(i) = word$(Drives$, i)
next i
return
[FolderDlgGetDir]
files folder$, info$(
s = val(info$(0,0))
t = val(info$(0,1))
redim FolderList$(t)
for i = 1 to t
FolderList$(i) = info$(i+s, 1)
next i
return
[FolderDlgOk]
#folderdlg.text, "!contents? FolderDialog$"
If right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1)
[FolderDlgCancel]
close #folderdlg
end function
You might have to twist the meaning of virus to apply it to what you can do with Just BASIC.