Updating Text Area with Status in HTA [duplicate] - vbscript

In several of my .HTA scripts that I created, I had the need for the VBScript WScript.Sleep command which simply waits for a number of milliseconds without utilizing the CPU.
And when I browse the web, it appears that I am not the only one looking for this:
https://www.google.nl/search?q=hta+sleep
(I bet that if you read this, you probably need(ed) this as well)
The best solution that I could find appears to be the one which uses the PING command.
But especially for a situation were just need to pause the script for a few 100ms, this solution is quiet odd as it uses an external command and triggers all kind of (network) processes that unlikely have anything to do with the concerned .HTA script.
So the first thing that came to my mind was to use the WMI Win32_PingStatus class to avoid the external command but then I started to question why not completely basing it on WMI.
It has taken me several hours to get the right WMI classes and methods in place, but finally I succeeded…

When writing HTA's you should be thinking asynchronously. Consider rewriting your code to use window.setTimeout. In the following example, I will use window.setTimeout to make a bell sound every 2 seconds:
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="x-ua-compatible" content="ie=8">
<title>Bell Test</title>
<script language="VBScript">
Option Explicit
Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
Sub DoPing
divText.innerText = Now
objWShell.Run "%COMSPEC% /c ECHO " & Chr(7), 0, False
window.setTimeOut "DoPing", 2000
End Sub
Sub window_OnLoad
window.ResizeTo 240,130
DoPing
End Sub
</script>
</head>
<body>
<div id="divText">TEST</div>
</body>
</html>

I had the same problem with HTA.
My solution with vbs ...
Sub sleep (Timesec)
Set objwsh = CreateObject("WScript.Shell")
objwsh.Run "Timeout /T " & Timesec & " /nobreak" ,0 ,true
Set objwsh = Nothing
End Sub
' example wait for 3 seconds
sleep 3
The routine will call a shell command, minimized and without a keyboard command.
Only ^C is permitted, but this will no user given in these situation.

Sub Sleep(iMilliSeconds)
With GetObject("winmgmts:\\.\root\cimv2")
With .Get("__IntervalTimerInstruction").SpawnInstance_()
.TimerId = "Sleep"
.IntervalBetweenEvents = iMilliSeconds
.Put_()
End With
.ExecNotificationQuery("SELECT * FROM __TimerEvent WHERE TimerId='Sleep'").NextEvent
End With
End Sub
Added 2015-02-11:
Unfortunately, this function doesn’t work when using Internet Explorer 10 (see comments below).
With Internet Explorer 11 installed, it appears to work if you run the HTA as administrator.

Wait(2000) 'pauses 2 seconds
Sub Wait(Time)
Dim wmiQuery, objWMIService, objPing, objStatus
wmiQuery = "Select * From Win32_PingStatus Where Address = '1.1.1.1' AND Timeout = " & Time
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)
For Each objStatus in objPing
Next
End Sub

Sub Sleep (ms)
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sFilePath: sFilePath = fso.GetSpecialFolder(2) & "\WScriptSleeper.vbs"
If Not fso.FileExists(sFilePath) Then
Set oFile = fso.CreateTextFile(sFilePath, True)
oFile.Write "wscript.sleep WScript.Arguments(0)"
oFile.Close
End If
Dim oShell: Set oShell = CreateObject("WScript.Shell")
oShell.Run sFilePath & " " & ms, 1, True
End Sub

Related

Why does this small vbscript to change desktop background work intermittently, not all the time?

A small VBscript in order to change the desktop background automatically, practically for demo purposes:
dim wshShell
dim sUserName
Set wshShell = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("WScript.Shell")
currWallPaper = oShell.RegRead("HKCU\Software\Microsoft\InternetExplorer\Desktop\General\Wallpap erSource")
If currWallPaper = "C:\Users\Utsav\Pictures\493889.png" Then
msgbox "OK1"
sWallPaper = "C:\Users\Utsav\Pictures\336180.png"
ElseIf currWallPaper = "C:\Users\Utsav\Pictures\336180.png" Then
sWallPaper = "C:\Users\Utsav\Pictures\1920-1080-278658.png"
Else
sWallPaper = "C:\Users\Utsav\Pictures\493889.png"
End If
' update in registry
oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", sWallPaper
' let the system know about the change
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
msgbox "done"
This script works only intermittently, i.e. on executing from command line it will change the background only once in about 4-5 attempts. Any ideas explaining the reason for this behaviour would be most welcome.

object top in VBScript

Me and my teammate is getting hammered by this mystery.
While we are tracing some codes, we encounter something like this
top.VARIABLE_NAME
top.FunctionName(param)
We tried to trace the code for the object top, but it was not declared anywhere in the project, so we thought that it was a VBScript built-in object for global variables but there is not documentation for it.
so far we notice this line of code
ExecuteGlobal(strCode)
can this be the cause of that top object? please help us to understand this.
Update
It is weird but the HTML of our current project contains a lot of frames. but I don't know if that's the reason of using "top".
Here is the complete code/implementation for ExecuteGlobal(strCode)
Sub Import(ByVal strFile)
Dim objFs
Dim WshShell
Dim objFile
Dim strCode
Set objFs = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
WshShell.CurrentDirectory = "E:\MyFiles\Documents\Dev\Tester\VBS\haha"
Set objFile = objFs.OpenTextFile(strFile)
strCode = objFile.ReadAll
objFile.Close
ExecuteGlobal(strCode)
End Sub
if I print strCode, it contains this value.
sub HtmlCreator(arrObj)
for i = LBound(arrObj) to UBound(arrObj)
if not isEmpty(arrObj(i)) then
arrObj(i).innerHtml = "me"
end if
next
end sub
sorry I can't post the exact code because of confidentiality but I hope you get the idea.
THANKS..
top is the top level window in the DOM hierarchy.
Demo:
<html>
<head>
<script type="text/vbscript">
MsgBox TypeName(window.top) & " " & CStr(window.top Is top) & " " & CStr(window Is top)
</script>
</head>
<body>
</body>
</html>

VB script works on Windows XP but not in Windows 7

I have a simple VBScript that I use in my webpage to rotate images located in a folder named "media\rotate". My script works fine when I run it in Windows XP but it does not work if I run it from Windows 7. I am using Windows 7 32Bit, while my Windows XP is a Service Pack 3.
My script looks like this:
Dim gRotatorFiles, gFileCount, gFileIndex
gFileCount = 0
gFileIndex = 1
Sub LoadRotatorImages()
Dim oFileSystem, oFolder, oFile
Set gRotatorFiles = CreateObject("POSCommonObjects.POSCollection")
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
If oFileSystem.FolderExists("C:\Program Files\Customer Display\media\rotate") Then
Set oFolder = oFileSystem.GetFolder("C:\Program Files\Customer Display\media\rotate")
If Not oFolder Is Nothing Then
If Not oFolder.Files Is Nothing Then
For Each oFile In oFolder.Files
gRotatorFiles.Add oFile.Path, oFile.Name
Next
End If
End If
End If
gFileCount = gRotatorFiles.Count
Set oFileSystem = Nothing
Set oFolder = Nothing
Set oFile = Nothing
End Sub
Sub RotateImages()
If gFileCount > 0 Then
gFileIndex = gFileIndex + 1
If gFileIndex >= gFileCount Then
gFileIndex = 1
End If
LoadCurrentImage()
window.setTimeout "RotateImages()", 10000
End If
End Sub
Sub LoadCurrentImage()
document.all("AdImage").Filters(0).Apply
document.all("AdImage").src = gRotatorFiles(CInt(gFileIndex))
document.all("AdImage").Filters(0).Play
End Sub
Then I call it in my page like this:
<script language="vbscript" src="RotateImages.vbs"></script>
<script language="vbscript">
Sub Window_OnLoad()
RotateImages()
End Sub
</script>
And in the body:
<img id="AdImage" style="FILTER: prodig:DXImageTransform.Microsoft.GradientWipe(duration=2)" src="">
I wonder if someone knows what the inconsistencies between those operating systems might cause these issues or if it is something in my code.
To base the trouble shooting on something testable:
' On Error Resume Next
' global var used by LoadRotatorImages() and RotateImages()
Dim gRotatorFiles
' preparation: init gRotatorFiles
Sub LoadRotatorImages()
' Set gRotatorFiles = CreateObject("POSCommonObjects.POSCollection")
Set gRotatorFiles = CreateObject("System.Collections.ArrayList")
' Set gRotatorFiles = CreateObject("System.Collection.ArrayList")
gRotatorFiles.Add "fi"
gRotatorFiles.Add "fa"
gRotatorFiles.Add "fo"
End Sub
' real work: using gRotatorFiles
Sub RotateImages()
For Each f In gRotatorFiles
WScript.Echo f
Next
End Sub
' Then I call it in my page like this:
' but I forgot to call LoadRotatorImages()
LoadRotatorImages()
RotateImages()
output:
cscript 23547130.vbs
fi
fa
fo
First shot:
In the code you posted, you don't call LoadRotatorImages(). If adding this call does not fix your problem, disable the EVIL global OERN I suspect in your code and publish error messages.
Second shot:
"Not getting errors" is caused by an EVIL On Error Resume Next or (perhaps; I don't use IE) by some "Keep quiet about errors" setting(s) in the Internet Options. Evidence: If you activate the OERN and the bad CreateObject in the demo code, you get no output at all. After disabling The OERN again, you get a can't create object: 'System.Collection.ArrayList' message.
It's up to you whether you use OERN in your production code, but you shouldn't ask questions here without having tested your code without OERN (or equivalent IE settings).
If the code runs with neither error nor output even when "break on error" is on, try to add diagnostics for important pre-requisites. E.g.
' On Error Resume Next
...
Set gRotatorFiles = CreateObject("System.Collections.ArrayList")
' Set gRotatorFiles = CreateObject("System.Collection.ArrayList")
WScript.Echo "****", TypeName(gRotatorFiles)
...
results in:
cscript 23547130.vbs
**** ArrayList
If TypeName(gRotatorFiles) does not delivers something reasonable
double check the installation of the component
consider using a 'more native' collection (Scripting.Dictionary, ArrayList, ...)

Use clipboard from VBScript

I am looking for a method to place some text onto the clipboard with VBScript. The VBScript in question will be deployed as part of our login script. I would like to avoid using anything that isn't available on a clean Windows XP system.
Edit:
In answer to the questions about what this is for.
We wanted to encourage users inside our organization to use the file server to transfer documents instead of constantly sending attachments by email. One of the biggest barriers to this is that it isn't always obvious to people what the correct network path is to a file/folder. We developed a quick script, and attached it to the Windows context menu so that a user can right click on any file/folder, and get a URL that they can email to someone within our organization.
I want the URL displayed in the dialog box to also be placed onto the clipboard.
GetNetworkPath
Another solution I have found that isn't perfect in my opinion, but doesn't have the annoying security warnings is to use clip.exe from a w2k3 server.
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo hello world | clip", 0, TRUE
Example with a multiline string as per question below :
Link1
Dim string
String = "text here" &chr(13)& "more text here"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo " & String & " | clip", 0, TRUE
Using Microsoft's clip.exe is the closest to having a clean Windows XP system solution. However you don't have to call CMD.EXE to host it in order to use it. You can call it directly and write to its input stream in your script code. Once you close the input stream clip.exe will write the contents straight to the clipboard.
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("clip")
Set oIn = oExec.stdIn
oIn.WriteLine "Something One"
oIn.WriteLine "Something Two"
oIn.WriteLine "Something Three"
oIn.Close
If you need to wait for clip to be finished before your script can continue processing then add
' loop until we're finished working.
Do While oExec.Status = 0
WScript.Sleep 100
Loop
And don't forget to release your objects
Set oIn = Nothing
Set oExec = Nothing
The closest solution I have found so far is a method to use IE to get and set stuff on the clipboard. The problem with this solution is the user gets security warnings. I am tempted to move 'about:blank' to the local computer security zone so I don't get the warnings, but I am not sure what the security implications of that would be.
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", "Hello This Is A Test"
objIE.Quit
http://www.microsoft.com/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx
No security warnings, full let and get access:
'create a clipboard thing
Dim ClipBoard
Set Clipboard = New cClipBoard
ClipBoard.Clear
ClipBoard.Data = "Test"
Class cClipBoard
Private objHTML
Private Sub Class_Initialize
Set objHTML = CreateObject("htmlfile")
End Sub
Public Sub Clear()
objHTML.ParentWindow.ClipboardData.ClearData()
End Sub
Public Property Let Data(Value)
objHTML.ParentWindow.ClipboardData.SetData "Text" , Value
End Property
Public Property Get Data()
Data = objHTML.ParentWindow.ClipboardData.GetData("Text")
End Property
Private Sub Class_Terminate
Set objHTML = Nothing
End Sub
End Class
Example Usage.
' Create scripting object
Dim WShell, lRunUninstall
Set WShell = CreateObject("WScript.Shell")
WShell.sendkeys "^c"
WScript.Sleep 250
bWindowFound = WShell.AppActivate("Microsoft Excel")
WShell.sendkeys ClipBoard.Data
To avoid the security warnings associated with Internet Explorer and clipboard access, I would recommend you use the Word application object and its methods to put your data onto the clipboard. Of course you can only use this on a machine that has MS Word installed, but these days that's most of them. (*In spite of the fact that you asked for stuff on a 'clean' system :) *)
' Set what you want to put in the clipboard '
strMessage = "Imagine that, it works!"
' Declare an object for the word application '
Set objWord = CreateObject("Word.Application")
' Using the object '
With objWord
.Visible = False ' Don't show word '
.Documents.Add ' Create a document '
.Selection.TypeText strMessage ' Put text into it '
.Selection.WholeStory ' Select everything in the doc '
.Selection.Copy ' Copy contents to clipboard '
.Quit False ' Close Word, don't save '
End With
You can find detail on the MS Word application object and its methods here: http://msdn.microsoft.com/en-us/library/aa221371(office.11).aspx
Microsoft doesn't give a way for VBScript to directly access the clipboard. If you do a search for 'clipboard'on this site you'll see:
Although Visual Basic for Applications supports the Screen, Printer, App, Debug, Err, and Clipboard objects, VBScript supports only the Err object. Therefore, VBScript does not allow you to access such useful objects as the mouse pointer or the clipboard. You can, however, use the Err object to provide runtime error handling for your applications.
So using notepad indirectly is probably about the best you'll be able to do with just VBScript.
Here's another version of using the "clip" command, which avoids adding a carriage return, line feed to the end of the string:
strA= "some character string"
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /C echo . | set /p x=" & strA & "| c:\clip.exe", 2
s = "String: """ & strA & """ is on the clipboard."
Wscript.Echo s
I've only tested this in XP. clip.exe was downloaded from Link and placed in C:\.
I've found a way to copy multi line information to clipboard by vbscript/cmd.
Sequence:
with VBS generate the final "formatted string" that you need copy to clipboard
generate a (txt) file with the "formatted string"
use type command from cmd to paste information to clip by pipe
Example script:
Function CopyToClipboard( sInputString )
Dim oShell: Set oShell = CreateObject("WScript.Shell")
Dim sTempFolder: sTempFolder = oShell.ExpandEnvironmentStrings("%TEMP%")
Dim sFullFilePath: sFullFilePath = sTempFolder & "\" & "temp_file.txt"
Const iForWriting = 2, bCreateFile = True
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.OpenTextFile(sFullFilePath, iForWriting, bCreateFile)
.Write sInputString
.Close
End With
Const iHideWindow = 0, bWaitOnReturnTrue = True
Dim sCommand: sCommand = "CMD /C TYPE " & sFullFilePath & "|CLIP"
oShell.Run sCommand, iHideWindow, bWaitOnReturnTrue
Set oShell = Nothing
Set oFSO = Nothing
End Function
Sub Main
Call CopyToClipboard( "Text1" & vbNewLine & "Text2" )
End Sub
Call Main
The easiest way is to use built-in mshta.exe functionality:
sText = "Text Content"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True
To put to clipboard a string containing double quote char ", use the below code:
sText = "Text Content and double quote "" char"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(Replace(sText, "\", "\\"), """", """"""), "'", "\'") & "'.replace('""""',String.fromCharCode(34)));close();""", 0, True
Take a look at this post. It describes a hacky approach to read from the clipboard, but I imagine it could be adapted to also write to the clipboard as well, such as changing the Ctrl+V to Ctrl+A then Ctrl+C.
I devised another way to use IE and yet avoid security warnings...
By the way.. this function is in JavaScript.. but u can easily convert it to VBScript..
function CopyText(sTxt) {
var oIe = WScript.CreateObject('InternetExplorer.Application');
oIe.silent = true;
oIe.Navigate('about:blank');
while(oIe.ReadyState!=4) WScript.Sleep(20);
while(oIe.document.readyState!='complete') WSript.Sleep(20);
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>";
var oTb = oIe.document.getElementById('txtArea');
oTb.value = sTxt;
oTb.select();
oTb = null;
oIe.ExecWB(12,0);
oIe.Quit();
oIe = null;
}
Here is Srikanth's method translated into vbs
function SetClipBoard(sTxt)
Set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.value = sTxt
oTb.select
set oTb = nothing
oIe.ExecWB 12,0
oIe.Quit
Set oIe = nothing
End function
function GetClipBoard()
set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.focus
oIe.ExecWB 13,0
GetClipBoard = oTb.value
oTb.select
set oTb = nothing
oIe.Quit
Set oIe = nothing
End function
In your Class ClipBoard, neither the Clear sub nor the Let Data sub work. I mean they have no effect on Windows Clipboard. Actually, and ironically so, the only sub that works is the one you have not included in your example, that is Get Data! (I have tested this code quite a few times.)
However, it's not your fault. I have tried to copy data to clipboard with ClipboardData.SetData and it's impossible. At least not by creating an "htmlfile" object. Maybe it works by creating an instance of "InternetExplorer.Application" as I have seen in a few cases, but I have not tried it. I hate creating application instances for such simple tasks!
Alkis
If it's just text can't you simply create a text file and read in the contents when you need it?
Another alternative and clearly a kludge, would be to use the SendKeys() method.
No security warnings and no carriage return at the end of line
' value to put in Clipboard
mavaleur = "YEAH"
' current Dir
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
' Put the value in a file
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile=GetPath & "fichier.valeur"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write mavaleur
objFile.Close
' Put the file in the Clipboard
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c clip < " & outFile, 0, TRUE
' Erase the file
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile outFile

WScript.Shell and blocking execution?

I'm using WScript to automate some tasks, by using WScript.Shell to call external programs.
However, right now it does not wait for the external program to finish, and instead moves on. This causes issues because I have some tasks dependent on others finishing first.
I am using code like:
ZipCommand = "7za.exe a -r -y " & ZipDest & BuildLabel & ".zip " & buildSourceDir
Set wshShell = WScript.CreateObject("Wscript.Shell")
wshShell.run ZipCommand
Is there a way to do this so it blocks until the shell executed program returns?
Turns out, that while loop is severe CPU hog :P
I found a better way:
ZipCommand = "7za.exe a -r -y " & ZipDest & BuildLabel & ".zip " & buildSourceDir
Set wshShell = WScript.CreateObject("Wscript.Shell")
wshShell.Run ZipCommand,1,1
The last two arguments are Show window and Block Execution :)
If you use the "Exec" method, it returns a reference, so you can poll the "Status" property to determine when it is complete. Here is a sample from msdn:
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(ZipCommand)
Do While oExec.Status = 0
WScript.Sleep 100
Loop

Resources