<html>
<head>
<meta http-equiv="content-type" content="text/html;charset=utf-8" />
<head>
<script language = "VBScript">
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
Sub Window_onLoad
Set dict = CreateObject("Scripting.Dictionary")
Set file = fso.OpenTextFile ("fr.yml", 1)
row = 0
Do Until file.AtEndOfStream
'Msgbox(file.Readline)
line = file.Readline
dict.Add row, line
row = row + 1
Loop
nnn.innerHTML = dict(15)
hhh.innerHTML = "prêt àprêt à"
End Sub
</script>
<body>
<p id="nnn">éprêt à</p>
<p id="hhh">éprêt à</p>
</body>
In this code the <p id="nnn"> shows Terminé like this, and <p id="hhh"> shows prêt àprêt à like this exactly.
My fr.yml file has 16th line Terminé.
Your input file (fr.yml) appears to be UTF-8 encoded. FileSystemObject methods can't handle that encoding, so you need to use an ADODB.Stream, as #Ekkehard.Horner suggested:
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2 'text
stream.Charset = "utf-8"
stream.LoadFromFile "fr.yml"
For Each line In Split(stream.ReadText, vbNewLine)
dict.Add row, line
row = row + 1
Next
stream.Close
I solved it by my self by adding one more parameter to OpenTextFile().
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
Sub Window_onLoad
Set dict = CreateObject("Scripting.Dictionary")
Set file = fso.OpenTextFile ("fr.yml", 1, -1)
row = 0
Do Until file.AtEndOfStream
'Msgbox(file.Readline)
line = file.Readline
dict.Add row, line
row = row + 1
Loop
nnn.innerHTML = dict(15)
hhh.innerHTML = "prêt àprêt à"
End Sub
Reference Here
Related
I've been trying to figure out this issue for 3 days now and I want to hurt myself.
I built a little utility to download files from a server. The script simply loops through a list of user-entered serials and appends each into the file url. It seems to perform fine for the most part until it hits a large file. "Large" being the third serial which is the one and only test case of 500mb I've encountered. The first two are less than 20mb. The smaller files download fine, but the larger file throws a "Not enough memory resources are available to complete this operation." error. I have 16gb of ram (barely utilized) and more than enough storage space.
Here's the really strange part, if I only attempt to download the 500mb file (enter only the last serial), sometimes it works. I cannot conclude what the cause is.
I've included a heavily stripped version of my code. I thought pulling pieces out might resolve the issue or at least shed some light, but it persists. I'd be grateful to anyone that can help me resolve this.
To recreate, copy my script below into a text file and rename extension from .txt to .hta. To use, enter the 3 serials below (including commas) into the text box and click download. The script creates the directory "C:\Downloads" and places downloaded files within:
Serials:
BLES01294,BCES00510,BLUS30109
My hta script:
<!DOCTYPE html>
<!-- saved from url=(0014)about:internet -->
<html style="display: inline-block;" id="mainHTML">
<head>
<meta http-equiv="x-ua-compatible" content="ie=9"/>
<title>Download Tool</title>
<!--Styles defined for doc (end)-->
<!--Scripts to control app window size, position, and behavior (start)-->
<script language="VBScript">
window.resizeTo 500,300
screenWidth = document.parentwindow.screen.availwidth
screenHeight = document.parentwindow.screen.availheight
posLeft = (screenWidth - 800) / 2
posTop = (screenHeight - 600) / 2
window.moveTo posLeft, posTop
</script>
<!--Scripts to control app window size, position, and behavior (end)-->
<!--Features of app window (start)-->
<HTA:APPLICATION ID="download tool"
APPLICATIONNAME="download tool
version="ver.2020.4.13"
CAPTION="yes"
BORDER="thin"
BORDERSTYLE="none"
ICON=""
CONTEXTMENU="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
NAVIGABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal">
</head>
<!--Features of app window (end)-->
<body style="display: inline-block;" id="mainBody" >
<div id="Menu" style="display: inline;"><br>
<center>
<span style="display:inline-block;" id="Span_APIText">
<center>
<Span style="display: inline-block;">
<span >
<textarea style="width:70%;" class="apitextarea" name="txtPS3SerialEntry" rows=6 id="txtPS3SerialEntry"/></textarea>
</span>
<span id="Span_Buttons2" style="display: inline-block;">
<br><br><button id="GetGameDataBtn" title="Browse for download directory" onclick="dataValidation()"><br>Download</button>
</span>
</span>
</center>
</span>
</center>
</div>
</div>
</body>
</html>
<script language="VBScript">
'=================================================
Function dataValidation()
'on error resume next
noBlanks = ""
EntryTest = trim(ucase(document.getelementbyID("txtPS3SerialEntry").value))
if EntryTest = "" then
alert "No valid API numbers found in list"
exit function
elseif EntryTest <> "" then
document.getelementbyID("txtPS3SerialEntry").value = replace(EntryTest,",",vblf)
chkBlankLines = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)
else
chkBlankLines = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)
end if
for i = 0 to Ubound(chkBlankLines)
If Len(trim(chkBlankLines(i))) > 0 then
noBlanks = noBlanks & chkBlankLines(i) & vbcrlf
End If
Next
if noBlanks = "" then
alert "No valid API numbers found in list"
exit function
Else
document.getelementbyID("txtPS3SerialEntry").value = trim(noBlanks)
End If
chkNumeric = split(document.getelementbyID("txtPS3SerialEntry").value,vblf)
call getFiles()
end function
'========================================================
Sub ccSleep(seconds)
set oShell = CreateObject("Wscript.Shell")
cmd = "%COMSPEC% /c ping -n " & 1 + seconds & " 127.0.0.1>nul"
oShell.Run cmd,0,1
End Sub
'============================================================
Function ConvertSize(byteSize)
dim Size
Size = byteSize
Do While InStr(Size,",") 'Remove commas from size
CommaLocate = InStr(Size,",")
Size = Mid(Size,1,CommaLocate - 1) & _
Mid(Size,CommaLocate + 1,Len(Size) - CommaLocate)
Loop
Suffix = " Bytes"
If Size >= 1024 Then suffix = " KB"
If Size >= 1048576 Then suffix = " MB"
If Size >= 1073741824 Then suffix = " GB"
If Size >= 1099511627776 Then suffix = " TB"
Select Case Suffix
Case " KB" Size = Round(Size / 1024, 1)
Case " MB" Size = Round(Size / 1048576, 1)
Case " GB" Size = Round(Size / 1073741824, 1)
Case " TB" Size = Round(Size / 1099511627776, 1)
End Select
ConvertSize = Size & Suffix
End Function
'========================================================================
'Main Function Start
'========================================================================
function GetFiles()
'on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
path = "c:\Downloads" 'fso.BuildPath("c:\Downloads","")
If NOT fso.FolderExists(path & "\") then
fso.CreateFolder(path & "\")
end if
arrStr = split(ucase(document.getelementbyID("txtPS3SerialEntry").value),vbLf)
APICount = Ubound(arrStr)
for i = 0 to Ubound(arrStr)
API = trim(arrStr(i))
if API <> "" then
Set IE = CreateObject("internetexplorer.application")
IE.Visible = false
IE.Navigate replace("https://a0.ww.np.dl.playstation.net/tpl/np/{game_id}/{game_id}-ver.xml","{game_id}",API)
Do While IE.Busy or IE.ReadyState <> 4: ccSleep(1): Loop
Do Until IE.Document.ReadyState = "complete": ccSleep(1): Loop
on error resume next
ie.document.getelementbyid("overridelink").click
on error goto 0
Do While IE.Busy or IE.ReadyState <> 4: ccSleep(1): Loop
Do Until IE.Document.ReadyState = "complete": ccSleep(1): Loop
'============================================================
id = API
'============================================================
'Grab xml elements from site
for each a in ie.document.getelementsbytagname("package")
ps3ver = a.getattribute("ps3_system_ver")
url = a.getattribute("url")
strFileSize = convertsize(a.getattribute("size"))
ver = a.getattribute("version")
strFileName = mid(url,instrrev(url,"/")+1)
'============================================================
filename = "c:\Downloads\" & strFileName
msgbox "Getting file: " & strFileName & " (" & strFileSize & ")"
Set xHttp = createobject("Microsoft.XMLHTTP")
Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", url, false
xHttp.Send
'on error resume next
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile filename, 2 '//overwrite
.close
end with
'on error goto 0
'----------------------------------------------------------------
Next
end if
Next 'APICount
ie.quit
end function
'========================================================================
</script>
Using an Onload command I can output the relevant files from a folder in a messagebox but cannot understand how to use that information to populate a drop down menu in the html code.
Sub Window_onLoad
LoadDropDown
End Sub
Sub LoadDropDown
Dim dir, foundFile
dir = zipfolder
Dim fileNames, fso, folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(dir)
For Each foundFile In folder.Files
fileNames = foundFile.name
If(Right(fileNames,4) = ".zip") then
fileNames = Left(fileNames,(Len(fileNames)-4))
Value = Value & fileNames & vbCr
MsgBox "inside sub Value : " & Value
End If
Next
End Sub
This will display a msgbox for each file found with extension ".zip"
The confusing part is how to display this information (on load) in a drop down menu???
What am I missing from the below?
<select id="test" name="test" onchange="LoadDropDown" style="width: 336px;">
<option value=""></option>
</select>
Thank you in advance for any help!
This is NOT the same as:
How to output all sub-folder to a drop down list in a HTA?
They are not using a file filter and mouseover on populate is NOT what is required or even wanted.
You can try like this to auto-populate your drop down menu :
I have tested this in the temporary folder to populate *.tmp files, so you can change it for your needs
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
Ext = "tmp"
'---------------------------------------------------------------
Sub Window_onLoad
Call LoadDropDown(Dir,Ext)
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
Call ClearListbox()
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = Count & " - " & fileNames
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Based on your last comment
How can i add more than extension file in the dropdown listbox ?
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,ArrayExtensions,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
ArrayExtensions = Array("exe","bat","cmd","vbs","ps1","zip","rar","tmp")
'---------------------------------------------------------------
Sub Window_onLoad
Call ClearListbox()
For each Ext in ArrayExtensions
Call LoadDropDown(Dir,Ext)
Next
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = "[" & Ext & "] - " & Count & " - " & foundFile.Name
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Here is an example:
<html>
<head>
<script language="vbscript">
Sub Init
document.getElementById("option1").innerText = "Sample 1"
document.getElementById("option2").innerText = "Sample 2"
End Sub
</script>
</head>
<body onLoad="Init()">
<select id="test" name="test" style="width: 336px;">
<option id="option1"></option>
<option id="option2"></option>
</select>
</body>
</html>
The following code worked pre-Windows 10 to open a htm file in Internet Explorer set to specific size and screen position. Now in Windows 10 and IE11 I get multiple errors popup and the IE box size and position are not size. Any suggestions?
Batch File
Main()
Sub Main()
Force32bit()
Dim objExplorer : Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "G:\operational.htm"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 280
objExplorer.Height = 1160
objExplorer.Left = 1645
objExplorer.Top = 0
objExplorer.Visible = 1
objExplorer.Menubar = 0
objExplorer.Resizable = 1
End Sub
Sub Force32bit()
If InStr(UCase(WScript.FullName), "SYSTEM32") > 0 and CreateObject("Scripting.FileSystemObject").FolderExists("C:\Windows\SysWOW64") Then
Dim objShell : Set objShell = CreateObject("WScript.Shell")
objShell.CurrentDirectory = "C:\Windows\SysWOW64"
objShell.Run "wscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34), 1, False
End If
End Sub
operational.htm
This is a plain HTML document with shortcut links to resources on the local drive and internet.
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<title>Operator</title>
<link rel="stylesheet" href="../css/styles.css" type="text/css" />
<script type="text/javascript">
tday =new Array("Sun","Mon","Tues","Wed","Thurs","Fri","Sat");
tmonth=new Array("Jan","Feb","March","Apr","May","June","July","Aug","Sept","Oct","Nov","Dec");
function GetClock(){
d = new Date();
nday = d.getDay();
nmonth = d.getMonth();
ndate = d.getDate();
nyear = d.getYear();
nhour = d.getHours();
nmin = d.getMinutes();
if(nyear<1000) nyear=nyear+1900;
if(nmin <= 9){nmin="0"+nmin}
<!--+(nmonth+1)+-->
document.getElementById('clockbox').innerHTML=""+nhour+":"+nmin+"hrs "+tday[nday]+", "+ndate+" "+tmonth[nmonth]+" "+nyear+"";
setTimeout("GetClock()", 1000);
}
window.onload=GetClock;
</script>
<script type="text/javascript">
function hideshow(which){
if (!document.getElementById)
return
if (which.style.display=="block")
which.style.display="none"
else
which.style.display="block"
}
</script>
</head>
<body class="body">
<div id="clockbox""></div>
<br><B>MENU</b>
<h1>Options</h1>
....
</body></html>
I tried this code for testing but get a Windows Script Host error Line 8 Char 1 'unspecified error' error code 80004005.
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate "testing.htm"
objIE.ToolBar = 0
objIE.Menubar = 1
objIE.StatusBar = 0
objIE.Width = 280
objIE.Resizable = 1
objIE.Height = 600
objIE.Top = 10
On Error Resume Next
Do
If objIE.ReadyState = 4 Then
If Err = 0 Then
Exit Do
Else
Err.Clear
End If
End If
WScript.Sleep 10
Loop
On Error Goto 0
How can i assign the text1 value(javascript value) to vbscript variable so that i can write that data into a
text file using ts.WriteLine(av)
I tried submitting the form and getting all the values in the next .asp page and then writing it to a text file,
but my value has many alpha-numeric and special characters....so I cant achieve in that way..any help please.
<% Option Explicit
Const Filename = "/project.txt" ' file to read
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim FSO
set FSO = server.createObject("Scripting.FileSystemObject")
Dim Filepath
Filepath = "E:\applications\FTP\project.txt"
if FSO.FileExists(Filepath) Then
Dim file
set file = FSO.GetFile(Filepath)
Dim TextStream
Set TextStream = file.OpenAsTextStream(ForReading, TristateUseDefault)
%>
<form id="ValidForm" action="">
<input type="textbox" name="ac" id="ac" value="">
<textarea rows="100" cols="230" contenteditable>
<% Do While Not TextStream.AtEndOfStream
Dim Line
Line = TextStream.readline
Line = Line & vbCRLF
Response.write Line
Loop
%>
</textarea>
</form >
<%
Response.Write "</pre><hr>"
Set TextStream = nothing
End If
Set FSO = nothing
%>
<button onclick=abc();>save</button>
<script type="text/javascript" >
function abc()
{alert("1");
var contenteditable = document.querySelector('[contenteditable]'),
text1 = contenteditable.textContent;
//document.getElementById("ac").value=text1;
alert(text1);
}
</script>
<%
'what i should add here to get the javascript variable(text1)
set fs=Server.CreateObject("Scripting.FileSystemObject")
set ts = fs.CreateTextFile("E:\\applications\\FTP\\shivan123.txt",true)
ts.WriteLine("This is my first FileSystemObject application.")
ts.WriteLine( )
ts.Close()
set ts=nothing
set fs=nothing
%>
OK, I have a nifty VBS that will search huge log files for certain character strings, but I don't always want to search every log file for every string. I'd like an HTA frontend that allows the end user to select what strings they want to look for.
Here is a sample of my code and it works great as a vb, but in this example, i'd like checkboxes for cows, goats, cats, dogs, etc.. and for the script to run correctly no matter how many are selected.. (my actual script has about 20 words to choose from) and also the path and name of the 'animal log file' is currently an input box.. i'd like that in the hta as well.
Const ForReading = 1
Dim words(7)
Dim msg
words(0) = "cows"
words(1) = "goats"
words(2) = "cats"
words(3) = "dogs"
words(4) = "elephants"
words(5) = "giraffes"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strAnswer = InputBox("Please enter the path & filename for the animal log file:", _
"Create File")
Wscript.Echo strAnswer
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
WScript.Echo "Done!"
This can get you started. You will need to code in how to handle if multiple checkboxes are selected and the code logic required to open those log files (multiple log files). You can find more info about HTAs here, http://technet.microsoft.com/en-us/scriptcenter/dd742317.aspx
<html>
<head>
<title>My Logfile App</title>
<HTA:APPLICATION
APPLICATIONNAME="My Logfile App"
ID="MyLogfileApp"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
window.resizeto 300,300
End Sub
Sub Start_Button()
Const ForReading = 1
Dim objFSO, objFile, inFile, strAnswer
strAnswer = ""
If chkCows.Checked Then strAnswer = "Cows"
If chkGoats.Checked Then strAnswer = "Goats"
If chkCats.checked Then strAnswer = "Cats"
If chkDogs.Checked Then strAnswer = "Dogs"
If chkElephants.Checked Then strAnswer = "Elephants"
If chkGiraffes.Checked Then strAnswer = "Giraffes"
'If strAnswer is empty then nothing was checked.
If strAnswer = "" Then
Window.Alert "Please Make an Selection!"
Exit Sub
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
Window.Alert "Done!"
End Sub
</script>
<body bgcolor="white">
<center>
<label>Choose your logfile below.</label><br />
</center>
<input type="checkbox" name="chkCows" id="chkCows">Cows<br />
<input type="checkbox" name="chkGoats" id="chkGoats">Goats<br />
<input type="checkbox" name="chkCats" id="chkCats">Cats<br />
<input type="checkbox" name="chkDogs" id="chkDogs">Dogs<br />
<input type="checkbox" name="chkElephants" id="chkElephants">Elephants<br />
<input type="checkbox" name="chkGiraffes" id="chkGiraffes">Giraffes<br />
<p>
<center>
<input type="button" name="btnStart" id="btnStart" value="Start" onclick="Start_Button">
</center>
</body>
</html>