I needed a file browser because on w98 I can't use the User object that allows using the windows "open" dialog.
Yet I can use the IE open dialog but it doesn't allow filtering by extention. So I had to sort of reinvent the wheel.
Now the real advantage of this HTA over the default dialog is that you can select files from different directories before submiting your selection.
You don't need to hold the Ctrl key to make multiple selections, but you can't use Shift+Sparrow to select groups of files.
And HTA allows you to creates your own features:
-Select all, Unselect all, Reset and other buttons
-Shows the list of the files selected
-Shows the number of files in the directory after filtering
-Separate folders from files
-Path, extention filter, detail view and sorting argument customizable from launch script
Not featuring yet:
-Address bar
-Buttons for changing extention filter, detail view and sorting argument from the HTA file browser
-List of subfolders not sorted
Use:
Take the example from the script below.
commandline is:
WshShell.Run "filebrowser3.hta /[path] /[extentions separated by commas] /O:[sort by argument] /V:[view arguments]", 3, true
Sort argument and view argument are moreless the same as in DOS:
Sort by (/O:) :
N - by name
E - by extension
A - by last access date
S - by size
D - by date and time
View details (/V:) :
A - last access date
S - size
D - date and time
B - attribute
L - full details
Arguments can be written in whatever order you wish, with or without white space or be obmited without generating error.
When the dialog open click on file names to select them.
After the dialog is closed, the script will have to read the list from "list.tmp".
Title = "Testing Browse for files"
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
'--------Launch browser--------
'---------SortBy (/O:)---------
' N - by name
' E - by extension
' A - by last access date
' S - by size
' D - by date and time
'------ViewDetails (info) (/V:)-------
' A - last access date
' S - size
' D - date and time
' B - attribute
' L - full details
'----------
WshShell.Run "filebrowser.hta /C:\MYDOCU~1 /txt,doc,pdf /O:N /V:SD", 3, true
'-------Open temp file to read the list of items-----
If fso.FileExists("list.tmp") Then
Set f = fso.GetFile("list.tmp")
Set ts = f.OpenAsTextStream(1)
t = ts.ReadAll
ts.Close
f.Delete
MsgBox t,,Title
End If
'-------end of example---------
Here is the HTA code
Save it as "filebrowser.hta"
<HTML>
<HEAD>
<HTA:APPLICATION ID="FileBrowser"
APPLICATIONNAME="FileBrowser"
WINDOWSTATE="maximize"
SINGLEINSTANCE="no">
<meta name="VI60_defaultClientScript" content="VBScript">
<TITLE>Select a file</TITLE>
<SCRIPT LANGUAGE="VBScript">
Public FolPath, fso, WshShell, InvLinkDebug, Selection, ExtFilter, SortBy, ViewDetails
Sub window_onLoad()
Set fso = CreateObject("scripting.FilesystemObject")
Set WshShell = CreateObject("WScript.Shell")
t = Split(FileBrowser.commandLine, "/")
'MsgBox t(1) &vbcrlf& t(2) ,,"debug arguments"
'----read arguments-----
FolPath = ""
SortBy = ""
ViewDetails = ""
ExtFilter = ","
If UBound(t)>0 Then
For i=1 To UBound(t)
If InStr(t(i), ":\") Then
FolPath = t(i)
ElseIf InStr(t(i), "O:") Then
SortBy = UCase(Replace( Mid(t(i), InStr(t(i), ":")+1) ," ",""))
ElseIf InStr(t(i), "V:") Then
ViewDetails = UCase(Replace( Mid(t(i), InStr(t(i), ":")+1) ," ",""))
ElseIf t(i)<>"" Then
ExtFilter = Replace(t(i)," ","") & ","
End If
Next
End If
'---------SortBy---------
' N - by name
' E - by extension
' A - by last access date
' S - by size
' D - by date and time
'----
If SortBy = "" Then
SortBy = "N"
End If
'-----------------------
If FolPath = "" Then
FolPath = WshShell.CurrentDirectory
End If
'------ViewDetails (info)-------
' A - last access date
' S - size
' D - date and time
' B - attribute
' L - full details
' ""
'
'-------debug--------
'MsgBox "FolPath= " & FolPath _
' &vbcrlf& "SortBy=" & SortBy _
' &vbcrlf& "ViewDetails= " & ViewDetails _
' &vbcrlf& "ExtFilter= " & ExtFilter ,,"debug arguments"
'------end debug------
InvLinkDebug = True
t=Null
Call DoList(FolPath)
End Sub
Sub DoList(fPath)
LinkCount = 0
fCount = 0
t=""
'------------do buttons------
TextToStart = "<p align=""center""><strong>" & fPath & "</strong> <INPUT NAME=""BtnUpOneLevel"" TYPE=""BUTTON"" VALUE=""<== Up one level"" "
If InStr(fPath, "\")=0 Then
fPath = fPath & "\"
End If
If InStrRev(fPath, ":\") = Len(fPath)-1 Then
TextToStart = TextToStart & "disabled></p>"
Else
TextToStart = TextToStart & "onclick=""DoList('" & Left(fPath, InStrRev(fPath,"\")-1) & "')""></p>"
End If
TextToStart = TextToStart & "<span id=""This"" onmouseover=""this.style.cursor='hand'"" onmouseout=""this.style.cursor='auto'"">"
'----------do subfolders--------
Set folder = fso.getfolder(fPath)
For Each f in folder.subfolders
t = t & "<A onclick=""DoList('" & f.path & _
"')"" ><img name=""BtnOpenFolder"" src=""openfol.gif"" border=""0"" alt=""go to this directory""> " &_
Replace(f.name," "," ") & "</A> "
Next
If t <>"" Then
TextToStart = TextToStart & t
End If
'-------------do files---------
'---------SortBy---------
Select Case SortBy
Case "" t="MyString = UCase(f.name) & VbTab &"
Case "N" t="MyString = UCase(f.name) & VbTab &"
Case "E" t="MyString = fso.GetExtensionName(f.name) & UCase(f.name) & VbTab &"
Case "A" t="MyDate = f.DateLastAccessed" _
& VbCrlf & "MyString = Right(Year(MyDate),2) & Right( ""0"" & Month(MyDate),2 ) & Right( ""0"" & Day(MyDate),2 ) " _
& "& UCase(f.name) & VbTab &"
Case "S" t="MyString = Chr(Len(f.size)+65) & f.size & VbTab &"
Case "D" t="MyDate = f.DateLastModified" _
& VbCrlf & "MyString = Right(Year(MyDate),2) & Right( ""0"" & Month(MyDate),2 ) & Right( ""0"" & Day(MyDate),2 ) " _
& " & Right( ""0"" & Hour(MyDate),2 ) & Right( ""0"" & Minute(MyDate),2 ) & Right( ""0"" & Second(MyDate),2 )" _
& "& UCase(f.name) & VbTab &"
End Select
'------ViewDetails-------
Select Case True
Case ViewDetails="" t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;</b></A></span>"""
Case InStr(ViewDetails,"L")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;*3*""" _
& " & FormatNumber(f.Size, 0,0,0,-1) & "";b, Modified: "" & f.DateLastModified & "", Accessed: "" & f.DateLastAccessed" _
& " & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]</font></A></span><br>"""
Case InStr(ViewDetails,"A")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;*3*""" _
& " & "" Acc.: "" & f.DateLastAccessed"
Case InStr(ViewDetails,"S")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;*3*""" _
& " & FormatNumber(f.Size, 0,0,0,-1) & "";b"""
Case InStr(ViewDetails,"D")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;*3*""" _
& " & f.DateLastModified"
Case InStr(ViewDetails,"B")>0 t=t & " ""*1*"" & Replace(Replace(Replace(Replace(f.ShortName,""."",""""),"" "",""""),""~"",""""),""-"",""_"") & ""*2*"" & f.path & ""')""""><b>;;""" _
& " & Replace(f.name,"" "","" "") & "";;*3*""" _
& " & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]"""
End Select
'----if more than one---
If Len(ViewDetails)>1 Then
For i=2 To Len(ViewDetails)
Select Case True
Case InStr(i,ViewDetails,"A",1)>0 t=t & " & "";Acc.:;"" & f.DateLastAccessed"
Case InStr(i,ViewDetails,"S",1)>0 t=t & " & "";-;"" & FormatNumber(f.Size, 0,0,0,-1) & "";b"""
Case InStr(i,ViewDetails,"D",1)>0 t=t & " & "";-;"" & f.DateLastModified"
Case InStr(i,ViewDetails,"B",1)>0 t=t & " & "";-;"" & Replace(Replace(Replace(Replace(""["" & f.Attributes,""1"",""Read Only""),""[2"",""[Hidden""),""4"",""System File""),""32"",""Archive"") & ""]"""
End Select
Next
End If
If InStr(ViewDetails,"L")=0 And ViewDetails<>"" Then
If Len(ViewDetails)>2 Then
t=t & " & ""</font></A></span><br>"""
Else
t=t & " & ""</font></A></span>"""
End If
End If
'-------------
Set oMyCatString = New AddString '---utilise la classe pour ajouter les ficheirs dans la liste rapidement
For Each f in folder.files
If ExtFilter = "," Or InStr(1, ExtFilter, fso.GetExtensionName(f.name) & ",", 1) Then
Execute t
oMyCatString MyString
fCount = fCount+1
End If
Next
If fCount > 1 Then
FileList = oMyCatString.Flush
ElseIf fcount = 0 Then
FileList = ""
Else
MyString = Mid(MyString, InStr(MyString, VbTab)+1)
MyString = Replace(Replace(Replace(Replace(MyString, ";", " "),"*1*","<span id=""f" ), "*2*", """><A onclick=""SelectFile('" ), "*3*", "</b><font color=""#009933"">")
FileList = MyString
End If
document.all.ListOfItems.innerhtml = TextToStart & "<hr>" & FileList & "</p></span><p><font color=""#FF0000"">Number of files: " & fCount & "</font></p>"
End Sub
'-----class to concatenate strings (modified)-----
Class AddString
Dim iElement, NewStrArray
Private Sub Class_Initialize()
iElement = 0
ReDim NewStrArray(iElement)
End Sub
Public Default Sub AddString(Value)
NewStrArray(iElement) = Value
iElement = iElement + 1
ReDim Preserve NewStrArray(iElement)
End Sub
Public Function Flush
iElement = iElement - 1
Redim Preserve NewStrArray(iElement)
'------sort list-----
ArraySort NewStrArray
'-----remove sorting mark------
'-----and add html code that where replaced by "*1*" to make string shorter when sorting-----
For iel = 0 To UBound(NewStrArray)
Word = NewStrArray(iel)
Word = Mid(Word, InStr(Word, VbTab)+1)
Word = Replace(Replace(Replace(Replace(Word, ";", " "),"*1*","<span id=""f"), "*2*", """><A onclick=""SelectFile('"), "*3*", "</b><font color=""#009933"">")
NewStrArray(iel) = Word
Next
'--------------------
Flush = Join(NewStrArray,VbCrLf)
End Function
'-----------sort function---------
Private Function ArraySort(ArrY)
ReDim TempArray(255)
For Each Word in ArrY
UCaseWord = UCase(Word) & " "
TempArrayNum = Asc(Left(UCaseWord,1))
TempArray(TempArrayNum) = TempArray(TempArrayNum) & Word & VBCrlf
Next
For Each SmallList In TempArray
If SmallList <>"" Then
SmallArray = Split( Mid(SmallList,2 ),VBCrlf)
'-----------------
InsertionSort SmallArray
'------------------
BigList = BigList & Join(SmallArray,VbCrlf)
End If
Next
time2 = Timer
ArrY = Split(BigList,VbCrlf)
Erase SmallArray
Erase TempArray
End Function
'-----------sort function---------
Private Function InsertionSort(arrX)
Dim nUB : nUB = UBound(arrX)
Dim i, j, v
For i=1 To nUB
v=arrX(i)
j=i
Do While arrX(j-1) > v
arrX(j) = arrX(j-1)
j=j-1
If j<=0 Then
Exit Do
End If
Loop
arrX(j) = v
Next
End Function
'------------------------------------
Private Sub Class_Terminate()
Erase NewStrArray
End Sub
End Class
'--------
Sub SelectFile(fPath)
fName = fso.GetFile(fPath).ShortName
fName = "f" & Replace(Replace(Replace(Replace(fName,".",""),"~","")," ",""),"-","_")
Execute "t = document.all." & fName & ".innerhtml"
If InStr(t,"#ffffff") Then
Selection = Replace(Selection, fPath & VbCrlf,"")
t = Mid(t, 55)
t = Left(t, Len(t)-7)
MyString = "document.all." _
& fName _
& ".innerhtml =""" _
& Replace(Replace(t,"""",""""""),VbCrlf,"") _
& """"
Else
Selection = Selection & fPath & VbCrlf
MyString = "document.all." _
& fName _
& ".innerhtml = ""<font color=""""#ffffff"""" style=""""background-color: #0000ff""""> " _
& Replace(Replace(t,"""",""""""),VbCrlf,"") _
& "</font>"""
End If
Execute MyString
document.all.ListOfSelectedItems.innerhtml = Replace(Selection, VbCrlf,"<br>")
End Sub
Sub ResetSelection
Selection = ""
For each span in document.all.tags("span")
SpanID = span.id
If Left(SpanID,1) = "f" Then
t = span.innerhtml
If InStr(t,"#ffffff") Then
t = Mid(t, 55)
t = Left(t, Len(t)-7)
span.innerhtml = t
End If
End If
Next
document.all.ListOfSelectedItems.innerhtml = ""
End Sub
Sub UnSelectAll
For each span in document.all.tags("span")
SpanID = span.id
If Left(SpanID,1) = "f" Then
t = span.innerhtml
If InStr(t,"#ffffff") Then
fPath = Mid(t, InStr(t,"SelectFile('")+12)
fPath = Left(fPath, InStr(fPath,"'")-1)
Selection = Replace(Selection, fPath & VbCrlf,"")
t = Mid(t, 55)
t = Left(t, Len(t)-7)
span.innerhtml = t
End If
End If
Next
document.all.ListOfSelectedItems.innerhtml = Replace(Selection, VbCrlf,"<br>")
End Sub
Sub SelectAll
For each span in document.all.tags("span")
SpanID = span.id
If Left(SpanID,1) = "f" Then
t = span.innerhtml
If InStr(t,"#ffffff")=0 Then
fPath = Mid(t, InStr(t,"SelectFile('")+12)
fPath = Left(fPath, InStr(fPath,"'")-1)
Selection = Selection & fPath & VbCrlf
t = "<font color=""#ffffff"" style=""background-color: #0000ff""> " & t & "</font>"
span.innerhtml = t
End If
End If
Next
document.all.ListOfSelectedItems.innerhtml = Replace(Selection, VbCrlf,"<br>")
End Sub
Sub WriteList
Set objOutputFile = fso.CreateTextFile("list.tmp", True)
objOutputFile.WriteLine Selection
objOutputFile.Close
Window.Close
Wscript.Quit(1)
End Sub
Sub CancelSelection
Window.Close
Wscript.Quit
End Sub
</SCRIPT>
</HEAD>
<BODY bgcolor="#FCF3DA">
<FORM NAME="form">
<INPUT NAME="BtnOpenSelection" ONCLICK="WriteList" TYPE="BUTTON" VALUE="Open selection">
<INPUT NAME="BtnSelectAll" ONCLICK="SelectAll" TYPE="BUTTON" VALUE="Select All">
<INPUT NAME="BtnUnSelectAll" ONCLICK="UnSelectAll" TYPE="BUTTON" VALUE="UnSelect All">
<INPUT NAME="BtnReset" ONCLICK="ResetSelection" TYPE="BUTTON" VALUE="Reset">
<INPUT NAME="BtnCancel" ONCLICK="CancelSelection" TYPE="BUTTON" VALUE="Cancel">
<span id="ListOfItems"></span>
<hr>
<font color="#FF0000">Files selected:</font><br>
<span id="ListOfSelectedItems"></span>
</FORM>
</BODY>
<!--Free to use and distribute for private and non commercial and non professional purpose.
This hta application is under copyright protection." -->
</HTML>
<message edited by Fredledingue on Tuesday, November 21, 2006 9:02 AM>