MultiFile Select Dialog

[xxgeek]

Edit - Rewrote the program, now it works without restrictions

This program allows for multifile selection in Just Basic v2.0
It will copy the files to a folder YOU select.

Make sure you select the files, before you select the destination folder
Don't copy shortcuts, if they point to files outside the selected source folder
If you select a folder by mistake, it will be ignored, don't worry, be happy

You just have to wait for the message stating files were copied for now.
When I get back at it I'll make a progress bar linked to the total file size(s)

Edit
This program runs a script that calls Powershell to do some work.
If you get a "isnot empty" error it usually means powershell didn't close on the last run, and something went wrong.
The powershell window is minimized (out of view) check your taskbar, and shut it down manually before running this program again.


-- MultiFie Select Dialog For Just Basic v2.0

'Title = MultiFileSelector Dialog
'Author = xxgeek, a member of the Just Basic Forums @ justbasiccom.proboards.com/
'Purpose =  to create a multifile selector dialog for Just Basic v2.0

' Cannot copy shortcuts since they point to files outside the selected files folder(Try again feature if you forget)
'Make sure you select files before selecting a destination folder

'Please report any other problems to xxgeek at justbasiccom.proboards.com/

[begin]
'don't show the mainwin text window
nomainwin

'for access to variables that are used in functions 'and' in the code outside functions
global selectedpath$, q$

'double quotes used when writing text to a file with enclosed quotes in the text
q$ = chr$(34)

'delete any pre-existing temp files from past use of this program
res = fileExists(DefaultDir$, "copylist.txt")
 if res then kill "copylist.txt"
res = fileExists(DefaultDir$, "MultiFile.vbs")
 if res then kill "MultiFile.vbs"
res = fileExists(DefaultDir$, "FolderPath.txt")
 if res then kill "FolderPath.txt"
res = fileExists(DefaultDir$, "FolderDialog.vbs")
 if res then kill "FolderDialog.vbs"

'get destination folder from user
Multi$ = getMultiFiles$(Multi$)

'get the path for Destination folder from user
a$ = getDest$(a$)

'get the list of user selected files to be copied from copylist.txt
dim multilines$(3000)
open "copylist.txt" for input as #1
while eof(#1) = 0
   x = x + 1
    line input #1, multilines$(x)
     line$ = multilines$(x)
wend
close #1

'copy the files in the list to the user selected destination folder
for z = 1 to x - 1
  linex$ = multilines$(z)
  'open linex$ for input as #3
  fileName$ = GetFilename$(linex$)
  'print "fileName$ = ";fileName$ 'LEFT IN FOR TESTING
  'print "selectedpath$ = ";selectedpath$ 'LEFT IN FOR TESTING
  dest$ = selectedpath$;"\";fileName$
     'print "dest$ = ";dest$ 'LEFT IN FOR TESTING

'sub to create vbs script for file copying
  gosub [filecopier]

'verify each file before continuing
   do
    res = fileExists(selectedpath$,fileName$)
     if res then exit do
      scan
   loop until res
next z

'Notify user - program finished
message$ = chr$(13)+"  Selected Files Should now be in  "+chr$(13)+"  ";selectedpath$
message$ = GetMessage$(message$)

'end this program
end

'write file copier script
[filecopier]
  filecopier$ = "filecopier.vbs"
open filecopier$ for output as #copy
 #copy, "Dim objFso, strSourcePath, strDestPath"
 #copy, "strSourcePath = ";q$;linex$;q$
 #copy, "strDestPath = ";q$;dest$;q$
 #copy, "Set objFso = CreateObject(";q$;"Scripting.FileSystemObject";q$;")"
 #copy, "If objFso.FileExists(strSourcePath) then"
 #copy, "objFso.CopyFile strSourcePath, strDestPath, True"
 #copy, "End If"
 #copy, "Set objFso = Nothing"
close #copy

'verify script was written
do
 res = fileExists(DefaultDir$, filecopier$)
  if res then exit do
  scan
loop until res

'run the file copier script
 run "wscript ";filecopier$

'verify the file was copied to the selected destination folder
do
res = fileExists(selectedpath$, linex$)
 if res then exit do
  scan
 loop until res
return

'function to get filename from path
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 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 to make message windows
function GetMessage$(message$)
   WindowWidth = 300 :  WindowHeight = 120
   UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
   UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
   BackgroundColor$ = "lightgray" : ForegroundColor$ = "black"
   statictext #textmessage.text, "", 0, 0, 350, 350
   button #textmessage.default, "OK", [quit], UL, 140, 110, 55, 35
    open "Information Message" for dialog as #textmessage
      print #textmessage, "trapclose [quit]"
#textmessage, "font Arial Bold 12"
#textmessage.text, message$
#textmessage.default, "!font Arial Bold 12"
wait

[quit]
 scan
 close #textmessage : exit function
end function

'write script to select multiple files
function getMultiFiles$(Multi$)
open "MultiFile.vbs" for output as #1
#1, "Dim fso : Set fso = CreateObject(";q$;"Scripting.FileSystemObject";q$;")"
#1, "Dim sp : sp = fso.GetFile(Wscript.ScriptFullName)"
#1, "Dim fp: fp = fso.GetParentFolderName(sp) & ";q$;"\copylist.txt";q$
#1, "Dim f : Set f = fso.CreateTextFile(fp)"
#1, "Private Function SelectFiles(InitialDir, Filter)"
#1, "Dim result : result = ";q$;q$
#1, "With WScript.CreateObject(";q$;"WScript.Shell";q$;").Exec( _"
#1, q$;"powershell.exe -NonInteractive -NoProfile -windowstyle hidden -NoLogo -Command ";q$;q$;"& {";q$;" & _"
#1, q$;"[void][System.Reflection.Assembly]::LoadWithPartialName('System.Windows.Forms');";q$;" & _"
#1, q$;"$objOFDialog = New-Object System.Windows.Forms.OpenFileDialog;";q$;" & _"
#1, q$;"$objOFDialog.Filter = '";q$;" & Filter & ";q$;"';";q$;" & _"
#1, q$;"$objOFDialog.InitialDirectory = '";q$;"  & InitialDir & ";q$;"';";q$;" & _"
#1, q$;"$objOFDialog.Multiselect = $True;";q$;" & _"
#1, q$;"$objOFDialog.RestoreDirectory = $True;";q$;" & _"
#1, q$;"$objOFDialog.ShowHelp = $True;";q$;" & _"
#1, q$;"$objOFDialog.SupportMultiDottedExtensions = $True;";q$;" & _"
#1, q$;"$objOFDialog.Title = '          Select Files to Copy          (";q$;" & InitialDir & ";q$;")';";q$;" &_"
#1, q$;"[void]$objOFDialog.ShowDialog();";q$;" & _"
#1, q$;"$objOFDialog.FileNames -join '|'";q$;" &_"
#1, q$;"}";q$;q$;q$;")"
#1, ".StdIn.Close"
#1, "While .Status = 0"
#1, "WScript.Sleep 100"
#1, "Wend"
#1, "if .ExitCode = 0 Then"
#1, "While Not .stdOut.AtEndOfStream"
#1, "result = result & .stdOut.ReadAll"
#1, "Wend"
#1, "SelectFiles = Split(Replace(result, vbCrLf, ";q$;q$;"), ";q$;"|";q$;")"
#1, "Else"
#1, "While Not .stdErr.AtEndOfStream"
#1, "result = result & .stdErr.ReadAll"
#1, "Wend ' Not .stdErr.AtEndOfStream"
'#1, "WScript.Echo result" ' - LEFT IN FOR TESTING
#1, "SelectFiles = False"
#1, "End If ' .ExitCode = 0"
#1, "End With ' WScript.CreateObject(";q$;"WScript.Shell";q$;").Exec(...)"
#1, "End Function ' SelectFiles"
#1, "Dim SelectedFiles"
#1, "SelectedFiles = SelectFiles(";q$;"C:\";q$;", ";q$;"All Files (*.*)|*.*|ScriptFiles (*.ps1;*.vbs;.*bas)|*.ps1;*.*vbs;*.bas|All Files (*.*)|*.*";q$;")"
#1, "If IsArray(SelectedFiles) Then"
#1, "If UBound(SelectedFiles) >= 0 Then"
#1, "f.WriteLine bf & Join(SelectedFiles, vbCrLf)"
#1, "WScript.Sleep 400"
'#1, "Else" '  - LEFT IN FOR TESTING
'#1, "WScript.Echo ";q$;"NO Files Selected";q$ '  - LEFT IN FOR TESTING
#1, "End If"
#1, "Else WScript.Quit 1"
#1, "End If"
#1, "f.WriteLine bf"
#1, "f.Close"
close #1

'verify existence of the MultiFile.vbs script before continuing
do
res = fileExists(DefaultDir$,"MultiFile.vbs")
 if res then exit do
  scan
   loop until res

'run the script for user to select multiple files
 run "wscript ";"MultiFile.vbs"

'verify existence of copylist.txt before continuing
 do
 res = fileExists(DefaultDir$, "copylist.txt")
 scan
  if res then exit do
  loop until res
end function

'functions for making the folder dialog window
'Must add selectedpath$ and q$ to "global" at top of your bas file eg: global, selectedpath$
function getDest$(a$)

'write the following vbs script to temp file named FolderDialog.vbs
 folderDialog$ = "FolderDialog.vbs"
open folderDialog$ for output as #1
'print each line to file (FolderDialog.vbs)
#1,"Function BrowseFolder( myStartLocation, blnSimpleDialog )"
#1,"Const MY_COMPUTER = &H11&"
#1,"Const WINDOW_HANDLE = 0"
#1,"Dim numOptions, objFolder, objFolderItem"
#1,"Dim objPath, objShell, strPath, strPrompt"
#1,"strPrompt = ";q$;"Select Destination Folder After Selecting Files";q$ 'destination dialog
#1,"If blnSimpleDialog = True Then"
#1,"numOptions = 0"
#1,"Else"
#1,"numOptions = &H10&"
#1,"End If"
#1,"Set objShell = CreateObject( ";q$;"Shell.Application";q$;" )"
#1,"If UCase( myStartLocation ) = ";q$;"MY COMPUTER";q$;" Then"
#1,"Set objFolder = objShell.Namespace( MY_COMPUTER )"
#1,"Set objFolderItem = objFolder.Self"
#1,"strPath = objFolderItem.Path"
#1,"Else"
#1,"strPath = myStartLocation"
#1,"End If"
#1,"Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _"
#1,"numOptions, strPath )"
#1,"If objFolder Is Nothing Then"
#1,"BrowseFolder = ";q$;q$
#1,"Exit Function"
#1,"End If"
#1,"Set objFolderItem = objFolder.Self"
#1,"objPath = objFolderItem.Path"
#1,"BrowseFolder = objPath"
#1,"End Function"
#1,"Dim bf"
#1,"bf = BrowseFolder( ";q$;"My Computer";q$;", False )"
#1,"Dim fso : Set fso = CreateObject(";q$;"Scripting.FileSystemObject";q$;")"
#1,"Dim sp : sp = fso.GetFile(Wscript.ScriptFullName)"
#1,"Dim fp: fp = fso.GetParentFolderName(sp) & ";q$;"\FolderPath.txt";q$
#1,"Dim f : Set f = fso.CreateTextFile(fp)"
#1,"f.WriteLine bf"
#1,"f.Close"
close #1

'loop until FolderDialog.vbs existence is verified
do
 res = fileExists(DefaultDir$,folderDialog$)
  if res then exit do
  scan
loop until res

'run the script for user to select destination folder(creates temp file FolderPath.txt)
 run "wscript ";"FolderDialog.vbs"

'loop until the selected folder path is verified written to temp file (FolderPath.txt)
do
 folderpath$ = "FolderPath.txt"
 res = fileExists(DefaultDir$,folderpath$)
  if res then exit do
  scan
loop until res

'get the text in FolderPath.txt (user selected path of folder)
 open folderpath$ for input as #1
 line input #1, line$(x)
 selectedpath$ = line$(x)
close #1

'delete both temp files (FolderPath.txt, and FileDialog.vbs)
 res = fileExists(DefaultDir$,folderpath$)
  if res then kill folderpath$
    res = fileExists(DefaultDir$,folderDialog$)
  if res then kill folderDialog$
  if selectedpath$ = "" or left$(selectedpath$,1)  = ":" then notice "No Folder selected" : end
end function


[Rod]

Instead of importing the content to a variable just print that input straight to the new file name,

[xxgeek]

Aug 13, 2021 6:49:26 GMT Rod said:

Instead of importing the content to a variable just print that input straight to the new file name,

Below is the code that gets the full path of each selected file from a text file created by the script (copylist.txt), then gets the "name" of the file using GetFilename$(fileName$)function, then goes on to copy the "original file" to the "selectedpath\newfile"

How can I do it without using variables?
Is this the reason why I am limited to files under 46MB?



'get the list of user selected files to be copied from copylist.txt
dim multilines$(3000)
open "copylist.txt" for input as #1
while eof(#1) = 0
   x = x + 1
    line input #1, multilines$(x)
     line$ = multilines$(x)
      'print "line$ =";line$
wend
close #1

'copy the files in the list to the user selected destination folder
for z = 1 to x - 1
linex$ = multilines$(z)
 open linex$ for input as #3

  fileName$ = GetFilename$(linex$)
open selectedpath$;"\";fileName$ for output as #2
    #2, input$(#3, lof(#3));
close #3
close #2
next z

[Rod]

I see you are actually printing the file input directly to the destination. Don’t know where the limit is coming from since jb2 has a much bigger memory limit than 46mb

[xxgeek]

Aug 13, 2021 19:57:39 GMT Rod said:

I see you are actually printing the file input directly to the destination. Don’t know where the limit is coming from since jb2 has a much bigger memory limit than 46mb

Does this help you at all?

Error log timestamp Friday 21-08-13 04:49:15 PM

Runtime error: system primitive failed

Error(Exception)>>defaultAction
Error(Exception)>>activateHandler: <anUndefinedObject>
Error(Exception)>>handle
Error(Exception)>>signal
Error class(Exception class)>>signal: <'system primitive fai...'>
BasicProgram(Object)>>error: <'system primitive fai...'>
BasicProgram>>terminateRun: <anError>
[] in BasicProgram>>errorHandlerBlock
ExceptionHandler>>evaluateResponseBlock: <aBlockClosure> for: <anError>
[] in ExceptionHandler>>handle:
ProtectedFrameMarker(BlockClosure)>>setUnwind: <aBlockClosure>
BlockClosure>>invisibleEnsure: <aBlockClosure>
ExceptionHandler>>handle: <anError>
ExceptionHandler>>findHandler: <anError>
Error(Exception)>>activateHandler: <anExceptionHandler>
Error(Exception)>>handle
Error(Exception)>>signal
Error class(Exception class)>>signal: <'system primitive fai...'>
String class(Object)>>error: <'system primitive fai...'>
String class(Object)>>primitiveFailed
String class(Behavior)>>new: <90882648>
FileStream>>copyFrom: <1> to: <90882648>
FileStream>>nextAsString: <90882648>
[] in BasicInputChar class>>using:program:
BasicStringContext(BasicContextWrapper)>>value
[] in PrintCommand>>device:handle:
BlockClosure>>value: <aBasicProgram> value: <'#2'> value: <aBasicStringContext>
BasicTripleParameterContextHolder>>value
[] in BasicProgram>>begin
ExceptionHandler>>evaluateProtectedBlock: <aBlockClosure>
[] in ExceptionHandler>>activateDuring:
ProtectedFrameMarker(BlockClosure)>>setUnwind: <aBlockClosure>
BlockClosure>>invisibleEnsure: <aBlockClosure>
ExceptionHandler>>activateDuring: <aBlockClosure>
ExceptionHandler class>>handle: <anError class> with: <aBlockClosure> during: <aBlockClosure>
BlockClosure>>on: <anError class> do: <aBlockClosure>
BasicProgram>>begin
BasicProgram>>run
[] in BasicSourcePane>>run
BasicCompiler class>>compileFromString: <'''Title = MultiFileSe...'> notify: <aBasicSourcePane> ifSuccess: <aBlockClosure>
BasicSourcePane>>run
BasicSourceWindow>>run
BasicEditorModel>>run: <aToolbarButton>
BasicEditorModel(Object)>>perform: <#run:> with: <aToolbarButton>
ToolbarButton>>triggerClickedEvent
Message>>perform
NotificationManager>>runPendingEvents
NotificationManager>>runEventLoop
Message>>perform
Message>>evaluate

The file attempted to copy was a tad under 89 MB
In the "selectedpath" I have a "zero byte" file of the same name after running the program. So the path is correct, and JB starts to make the file(0bytes), so possibly a timing issue? Maybe needs a bit more time delay in case of large files?
Or could this be a JB bug?

[Rod]

The system primitive error is usually about running out of resources. Perhaps not the file size that is causing the problem though I cant be sure. Resources can be many things, events for example. Looking at the code you have some pretty bad counter loops. For t=0 to 500000 for t= 0 to 3000000.

What happens with these "delay" loops is that the processor gets locked into them and can't handle anything else till they are done. So the process freezes. If events are kicking off they cant get handled and they stack up using resource.

Try and avoid that kind of delay, a simple timer delay allows the processor to do other stuff till the timer event kicks in itself.

Try simpler delays and see if the problem persists.

[tsh73]

#2, input$(#3, lof(#3));
So this code reads whole file/prints whole file in one go.
It is sure (SURE!) has to fail at some size.

Why not read/write in smaller chanks, say 1Mb? 10 Mb?

[xxgeek]

Thanks guys, I just posted an updated version using a script to do the copying for now. Testing shows no size limit now, and no limit on number of files to be copied.
I intend to revert back to jb code when I get a chance.

@ Rod - You may be right, but those delays are waiting for a script to complete, not JB code.
I'll try it when I get a chance to be sure.

tsh73 - Funny you mention smaller blocks.
While testing I tried some variations similar to below
print #1, input$(#fname, lof(#fname)/2); -no go (zero byte file created
print #1, input$(#fname, lof(#fname)/4); - wrote 1/4 of the file
print #1, input$(#fname, lof(#fname)/5); - no go again
strange, but true

I'm off on a long ride for a couple of weeks and won't have my notebook with me.
Decided not to bring it after all. Not enough room on the bike to load it safely.
I'd have to crush it a bit to make it fit.

See ya all soon.

P.S. Eventually I want to get to know the FILES$ command and use info$ so scripts won't be necessary, but that info$() boggles my mind. Maybe a good holiday will fix that

[xxgeek]

Aug 14, 2021 15:07:24 GMT tsh73 said:

#2, input$(#3, lof(#3));
So this code reads whole file/prints whole file in one go.
It is sure (SURE!) has to fail at some size.

Why not read/write in smaller chanks, say 1Mb? 10 Mb?

I also tried
#2, input$ (#3, lof(#3));
and
#2, input$(#3, eof(#3));
and
#2, input$ (#3, lof(#3));
and
#2, input$ (#3, eof(#3));
with no luck

It is probably an error somewhere else. No time right now. Be back in a couple of weeks to figure it out..

[tsh73]

Reading/writing in 10e6 chunks

srcFile$ = "H:\ISO\VS2010Express1.iso"
'693Mb

descFile$ = "c:\temp\out.iso"

chunkSize = 10*10^6 '10Mb. Actually less, should be 10*2^20

t0=time$("ms")

open srcFile$ for input as #1
open descFile$ for output as #2 'will be overwritten. WATCH OUT!
len1=lof(#1)
Print "The size of " ; srcFile$;" is ";len1
Print len1/chunkSize ;" chunks"

pos=0
chunk = chunkSize
while pos<len1
SCAN
   if len1-pos<chunk then
       chunk = len1-pos
   end if
   print #2, input$(#1, chunk);   '(;) is important here
   pos=pos+ chunk

   print ".";
   i=i+1
   if i mod 50=0 then print    'progress indicator
wend
close #2
close #1

t1=time$("ms")
print
print "Time taken, ms ";t1-t0

Output
The size of H:\ISO\VS2010Express1.iso is 727351296
72.7351296 chunks
..................................................
.......................
Time taken, ms 58594

I checked with FC, files match.

[xxgeek]

tsh73 - Excellent, thank you. I will work on that when I get back.
I'd rather it was all JB code (no scripts at all), but had to do what I had to do until I learn to do it the JB way.

Just updated the code above again.
It's working well with no restrictions.
Plus, there are no more time delays. (for next loops)
Seems when I write the code properly, I don't need delays

Gotta run, need to test the bike at high speed before I go - to make sure it's packed safely. Probably close to a hundred pounds of gear.