tbader01
2007-08-06 19:06:03 UTC
Hello Everyone,
A while back someone helped me write an HTA app that takes a CSV file and
makes all of the contents into a marquee across the top of the screen. I have
worked on some additional features such as figure out a way to determine the
current directory since WScript.ScriptFullName isn't available in HTA (took
me forever to figure that out!), dynamically adjusting for various # of
columns, adjusting for different screen resolutions, and I also converted the
code to VBS as well.
Well, what I would like to be able to do now is to list the CSV's in the
HTA's directory, click one of them, run my CSV2MrqXXX script, and clear the
CSV selection dialog box.
I have been messing around with this for quite a while, and would just like
to see my vision come true! Below are my CSVList1.hta code, CSV2MrqJS1.hta,
and CSV2MrqVBS1.hta code, which hopefully someone might be able to put the
two together. The CSV2Mrq's will work if you change "server.csv" to any CSV
file (/w a header) in the same dir as the hta.
Here are my 3 hta's (Thanks for any assistance you can give!):
<html>
<head>
<title>CSVList1</title>
<HTA:APPLICATION
ID="CSVList1"
APPLICATIONNAME="CSVList1"
SCROLL="no"
SINGLEINSTANCE="yes"
</head>
<SCRIPT LANGUAGE="VBScript">
window.resizeTo 640,480
Sub Window_Onload
const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
'WScript.ScriptFullName not valid in HTA. Use document.location.pathname
instead...
URL_Path_With_ScriptName = document.location.pathname
'Stringip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only =
Left(URL_Path_With_ScriptName,InStrRev(URL_Path_With_ScriptName,"\"))
'If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = URLDecode(URL_Path_Only)
ListFile(No_URL_Path & "*.csv")
End Sub
Sub MessageBox
MsgBox CSVFile.value
End Sub
Function URLDecode(String)
String = Replace(String, "+", " ")
For i = 1 To Len(String)
sT = Mid(String, i, 1)
If sT = "%" Then
If i+2 < Len(String) Then
sR = sR & _
Chr(CLng("&H" & Mid(String, i + 1, 2)))
i = i+2
End If
Else
sR = sR & sT
End If
Next
URLDecode = sR
End Function
' Changes:
' 2006-01-19 Extended to handle the special case of filter masks
' ending with a ".". Thanks to Dave Casey for the hint.
Function ListFile(Path)
Dim a: a = ListDir(Path)
If UBound(a) = -1 then
MsgBox "No files found."
Exit Function
End If
Dim Filename, PutList
For Each Filename In a
Set objOption = Document.createElement("OPTION")
objOption.Text = Filename
objOption.value = Filename
CSVFile.add(objOption)
Next
End Function
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else
Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
ReDim a(10)
Dim n: n = 0
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = "." Then ' special case: "." at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter,
ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ' skip over "*" and "?" characters in
filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
If fc2 = "." Then
If Mid(Filter,fp) = "*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ' special case: "." at end of filter
CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function
</SCRIPT>
<body>
<select size="10" name="CSVFile" onChange="MessageBox">
</select>
<p>
<span id = "DataArea"></SPAN>
</body>
<html>
<head>
<!--This text is a comment-->
<title>CSV2MrqVBS1</title>
<STYLE>BODY {font-size: 8pt; font-family: Comic Sans MS;}</STYLE>
<!-- Hypertext Application Properties:
http://msdn2.microsoft.com/en-us/library/ms536481.aspx -->
<HTA:Application
ApplicationName="CSV2MrqVBS1"
Border="none"
Caption="yes"
ID="CSV2MrqVBS1"
SCROLL="no"
SingleInstance="yes"
ShowInTaskBar="no"
/>
<SCRIPT LANGUAGE="VBScript">
window.resizeTo 1,1
LeftMargin = 20
TopMargin = 0
WindowWidth = screen.width - 110
WindowHeight = 22
Sub CsvMarquee()
window.setinterval "oPopUp.show
LeftMargin,TopMargin,WindowWidth,WindowHeight",1
End Sub
const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
'WScript.ScriptFullName not valid in HTA. Use document.location.pathname
instead...
URL_Path_With_ScriptName = document.location.pathname
'Strip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only =
Left(URL_Path_With_ScriptName,InStrRev(URL_Path_With_ScriptName,"\"))
'If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = URLDecode(URL_Path_Only)
Set objFile = objFSO.OpenTextFile(Non_URL_Path & "server.csv", ForReading)
sHeader = objFile.ReadLine
arrHeader = Split(sHeader,",")
sAllTogether = ""
Do Until objFile.AtEndOfStream
counter = (objFile.Line - 1)
StringLine = objFile.ReadLine
arrLine = Split(StringLine, ",")
'For loop to allow for dynamic/variable number of columns
For i = 0 to Ubound(arrLine)
sAddTokens = sAddTokens & arrHeader(i) & ":" & arrLine(i) &
" "
Next
'Separate each row with extra spaces
sAllTogether = sAllTogether & counter & ": " & sAddTokens & " "
Loop
objFile.Close
Set oPopUp = Window.createPopup()
Set PopUpBody = oPopUp.document.body
PopUpBody.InnerHTML = "<marquee>" & sAllTogether & "</marquee>"
Function URLDecode(String)
String = Replace(String, "+", " ")
For i = 1 To Len(String)
sT = Mid(String, i, 1)
If sT = "%" Then
If i+2 < Len(String) Then
sR = sR & _
Chr(CLng("&H" & Mid(String, i + 1, 2)))
i = i+2
End If
Else
sR = sR & sT
End If
Next
URLDecode = sR
End Function
</SCRIPT>
</head>
<body onload="CsvMarquee()">
</body>
</html>
<html>
<head>
<!--This text is a comment-->
<title>CSV2MrqJS1</title>
<STYLE>BODY {font-size: 8pt; font-family: Comic Sans MS;}</STYLE>
<!-- Hypertext Application Properties:
http://msdn2.microsoft.com/en-us/library/ms536481.aspx -->
<HTA:Application
ApplicationName="CSV2MrqJS1"
Border="none"
Caption="no"
ID="CSV2MrqJS1"
SCROLL="no"
SingleInstance="yes"
ShowInTaskBar="no"
/>
<SCRIPT LANGUAGE="JScript">
window.resizeTo(1,1)
<!-- Positions PopUp at top of screen with room for windows controls at both
sides and adjusts to screen width -->
LeftMargin = 20
TopMargin = 0
WindowWidth = screen.width - 110
WindowHeight = 22
function CsvMarquee(){
var forreading = 1;
fso = new ActiveXObject("Scripting.FileSystemObject");
//WScript.ScriptFullName not valid in HTA. Use
document.location.pathname instead...
var URL_Path_With_Scriptname = document.location.pathname
//Strip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only = URL_Path_With_Scriptname.substr(0,
URL_Path_With_Scriptname.lastIndexOf("\\") + 1);
//If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = unescape(URL_Path_Only.replace(new RegExp("\\+","g")," "));
objFile = fso.OpenTextFile(Non_URL_Path + "server.csv", forreading);
arrHeader = objFile.ReadLine().split(",");
var sAllTogether="";
var sAddTokens="";
while(!objFile.AtEndOfStream){
counter = (objFile.Line - 1)
arrLine = objFile.Readline().split(",");
var i=0;
//For loop to allow for dynamic/variable number of columns
for(var i in arrHeader){
sAddTokens += arrHeader[i] + ":" + arrLine[i] + " "
}
sAllTogether += counter + ": " + sAddTokens + " "
}
objFile.Close()
xxCr = window.createPopup();
xxCr.document.body.innerHTML = '<marquee>' + sAllTogether + '</marquee>';
window.setInterval("xxCr.show(LeftMargin,TopMargin,WindowWidth,WindowHeight)",1)
}
</SCRIPT>
</head>
<body onload="CsvMarquee()">
</body>
</html>
A while back someone helped me write an HTA app that takes a CSV file and
makes all of the contents into a marquee across the top of the screen. I have
worked on some additional features such as figure out a way to determine the
current directory since WScript.ScriptFullName isn't available in HTA (took
me forever to figure that out!), dynamically adjusting for various # of
columns, adjusting for different screen resolutions, and I also converted the
code to VBS as well.
Well, what I would like to be able to do now is to list the CSV's in the
HTA's directory, click one of them, run my CSV2MrqXXX script, and clear the
CSV selection dialog box.
I have been messing around with this for quite a while, and would just like
to see my vision come true! Below are my CSVList1.hta code, CSV2MrqJS1.hta,
and CSV2MrqVBS1.hta code, which hopefully someone might be able to put the
two together. The CSV2Mrq's will work if you change "server.csv" to any CSV
file (/w a header) in the same dir as the hta.
Here are my 3 hta's (Thanks for any assistance you can give!):
<html>
<head>
<title>CSVList1</title>
<HTA:APPLICATION
ID="CSVList1"
APPLICATIONNAME="CSVList1"
SCROLL="no"
SINGLEINSTANCE="yes"
</head>
<SCRIPT LANGUAGE="VBScript">
window.resizeTo 640,480
Sub Window_Onload
const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
'WScript.ScriptFullName not valid in HTA. Use document.location.pathname
instead...
URL_Path_With_ScriptName = document.location.pathname
'Stringip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only =
Left(URL_Path_With_ScriptName,InStrRev(URL_Path_With_ScriptName,"\"))
'If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = URLDecode(URL_Path_Only)
ListFile(No_URL_Path & "*.csv")
End Sub
Sub MessageBox
MsgBox CSVFile.value
End Sub
Function URLDecode(String)
String = Replace(String, "+", " ")
For i = 1 To Len(String)
sT = Mid(String, i, 1)
If sT = "%" Then
If i+2 < Len(String) Then
sR = sR & _
Chr(CLng("&H" & Mid(String, i + 1, 2)))
i = i+2
End If
Else
sR = sR & sT
End If
Next
URLDecode = sR
End Function
' Changes:
' 2006-01-19 Extended to handle the special case of filter masks
' ending with a ".". Thanks to Dave Casey for the hint.
Function ListFile(Path)
Dim a: a = ListDir(Path)
If UBound(a) = -1 then
MsgBox "No files found."
Exit Function
End If
Dim Filename, PutList
For Each Filename In a
Set objOption = Document.createElement("OPTION")
objOption.Text = Filename
objOption.value = Filename
CSVFile.add(objOption)
Next
End Function
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function ListDir (ByVal Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Path = "" then Path = "*.*"
Dim Parent, Filter
if fso.FolderExists(Path) then ' Path is a directory
Parent = Path
Filter = "*"
Else
Parent = fso.GetParentFolderName(Path)
If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else
Parent = "."
Filter = fso.GetFileName(Path)
If Filter = "" Then Filter = "*"
End If
ReDim a(10)
Dim n: n = 0
Dim Folder: Set Folder = fso.GetFolder(Parent)
Dim Files: Set Files = Folder.Files
Dim File
For Each File In Files
If CompareFileName(File.Name,Filter) Then
If n > UBound(a) Then ReDim Preserve a(n*2)
a(n) = File.Path
n = n + 1
End If
Next
ReDim Preserve a(n-1)
ListDir = a
End Function
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
CompareFileName = False
Dim np, fp: np = 1: fp = 1
Do
If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
If Mid(Filter,fp) = ".*" Then ' special case: ".*" at end of filter
If np > Len(Name) Then CompareFileName = True: Exit Function
End If
If Mid(Filter,fp) = "." Then ' special case: "." at end of filter
CompareFileName = np > Len(Name): Exit Function
End If
Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
Select Case fc
Case "*"
CompareFileName = CompareFileName2(name,np,filter,fp)
Exit Function
Case "?"
If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
Case Else
If np > Len(Name) Then Exit Function
Dim nc: nc = Mid(Name,np,1): np = np + 1
If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
End Select
Loop
End Function
Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter,
ByVal fp0)
Dim fp: fp = fp0
Dim fc2
Do ' skip over "*" and "?" characters in
filter
If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
fc2 = Mid(Filter,fp,1): fp = fp + 1
If fc2 <> "*" And fc2 <> "?" Then Exit Do
Loop
If fc2 = "." Then
If Mid(Filter,fp) = "*" Then ' special case: ".*" at end of filter
CompareFileName2 = True: Exit Function
End If
If fp > Len(Filter) Then ' special case: "." at end of filter
CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
End If
End If
Dim np
For np = np0 To Len(Name)
Dim nc: nc = Mid(Name,np,1)
If StrComp(fc2,nc,vbTextCompare)=0 Then
If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
CompareFileName2 = True: Exit Function
End If
End If
Next
CompareFileName2 = False
End Function
</SCRIPT>
<body>
<select size="10" name="CSVFile" onChange="MessageBox">
</select>
<p>
<span id = "DataArea"></SPAN>
</body>
<html>
<head>
<!--This text is a comment-->
<title>CSV2MrqVBS1</title>
<STYLE>BODY {font-size: 8pt; font-family: Comic Sans MS;}</STYLE>
<!-- Hypertext Application Properties:
http://msdn2.microsoft.com/en-us/library/ms536481.aspx -->
<HTA:Application
ApplicationName="CSV2MrqVBS1"
Border="none"
Caption="yes"
ID="CSV2MrqVBS1"
SCROLL="no"
SingleInstance="yes"
ShowInTaskBar="no"
/>
<SCRIPT LANGUAGE="VBScript">
window.resizeTo 1,1
LeftMargin = 20
TopMargin = 0
WindowWidth = screen.width - 110
WindowHeight = 22
Sub CsvMarquee()
window.setinterval "oPopUp.show
LeftMargin,TopMargin,WindowWidth,WindowHeight",1
End Sub
const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
'WScript.ScriptFullName not valid in HTA. Use document.location.pathname
instead...
URL_Path_With_ScriptName = document.location.pathname
'Strip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only =
Left(URL_Path_With_ScriptName,InStrRev(URL_Path_With_ScriptName,"\"))
'If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = URLDecode(URL_Path_Only)
Set objFile = objFSO.OpenTextFile(Non_URL_Path & "server.csv", ForReading)
sHeader = objFile.ReadLine
arrHeader = Split(sHeader,",")
sAllTogether = ""
Do Until objFile.AtEndOfStream
counter = (objFile.Line - 1)
StringLine = objFile.ReadLine
arrLine = Split(StringLine, ",")
'For loop to allow for dynamic/variable number of columns
For i = 0 to Ubound(arrLine)
sAddTokens = sAddTokens & arrHeader(i) & ":" & arrLine(i) &
" "
Next
'Separate each row with extra spaces
sAllTogether = sAllTogether & counter & ": " & sAddTokens & " "
Loop
objFile.Close
Set oPopUp = Window.createPopup()
Set PopUpBody = oPopUp.document.body
PopUpBody.InnerHTML = "<marquee>" & sAllTogether & "</marquee>"
Function URLDecode(String)
String = Replace(String, "+", " ")
For i = 1 To Len(String)
sT = Mid(String, i, 1)
If sT = "%" Then
If i+2 < Len(String) Then
sR = sR & _
Chr(CLng("&H" & Mid(String, i + 1, 2)))
i = i+2
End If
Else
sR = sR & sT
End If
Next
URLDecode = sR
End Function
</SCRIPT>
</head>
<body onload="CsvMarquee()">
</body>
</html>
<html>
<head>
<!--This text is a comment-->
<title>CSV2MrqJS1</title>
<STYLE>BODY {font-size: 8pt; font-family: Comic Sans MS;}</STYLE>
<!-- Hypertext Application Properties:
http://msdn2.microsoft.com/en-us/library/ms536481.aspx -->
<HTA:Application
ApplicationName="CSV2MrqJS1"
Border="none"
Caption="no"
ID="CSV2MrqJS1"
SCROLL="no"
SingleInstance="yes"
ShowInTaskBar="no"
/>
<SCRIPT LANGUAGE="JScript">
window.resizeTo(1,1)
<!-- Positions PopUp at top of screen with room for windows controls at both
sides and adjusts to screen width -->
LeftMargin = 20
TopMargin = 0
WindowWidth = screen.width - 110
WindowHeight = 22
function CsvMarquee(){
var forreading = 1;
fso = new ActiveXObject("Scripting.FileSystemObject");
//WScript.ScriptFullName not valid in HTA. Use
document.location.pathname instead...
var URL_Path_With_Scriptname = document.location.pathname
//Strip off Scriptname and only leave Drive Letter and Path...
URL_Path_Only = URL_Path_With_Scriptname.substr(0,
URL_Path_With_Scriptname.lastIndexOf("\\") + 1);
//If path has spaces in it (Ex. C:\Program%20Files), DeCode to standard
Windows format...
Non_URL_Path = unescape(URL_Path_Only.replace(new RegExp("\\+","g")," "));
objFile = fso.OpenTextFile(Non_URL_Path + "server.csv", forreading);
arrHeader = objFile.ReadLine().split(",");
var sAllTogether="";
var sAddTokens="";
while(!objFile.AtEndOfStream){
counter = (objFile.Line - 1)
arrLine = objFile.Readline().split(",");
var i=0;
//For loop to allow for dynamic/variable number of columns
for(var i in arrHeader){
sAddTokens += arrHeader[i] + ":" + arrLine[i] + " "
}
sAllTogether += counter + ": " + sAddTokens + " "
}
objFile.Close()
xxCr = window.createPopup();
xxCr.document.body.innerHTML = '<marquee>' + sAllTogether + '</marquee>';
window.setInterval("xxCr.show(LeftMargin,TopMargin,WindowWidth,WindowHeight)",1)
}
</SCRIPT>
</head>
<body onload="CsvMarquee()">
</body>
</html>