Multiple File Selection Dialog - lbjoseph

 ' Multiple file selection dialog by Joseph Essin. 
 ' I got tired of the performance of the API one, 
 ' as it was always crashing. 
 ' So I just made my own. 
 
 
 ' For the MultiOpen$() function: 
 Global Drives 
 Dim Drives$(0) 
 Dim Places$(0) 
 Dim PlacesList$(0) 
 Dim Folders$(0) 
 Dim Files$(0) 
 Dim FileInfo$(0,0) 
 Dim Ext$(0) 
 '-----------------------------------' 
 
 'NoMainWin 
 
 files$ = MultiOpen$("Open File(s)", DefaultDir$, "*.*;*.bas") 
 
 nfiles = Words(files$, "|") 
 
 For i = 1 To nfiles 
 Print Word$(files$, i, "|") 
 Next i 
 
 
 ' Returns a | delimited list of filenames selected. 
 ' Or nothing (""), if no files were selected. 
 ' 
 ' ext$ is the list of extensions you want people 
 ' to be able to select, seperated by a semicolon. 
 ' initpath$ is the initial path it opens to. 
 ' title$ is what it says in the window title. 
 Function MultiOpen$(title$, initPath$, ext$) 
 
 Drives = Words(Drives$, " ") 
 ReDim PlacesList$(Drives+5) 
 ReDim Places$(Drives+5) 
 
 Places$(1) = GetSpecialFolder$(40) ' User's folder 
 Places$(2) = GetSpecialFolder$(0) ' User's desktop 
 Places$(3) = GetSpecialFolder$(5) ' User's documents 
 Places$(4) = GetSpecialFolder$(39) ' User's pictures 
 Places$(5) = GetSpecialFolder$(13) ' User's music 
 
 For i = 1 To 5 : PlacesList$(i) = File.ShortName$(Places$(i)) : Next i 
 
 For i = 6 To 5+Drives 
 Places$(i) = Upper$(Word$(Drives$, i-5));"\" 
 PlacesList$(i) = Places$(i) 
 Next 
 
 extensions = Words(ext$,";") 
 ReDim Ext$(extensions) 
 For i = 1 To extensions 
 Ext$(i) = Word$(ext$,i,";") 
 Next i 
 
 WindowWidth = 640 
 WindowHeight = 450 
 UpperLeftX = Int((DisplayWidth-WindowWidth)/2) 
 UpperLeftY = Int((DisplayHeight-WindowHeight)/2) 
 
 Stylebits #sel.whitespace, 0, _WS_BORDER, 0, 0 
 Stylebits #sel.files, _LBS_EXTENDEDSEL, 0, 0, 0 
 Stylebits #sel.address, _ES_READONLY, 0, 0, 0 
 Stylebits #sel.filename,_ES_READONLY, 0, 0, 0 
 
 ' I would love to use this, but it makes the combobox stop sending change notifications: 
 'Stylebits #sel.ext, _CBS_DROPDOWNLIST, 0, 0, 0 
 
 Graphicbox #sel.whitespace, -4, -4, 660, 44 
 
 Button #sel.up, "Back", [FolderUp], UL, 2, 2, 46, 34 
 Textbox #sel.address, 54, 08, 570, 20 
 Listbox #sel.places, PlacesList$(), [SelectPlace], 2, 42, 150, 300 
 Listbox #sel.folders, Folders$(), [SelectFolder], 154, 42, 476, 120 
 Listbox #sel.files, Files$(), [SelectFile], 154, 164, 476, 178 
 Textbox #sel.filename, 6, 348, 516, 20 
 Combobox #sel.ext, Ext$(), [SelectExt], 530, 346, 94, 20 
 Button #sel.default, "Open", [Go], UL, 460, 380, 80, 30 
 Button #sel.cancel, "Cancel", [Cancel], UL, 545, 380, 80, 30 
 
 Stylebits #sel, _DS_CENTER, 0, 0, 0 
 Open title$ For Dialog_Modal As #sel 
 
 lbx = Hwnd(#sel.files) 
 
 #sel "TrapClose [Quit]" 
 #sel "Font Arial 9" 
 #sel.places "SingleClickSelect" 
 #sel.files, "SingleClickSelect" 
 #sel.places "SetFocus" 
 #sel.ext, "SelectIndex 1" 
 
 ext$ = Ext$(1) 
 folder$ = initPath$ 
 GoSub [StartAt] 
 
 Wait 
 
 [SelectPlace] 
 #sel.places, "SelectionIndex? n" 
 If n = 0 Then Wait 
 folder$ = Places$(n) 
 GoSub [StartAt] 
 Wait 
 
 [SelectFolder] 
 #sel.folders, "Selection? n$" 
 If n$ = "" Then Wait 
 folder$ = folder$;"\";n$ 
 GoSub [StartAt] 
 Wait 
 
 [SelectFile] 
 items$ = "" 
 paths$ = "" 
 For i = 1 To nfiles 
 isSel = SendMessageA(lbx, _LB_GETSEL, i - 1, 0) 
 If isSel Then 
 items$ = items$; Files$(i); "|" 
 paths$ = paths$; folder$; "\"; Files$(i); "|" 
 End If 
 Next i 
 #sel.filename, items$ 
 Wait 
 
 [FolderUp] 
 For i = Len(folder$) To 1 Step -1 
 If Mid$(folder$, i, 1) = "\" Then 
 folder$ = Mid$(folder$, 1, i-1) 
 GoSub [StartAt] 
 Exit For 
 End If 
 Next i 
 #sel.folders, "SetFocus" 
 Wait 
 
 [SelectExt] 
 #sel.ext, "SelectionIndex? n" 
 If n = 0 Then Wait 
 ext$ = Ext$(n) 
 GoSub [StartAt] 
 Wait 
 
 [StartAt] 
 ' Remove any trailing slash. 
 If right$(folder$,1) = "\" Then folder$ = Mid$(folder$,1,Len(folder$)-1) 
 ' Find the files and folders within: 
 Files folder$;"\", ext$, FileInfo$() 
 nfolders = Val(FileInfo$(0,1)) 
 nfiles = Val(FileInfo$(0,0)) 
 items$ = "" 
 paths$ = "" 
 ReDim Folders$(nfolders) 
 ReDim Files$(nfiles) 
 For i = 1 To nfolders 
 Folders$(i) = FileInfo$(nfiles+i,1);"\" 
 Next i 
 #sel.folders "Reload" 
 For i = 1 To nfiles 
 Files$(i) = FileInfo$(i,0) 
 Next i 
 #sel.files "Reload" 
 #sel.address folder$;"\" 
 ' Select one of the places if this folder is identical to it. 
 #sel.places, "SelectIndex 0" 
 For i = 1 To Drives+5 
 compare$ = Lower$(folder$) 
 If Right$(compare$,1) = ":" Then compare$ = compare$; "\" 
 If compare$ = Lower$(Places$(i)) Then 
 #sel.places "SelectIndex ";i 
 Exit For 
 End If 
 Next i 
 #sel.filename, items$ 
 Wait 
 
 [Go] 
 MultiOpen$ = paths$ 
 
 [Cancel] 
 
 [Quit] 
 Close #sel 
 
 End Function 
 
 Function GetSpecialFolder$(CSIDL) 
 struct IDL, _ 
 cb As uLong,abID As short 
 calldll #shell32, "SHGetSpecialFolderLocation",_ 
 0 as ulong,CSIDL as ulong,IDL as struct,ret as ulong 
 if ret=0 then 
 Path$ = Space$(_MAX_PATH) 
 id = IDL.cb.struct 
 calldll #shell32, "SHGetPathFromIDListA",_ 
 id as ulong,Path$ as ptr,ret as ulong 
 GetSpecialFolder$ = trim$(Path$) 
 end if 
 if GetSpecialFolder$ = "" then GetSpecialFolder$ = "Not Applicable" 
 End Function 
 
 Function SendMessageA(hW, msg, par1, par2) 
 CallDLL #user32, "SendMessageA",_ 
 hW as Ulong, _ 'Handle of the control (listbox) 
 msg as Long, _ 'Stylebits (Windows Constant) 
 par1 as Long, _ 'Parameter 1 (sometimes irrelevant) 
 par2 as Long, _ 'Parameter 2 (sometimes irrelevant) 
 SendMessageA as long 'Return Value, 1 = success 
 End Function 
 
 Function Words(str$, del$) 
 index = 1 
 While Word$(str$, index, del$) <> "" 
 index = index + 1 
 WEnd 
 Words = index - 1 
 End Function 
 
 ' Returns the short filename of a path. 
 Function File.ShortName$(filepath$) 
 File.ShortName$ = filepath$ 
 For i = (Len(filepath$) - 1) To 0 Step -1 
 If Mid$(filepath$,i,1) = "\" Then 
 File.ShortName$ = Mid$(filepath$,i+1) 
 Exit Function 
 End If 
 Next i 
 End Function