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
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>
I am currently working on a game launcher and have working code borrowed from the Internet to be able to parse an INI. All is working excellently save for one issue.
It cannot parse inline comments on the ini file.
Example:
[Window]
Width=800
Is parsed fine and without issue, great.
[Window]
Width=800 ; width in pixels
But the above is not, I need it to be able to stop reading the line at detecting a ; if possible.
Here is my full HTA code:
<Html>
<Head>
<Title>Installer</Title>
<Meta Http-Equiv="x-ua-compatible" Content="ie=9">
<Link Rel="stylesheet" Type="text/css" Href="image/appStyles.css" Media="screen" />
<Script Language="VBScript" Type="Text/VBScript">
'-- Scripts to be carried out before the installer loads in.
'-- Functions --'
Function ReadIni( myFilePath, mySection, myKey )
' This function returns a value read from an INI file
' Examples
' ReadIni( "settings.config", "Section1", "Keyname1" )
' ReadIni( "settings.config", "Section1", "Keyname2" )
' ReadIni( "settings.config", "Section2", "Keyname1" )
' ReadIni( "settings.config", "Section4", "Keyname2" )
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
' Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
' Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
' Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
' Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
' In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
' Abort loop when item is found
Exit Do
End If
End If
' Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
' Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
Else
' WScript.Echo strFilePath & " doesn't exists. Exiting..."
' Wscript.Quit 1
End If
End Function
'-- Subroutines --'
'-- Resize & move app to center
Sub SetWindow( WidthX,HeightY )
Self.ResizeTo WidthX, HeightY
Self.MoveTo (screen.Width - WidthX)/2, (screen.Height - HeightY)/2
End Sub
'-- Close app
Sub WinClose
Self.Close
End Sub
'-- Startup --'
'-- Read the configuration settings.
IniFile = "settings.config"
WinWidth = ReadIni( IniFile, "Window", "Width" )
WinHeight = ReadIni( IniFile, "Window", "Height" )
'-- Set Window size
SetWindow WinWidth, WinHeight
</Script>
<Hta:Application Id="Installer" ApplicationName="Installer" Version="0.1"
SingleInstance="Yes"
Icon="image/appIcon.ico"
Caption="No"
Border="None"
InnerBorder="No"
ContextMenu="No"
SysMenu="None"
Scroll="No"
Selection="No"
/>
</Head>
<Body>
<Div Id="status">Hello</Div>
<Script Language="VBScript" Type="Text/VBScript">
'-- Scripts that require access to the DOM...
'-- Startup
document.getElementById("status").InnerHTML = "Idle"
document.title = ReadIni( IniFile, "App", "Title" )
</Script>
<Script Type="Text/Javascript">
//-- Javascripts that require access to the DOM...
window.onload = function() {
var a = document.getElementsByTagName("img");
a.ondragstart = function() { return false; }
}
</Script>
</Body>
</Html>
Any help you guys could provide would be great, thank you!
WinWidth = Trim(Split(ReadIni( IniFile, "Window", "Width" ), ";")(0))
Split the value using the semicolon, take the first element in the list and remove start/end spaces if present
<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
Just wondering how i could have a MSgbox that displays the value of a variable as it constantly changes. Basically a number has one added to it everytime it loops. I want to display that in a MSGbox that doesnt have to open a million windows
A workaround would be to use PopUp
Set objShell = WScript.CreateObject("WScript.Shell")
For i = 1 To 3
objShell.Popup i, 1, "AutoClose MsgBox Simulation", vbInformation+vbOKOnly
Next
This will "autoclose" the MsgBox lookalike after 1 second
You can't do this with the default VBScript dialog elements, like MsgBox, WScript.Echo or Popup. You need to build a custom dialog using the Internet Explorer COM object:
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "about:blank"
While ie.ReadyState <> 4 : WScript.Sleep 100 : Wend
ie.ToolBar = False
ie.StatusBar = False
ie.Width = 300
ie.Height = 200
ie.document.body.innerHTML = "<p id='msg'>0</p>"
Set style = ie.document.CreateStyleSheet
style.AddRule "p", "text-align: center;"
ie.Visible = True
i = 1
Do
ie.document.getElementById("msg").innerText = i
i = i + 1
WScript.Sleep 2000
Loop Until i > 10
or use an HTA instead of plain VBScript:
<head>
<title>Test</title>
<HTA:APPLICATION ID="oHTA"
APPLICATIONNAME="Test"
SCROLL="no"
>
</head>
<style type="text/css">
p {text-align: center;}
</style>
<script language="VBScript">
window.resizeTo 300, 200
Set sh = CreateObject("WScript.Shell")
Sub Window_onLoad
For i = 1 To 10
msg.innerText = i
Sleep 2
Next
End Sub
Sub Sleep(t)
sh.Run "ping -n " & (t+1) & " 127.0.0.1", 0, True
End Sub
</script>
<body>
<p id="msg">0</p>
</body>
One more solution, uses HTA window, without temp files:
dim window, i
set window = createwindow()
window.document.write "<html><body bgcolor=buttonface>Current loop is: <span id='output'></span></body></html>"
window.document.title = "Processing..."
window.resizeto 300, 150
window.moveto 200, 200
for i = 0 to 32767
show i
' your code here
next
window.close
function show(value)
on error resume next
window.output.innerhtml = value
if err then wscript.quit
end function
function createwindow()
' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
dim signature, shellwnd, proc
on error resume next
set createwindow = nothing
signature = left(createobject("Scriptlet.TypeLib").guid, 38)
set proc = createobject("WScript.Shell").exec("mshta about:""<script>moveTo(-32000,-32000);</script><hta:application id=app border=dialog minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=no innerborder=no /><object id='shellwindow' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shellwindow.putproperty('" & signature & "',document.parentWindow);</script>""")
do
if proc.status > 0 then exit function
for each shellwnd in createobject("Shell.Application").windows
set createwindow = shellwnd.getproperty(signature)
if err.number = 0 then exit function
err.clear
next
loop
end function
This script will display how many loops it took and the value of a variable during the loop, and display the results in 1 message box after the loop is complete.
Dim RateOfChange, roc, watchvariable : roc = 1 : watchvariable = 1
for i=1 to 25
watchvariable = (watchvariable * i) * 16
RateOfChange = RateOfChange & "Iteration[" & roc & "]" & " - Value[" & watchvariable & "]" & vbcrlf
roc = roc + 1
next
'NOTE uncomment this below to activate msgbox.
'msgbox rateofchange
wscript.echo rateofchange
I'm trying to create a sort of persistent menu to place at the top of my WinPE image that offers: power off, restart and console access- In that order.
I have tried switching the order, switching names, switching images, changing associations, nothing I do will make more than two work at a time. Either power and admin work and restart doesn't, or restart and power work and admin doesn't, or admin and restart work and power doesn't.
Is there a limit on the amount of image inputs you can have or something?
<SCRIPT LANGUAGE="VBScript">
' Resize and center the window
' ==========================================================
sub DoResize
window.resizeTo 175,75
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 100) / 2
posTop = (screenHeight - 100) / 2
window.moveTo posLeft, posTop
end Sub
DoResize()
' ==========================================================
</SCRIPT>
<HEAD>
<TITLE> </TITLE>
<HTA:APPLICATION ID="oMyApp"
APPLICATIONNAME="Options"
INNERBORDER="no"
BORDER="none"
CAPTION="no"
SCROLL="NO"
SHOWINTASKBAR="NO"
SINGLEINSTANCE="yes"
SYSMENU="NO"
WINDOWSTATE="normal">
</HEAD>
<BODY>
<body background="Options.png">
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Sub Power
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = MsgBox("Shut Down Computer?", vbYesNo, "Power Off")
If ret = 6 Then
objShell.Run "x:\windows\system32\cmd.exe /c wpeutil shutdown", 0, True
ElseIf ret = 7 Then
Exit Sub
End If
End Sub
Sub Reboot
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = MsgBox("Restart Computer?", vbYesNo, "Restart")
If ret = 6 Then
objShell.Run "x:\windows\system32\cmd.exe /c wpeutil reboot", 0, True
ElseIf ret = 7 Then
Exit Sub
End If
End Sub
Sub Admin
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = InputBox("Enter Admin Password", "Password Required")
If ret = "password" Then
objShell.Run "x:\windows\system32\cmd.exe /k"
ElseIf Not ret = "password" Then
MsgBox "Incorrect Password", vbOKOnly, "Access Denied"
End If
End Sub
</SCRIPT>
<input type="image" img src="power.png" name="power" size="48" onclick="Power">
<input type="image" img src="restart.png" name="reboot" size="48" onclick"Reboot">
<input type="image" img src="config.png" name="config" size="48" onclick="Admin">
</BODY>
There's a syntax error in the second <input> tag. Replace
<input type="image" ... onclick"Reboot">
with
<input type="image" ... onclick="Reboot">