This may be the most important thing to keep in mind when scripting — in any language.
Never assume a WSH version.
Check it using WScript.Version!
Read more about WSH versions.
Never assume a Windows version.
Check it!
Never assume Windows' "bittedness" (32-bit vs. 64-bit), test in case it might be critical (i.e. when third party COM objects or external commands are used).
Never even assume the script runs in a 64-bit environment when on 64-bit Windows!
See the paragraph "Test for 32-bit MSHTA.EXE on 64-bit Windows" below to see how you can test this in HTAs.
Never assume .NET Framework is installed.
Check it!
Never assume a script runs with administrative rights.
Check it!
Never assume access to WMI is allowed.
Use custom error handling to check it!
Never assume write access.
Again, check it!
Never assume an open Internet connection.
Check, check, check!
If you create a new instance of an object, use custom error handling with Err and IsObject to check if it was successfully created.
Always check if required extensions are available before trying to use them!
Well, you get the idea...
Use common sense.
Make sure you log any requirements that aren't met, and/or display descriptive error messages.
Always use Option Explicit and declare all variables
It may seem a nuisance to force yourself to declare all variables, but trust me, Option Explicit will save you a lot of time searching for errors caused by typos in variable names.
It will also help you find variables with the wrong scope (local vs. global).
(Temporarily) disable all On Error Resume Next lines
When you're looking for the cause of an error, you do want to see the error messages stating which line in the code generates the error.
So "comment out" any On Error Resume Next lines while testing/debugging.
And whenever you really do need to use On Error Resume Next, check for errors (If Err Then...), and switch back to On Error Goto 0 as soon as possible.
Modularize your scripts with functions and subroutines
Any block of code that will be used more than once can be moved into a subroutine or function.
Dividing the code into logical subroutines and functions will improve readability of your script, and thus will make maintenance a lot easier.
If a "self-contained" subroutine or function has been debugged, it will save debugging time when you reuse it in another script.
If your function or subroutine receives parameters, use distinctive parameter names to avoid conflicts with global variables.
Do not use an existing variable name for a parameter name.
As you may have noticed, I use the prefix my for parameter names in my own scripts.
Choose any naming system you want, but be consistent, and keep in mind that some day others may need to understand your code.
To be completely on the safe side, use ByVal as in
Function MyFunc( ByVal varParameter )
to prevent changing the value of an existing global variable named varParameter in the global scope.
Experiment with Denis St-Pierre's ByVal/ByRef test script to become familiar with the concepts.
Use descriptive names for variables, functions and subroutines
You are (almost) completely free to use any name for a variable, subroutine or function.
However, instead of using a name like f, why not use objFSO for a FileSystem object?
Or Decode instead of dec as a function name?
Imagine what a difference it will make when someone else needs to read and understand your code (or you yourself a couple of months from now...).
By choosing logical, descriptive names, you may also save yourself time while debugging.
You may have noticed that many scripters use the first character, or the first 3 characters, of variable names to specify the data type: objFSO for a (FileSystem) object, intDaysPerWeek for integers, etc.
Though in VBScript any variable can contain any type of data at any time, this naming convention helps make clear what type of data a variable is supposed to contain.
For function or subroutine that receive parameters, use distinctive parameter names to avoid conflicts with global variables.
Using existing variable names for parameter names spells trouble.
As you may have noticed, I use the prefix my for parameter names in my own scripts.
You can choose any naming system you want.
But do keep it consistent.
Keep in mind that some day others may need to understand your code.
Again, to be completely on the safe side, use ByVal as in
Function MyFunc( ByVal varParameter )
to prevent changing the value of an existing global variable named varParameter in the global scope.
I urge you to try Denis St-Pierre's ByVal/ByRef test script to build an understanding of the concepts.
It may save you days of stressful debugging.
Initialize variables
This may be important when you use loop counters other than For loops: make sure the counter variable has a valid value to start with.
Also watch out for global variables that are used in subroutines or functions.
Avoid nested functions
A one-liner like:
strFullPath = "C:\Documents and Settings\Me\Application Data"
strParentName = Right( Left( strFullPath, InStrRev( strFullPath, "\" ) - 1 ), _
Len( Left( strFullPath, InStrRev( strFullPath, "\" ) - 1 ) ) - _
InStrRev( Left( strFullPath, InStrRev( strFullPath, "\" ) - 1 ), "\" ) )
is hard to debug if it returns the wrong result.
Split it up in several lines, each without nested functions, and use variables to contain the intermediate results:
strFullPath = "C:\Documents and Settings\Me\Application Data"
intLastSlash = InStrRev( strFullPath, "\" )
strParentName = Left( strFullPath, intLastSlash - 1 )
intParentLen = Len( strParentName ) - InStrRev( strParentName, "\" )
strParentName = Right( strParentName, intParentLen )
Now, if the code doesn't do what it is supposed to do, you can have a look at the intermediate results to check where the problem lies.
Display or log intermediate results like variable values and return codes
To check the script's program flow, and the values of variables during execution, it helps to display variable names and their values during run time.
If external commands or objects are used, display their return codes as well.
Write every detail in a log file too, preferably with a timestamp in order to detect possible delays.
If subroutines or (user defined) functions are used, log each call to these subroutines, it will help you follow the program flow.
If I expect problems with a script, I often add an optional /DEBUG command line switch, which will tell the script to log even more details.
Create and use a debug window (obsolete as of June 15, 2022)
This is a trick I learned from Don Jones, who describes it in his book VBScript, WMI, and ADSI Unleashed: Using VBScript, WMI, and ADSI to Automate Windows Administration.
Dim objIEDebugWindow
Debug "This is a great way to display intermediate results in a separate window."
Sub Debug( myText )
' Uncomment the next line to turn off debugging
' Exit Sub
If Not IsObject( objIEDebugWindow ) Then
Set objIEDebugWindow = CreateObject( "InternetExplorer.Application" )
objIEDebugWindow.Navigate "about:blank"
objIEDebugWindow.Visible = True
objIEDebugWindow.ToolBar = False
objIEDebugWindow.Width = 200
objIEDebugWindow.Height = 300
objIEDebugWindow.Left = 10
objIEDebugWindow.Top = 10
Do While objIEDebugWindow.Busy
WScript.Sleep 100
Loop
objIEDebugWindow.Document.Title = "IE Debug Window"
objIEDebugWindow.Document.Body.InnerHTML = "<b>" & Now & "</b></br>"
End If
objIEDebugWindow.Document.Body.InnerHTML = objIEDebugWindow.Document.Body.InnerHTML & myText & "<br />" & vbCrLf
End Sub
Notes:
Notes:(1)Since Internet Explorer support ended June 15, 2022, this technique is no longer recommended.
(2)objIEDebugWindowmust be declared in the main script body, not in the subroutine (must be global)!
(3)Do not discard the objIEDebugWindow object at the end of the script, or your debug window will vanish!
And this is what the debug window looks like:
Use a VBScript aware editor or IDE
with built-in debugger and object browser
There are several VBScript aware editors (IDEs) available, some with built-in debugger.
The main advantages of these editors are:
Different colors for commands and keywords: a typo will result in the wrong color
IntelliSense ™ like "intelligence" and object browser: type a dot after an object name and you'll get a drop-down list of available properties and methods
Built-in debugger: run the script "inside" the editor, add breakpoints, monitor variable values, get improved error handling
My personal favorite is VbsEdit, which saves me a lot of time and frustration when writing in VBScript.
Because there are more editors and more scripting languages, I compiled a list of script editors and IDEs.
Document your scripts with useful comments
It is always wise to add comments explaining what a script, or part of the script, does.
However, make sure the comments are relevant for future use — scripts need maintenance every now and then, and comments can help make this easier.
If you intend to reuse code, like subroutines or user defined functions, it is essential to describe the functionality in comments.
Include a description of what the routine is intended for, its requirements, input parameters, output and/or return codes.
In short, describe it as a "black box": what goes in, what comes out, and how are the two related.
Use custom error handling
It is ok to use the scripting engine's built-in error handling, but adding your own custom error handling may result in a better "user experience".
Insert a line On Error Resume Next just before some code that might cause trouble.
Insert another block of code after that suspect code to deal with potential errors.
Use Err or Err.Number and Err.Description to detect and log and maybe even correct errors.
If no more problems are expected, insert a line On Error Goto 0 after the custom error handling code to restore the default built-in error handling.
On Error Resume Next
' some code that might raise an error
If Err Then
WScript.Echo "Error # " & Err.Number
WScript.Echo Err.Description
' take some action, or in this case, abort the script with return code 1
WScript.Quit 1
End If
Clean up
It is usually advisable to clean up any leftover objects at the end of the script.
Objects like the FileSystem object, Internet Explorer and others may cause memory leaks if they aren't discarded and new instances are being opened all the time.
Just make sure to add a Set objectName = Nothing line at each "exit" (just before each WScript.Quit) and end of the program flow.
Objects that are "created" inside a subroutine or function should always be discarded at the end of the routine.
A known exception to this rule is the Internet Explorer Debug Window discussed before.
Check the WSH version
Ok, so you wrote your script, tested it on your own computer, maybe even on multiple computers, and everything seems to work fine.
Does that mean your script is ready to be distributed?
Would I ask if it were? 😉
No, we are not done yet.
A final screening is necessary to find out the minimum WSH version required to run the script.
Browse through your script and for each command you used, look up the WSH version required in MSDN's VBScript Version Information tables (JScript Version Information is available too).
The WSH version required for a particular command can be found in the page's second table.
Note:
Note:Besides using the MSDN links above, you can also use the WSH documentation in .chm format
Write down any required WSH version greater than 1.0.
The highest/latest version you wrote down is the minimum WSH version required to run your script.
Now check the VBScript Version Information page's first table to see if the minimum WSH version requirement is met by all client computers you had in mind...
In case you aren't sure about the client computers, you can make your script itself perform a check, using:
intMajorVerion = 0 + CInt( Mid( WScript.Version, 1, InStr( WScript.Version, "." ) - 1 ) )
intMinorVerion = 0 + CInt( Mid( WScript.Version, InStr( WScript.Version, "." ) + 1 ) )
intCheckVersion = 1000 * intMajorVerion + intMinorVerion
If intCheckVersion < 5005 Then
WScript.Echo "Sorry, this script requires WSH 5.5 or later"
WScript.Quit intCheckVersion
End If
Note:
Note:Yes, this check is safe, all commands and functions used were available in the very first WSH version
Use a debugger, if available
This tip was sent by Tom Hoff: use CSCRIPT //X yourscript.vbs to execute your script in a debugger.
You will be prompted to choose a debugger from a list of available debuggers.
Debuggers that can be used for VBScript include (but are, most likely, not limited to):
Microsoft Script Debugger
Microsoft Script Editor (comes with Microsoft Office)
Visual Studio's debugger
For HTAs only:
Test for 32-bit MSHTA.EXE on 64-bit Windows
Sometimes an HTA can cause trouble when running with 32-bit MSHTA.EXE on a 64-bit Windows.
This is especially true when 64-bit external commands need to be executed: a 32-bit MSHTA process simply cannot start a 64-bit external command.
The following sample code warns the user for this condition when the HTA is loaded:
Sub Window_OnLoad( )
Dim colItems, intMSHTA, intWindows, objItem, objWMIService
' intMSHTA will contain MSHTA.EXE's "bittedness"
intMSHTA = CInt( Right( window.navigator.platform, 2 ) )
' Use WMI to determine Windows' own "bittedness"
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Processor" )
For Each objItem in colItems
' intWindows will contain Windows' "bittedness"
intWindows = CInt( objItem.AddressWidth )
Next
Set objWMIService = Nothing
' Display a warning message if the "bittednesses" don't match
If intWindows <> intMSHTA Then
MsgBox "You are running this HTA with the " _
& intMSHTA _
& "-bit MSHTA on a " _
& intWindows _
& "-bit Windows"
End If
End Sub
Arrays
Sort
Case insensitive bubble sort subroutine
Display
Display the entire array's content on screen
Reverse
Reverse the order of array elements
Sort
Bubble sort algorithm borrowed from the Scripting Guys.
Case insensitive sorting subroutine.
Usage:
Sort array_name
VBScript code:
Sub Sort( ByRef myArray )
Dim i, j, strHolder
For i = ( UBound( myArray ) - 1 ) to 0 Step -1
For j= 0 to i
If UCase( myArray( j ) ) > UCase( myArray( j + 1 ) ) Then
strHolder = myArray( j + 1 )
myArray( j + 1 ) = myArray( j )
myArray( j ) = strHolder
End If
Next
Next
End Sub
Display
List the contents of an array on screen.
VBScript code:
WScript.Echo Join( myArray, vbCrLf )
Reverse
Subroutine to reverse the order of array elements.
Usage:
Reverse array_name
VBScript code:
Sub Reverse( ByRef myArray )
Dim i, j, idxLast, idxHalf, strHolder
idxLast = UBound( myArray )
idxHalf = Int( idxLast / 2 )
For i = 0 To idxHalf
strHolder = myArray( i )
myArray( i ) = myArray( idxLast - i )
myArray( idxLast - i ) = strHolder
Next
End Sub
ArrayLists
Arrays can be used in any version of VBScript, and in any Windows version, provided that Windows Script Host is installed.
A (minor) disadvantage of VBScript arrays is that, in order to add an element to an existing array, and then sort that array, you need to:
' [1] Retrieve the index number of the last element in the array
idxLast = UBound( myArray )
' [2] Resize the array, preserving the current content
ReDim Preserve myArray( idxLast + 1 )
' [3] Add the new element to the array
myArray( idxLast + 1 ) = strNewValue
' [4] Sort the array using a "bubble sort" algorithm borrowed from the Scripting Guys
For i = ( UBound( myArray ) - 1 ) to 0 Step -1
For j= 0 to i
If UCase( myArray( j ) ) > UCase( myArray( j + 1 ) ) Then
strHolder = myArray( j + 1 )
myArray( j + 1 ) = myArray( j )
myArray( j ) = strHolder
End If
Next
Next
In this article by the Scripting Guys an alternative technique is discussed: ArrayLists.
The ArrayList is a .NET Framework class, which means it requires the .NET Framework.
The following code is used to create an ArrayList and "populate" it with some data:
' this code creates and populates an ArrayList
Set myArrayList = CreateObject( "System.Collections.ArrayList" )
myArrayList.Add "F"
myArrayList.Add "B"
myArrayList.Add "D"
myArrayList.Add "C"
Now, to add an element and sort the ArrayList, all we need to do is:
' [1] add the new element to the ArrayList
myArrayList.Add "Z"
' [2] sort the ArrayList
myArrayList.Sort
And how about deleting an element?
In an array you would need to "shift" the elements to fill the gap and then ReDim the array again.
In an ArrayList you would use either myArrayList.Remove "element_value" or myArrayList.RemoveAt "element_index".
To learn more about the possibilities of the ArrayList class, read this Scripting Guys' article, browse the MSDN Library, and download and try my own ArrayLst.vbs demo script.
SortedList
The .NET SortedList class provides a hash table with automatically sorted key/value pairs.
The available methods and properties are very similar to the ones available in ArrayList.
The following code creates a SortedList and populates it with some key/value pairs:
Set objSortedList = CreateObject( "System.Collections.Sortedlist" )
objSortedList.Add "First", "Hello"
objSortedList.Add "Second", ","
objSortedList.Add "Third", "world"
objSortedList.Add "Fourth", "!"
For i = 0 To objSortedList.Count - 1
WScript.Echo objSortedList.GetKey(i) & vbTab & objSortedList.GetByIndex(i)
Next
This is the resulting output:
FirstHello
Fourth!
Second,
Thirdworld
Note how the list is automatically sorted by keys; it is not possible to sort the list by values.
Like ArrayLists, SortedLists have Count and Capacity properties, and a TrimToSize method, demonstrated in the following code:
WScript.Echo "Size : " & objSortedList.Count
WScript.Echo "Capacity : " & objSortedList.Capacity
WScript.Echo
objSortedList.TrimToSize
WScript.Echo "Size : " & objSortedList.Count
WScript.Echo "Capacity : " & objSortedList.Capacity
This will result in the following output:
Size : 4
Capacity : 16
Size : 4
Capacity : 4
Cloning a SortedList is a piece of cake:
Set objList2 = objSortedList.Clone
WScript.Echo "Sorted List Key(1) = " & objSortedList.GetKey(1)
WScript.Echo "Cloned List Key(1) = " & objList2.GetKey(1)
The result:
Sorted List Key(1) = Fourth
Cloned List Key(1) = Fourth
Available methods and properties are:
Methods:
AddAdds an element with the specified key and value to a SortedList object
ClearRemoves all elements from a SortedList object
CloneCreates a shallow copy of a SortedList object
ContainsDetermines whether a SortedList object contains a specific key
ContainsKeyDetermines whether a SortedList object contains a specific key
ContainsValueDetermines whether a SortedList object contains a specific value
GetByIndexGets the value at the specified index of a SortedList object
GetKeyGets the key at the specified index of a SortedList object
IndexOfKeyReturns the zero-based index of the specified key in a SortedList object
IndexOfValueReturns the zero-based index of the first occurrence of the specified value in a SortedList object
RemoveRemoves the element with the specified key from a SortedList object
RemoveAtRemoves the element at the specified index of a SortedList object
SetByIndexReplaces the value at a specific index in a SortedList object
TrimToSizeSets the capacity to the actual number of elements in a SortedList object
Properties:
CapacityGets or sets the capacity of a SortedList object
CountGets the number of elements contained in a SortedList object
There are 3 distinct methods for Integer Divides in VBScript: x \ y, Int( x / y ) and CInt( x / y )
The best way to explain the differences between the 3 available Integer Divide methods may be by showing some examples.
The following table lists the outcomes of the 3 methods for a range of values:
Demonstration of 3 integer divide methods
Abs(x\y) <=Abs(x/y)Int(x/y) <= x/yCInt(x/y) = x/y roundedto nearest integer
-7\3=-2Int(-7/3)=-3CInt(-7/3)=-2
-6\3=-2Int(-6/3)=-2CInt(-6/3)=-2
-5\3=-1Int(-5/3)=-2CInt(-5/3)=-2
-4\3=-1Int(-4/3)=-2CInt(-4/3)=-1
-3\3=-1Int(-3/3)=-1CInt(-3/3)=-1
-2\3= 0Int(-2/3)=-1CInt(-2/3)=-1
-1\3= 0Int(-1/3)=-1CInt(-1/3)= 0
0\3= 0Int( 0/3)= 0CInt( 0/3)= 0
1\3= 0Int( 1/3)= 0CInt( 1/3)= 0
2\3= 0Int( 2/3)= 0CInt( 2/3)= 1
3\3= 1Int( 3/3)= 1CInt( 3/3)= 1
4\3= 1Int( 4/3)= 1CInt( 4/3)= 1
5\3= 1Int( 5/3)= 1CInt( 5/3)= 2
6\3= 2Int( 6/3)= 2CInt( 6/3)= 2
7\3= 2Int( 7/3)= 2CInt( 7/3)= 2
Random Numbers
WSH
The following code uses standard VBScript only to generate a random number in the 1..100 range:
Randomize
Wscript.Echo Int( ( 100 - 1 + 1 ) * Rnd + 1 )
The general equation is:
Int( ( upperbound - lowerbound + 1 ) * Rnd + lowerbound )
.NET Framework
The following code, borrowed from the Scripting Guys, requires the .NET Framework:
Set objRandom = CreateObject( "System.Random" )
WScript.Echo objRandom.Next_2( 1, 100 )
Looking at this example, the general equation isn't hard to guess:
objRandom.Next_2( lowerbound, upperbound )
True Random Numbers
Computer generated random numbers are not true random numbers.
They are retrieved from a stored semi-random sequence.
Try the WSH samplewithoutRandomize, have it retrieve multiple random numbers, and then run the script several times.
The outcome will be the same each time you run the script.
That is why websites like random.org and random.irb.hr exist.
They use atmospheric noise and photonic emission in semiconductors respectively, which is more truly random than anything that computer software can generate.
I wrote 2 functions, a class and a Windows Script Component to retrieve random integers from random.org:
RndInt, function which returns a single random integer within a specified range
RndIntArr, function which returns an array of random integers within the specified range
Random, class which returns an array of random integers within the specified range
Random.wsc, component which returns an array of random integers within the specified range
The sample script on the True Random Functions page shows how to call these functions.
The sample script on the True Random Class page shows how to use the class.
The sample script on the True Random Windows Script Component page shows how to use the component.
True Random Numbers
RndInt (Function using WinHTTP & Random.org)
RndIntArr (Function using WinHTTP & Random.org)
Random (Class using WinHTTP & Random.org)
Random.wsc (Windows Script Component using WinHTTP & Random.org)
RndInt (WinHTTP & Random.org)
VBScript Code:
Function RndInt( myMin, myMax )
' Retrieves a single TRUE random integer from http://www.random.org/
'
' Arguments:
' myMin [int] lowest possible value for the random integer
' myMax [int] highest possible value for the random integer
'
' Returns:
' [int] random integer within the specified range
' OR a [string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim intStatus, objHTTP, strAgent, strResult, strURL
If Not IsNumeric( myMin ) Then
RndInt = "Error (" & myMin & " is not a number)"
Exit Function
End If
If Not IsNumeric( myMax ) Then
RndInt = "Error (" & myMax & " is not a number)"
Exit Function
End If
If Not CInt( myMin ) = myMin Then
RndInt = "Error (" & myMin & " is not an integer)"
Exit Function
End If
If Not CInt( myMax ) = myMax Then
RndInt = "Error (" & myMax & " is not an integer)"
Exit Function
End If
strURL = "http://www.random.org/integers/?num=1" _
& "&min=" & myMin _
& "&max=" & myMax _
& "&col=1&base=10&format=plain&rnd=new"
strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL, False
objHTTP.SetRequestHeader "User-Agent", strAgent
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
On Error Goto 0
If intStatus = 200 Then
RndInt = strResult
Else
RndInt = "Error (Status " & intStatus & ")"
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
RndIntArr (WinHTTP & Random.org)
VBScript Code:
Function RndIntArr( myMin, myMax, myLength )
' Retrieves TRUE random integers from http://www.random.org/
'
' Arguments:
' myMin [int] lowest possible value for the random integer
' myMax [int] highest possible value for the random integer
' myLength [int] the number of random integers that should be retrieved
'
' Returns:
' [array of int] array with the requested number of random integers within
' the specified range OR an [array of string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
If Not IsNumeric( myMin ) Then
RndInt = "Error (" & myMin & " is not a number)"
Exit Function
End If
If Not IsNumeric( myMax ) Then
RndInt = "Error (" & myMax & " is not a number)"
Exit Function
End If
If Not IsNumeric( myLength ) Then
RndInt = "Error (" & myLength & " is not a number)"
Exit Function
End If
If Not CInt( myMin ) = myMin Then
RndInt = "Error (" & myMin & " is not an integer)"
Exit Function
End If
If Not CInt( myMax ) = myMax Then
RndInt = "Error (" & myMax & " is not an integer)"
Exit Function
End If
If Not Abs( CInt( myLength ) ) = myLength Then
RndInt = "Error (" & myLength & " is not an integer)"
Exit Function
End If
If myLength < 1 Then
RndInt = "Error (" & myLength & " is not a valid number of requests)"
Exit Function
End If
strURL = "http://www.random.org/integers/" _
& "?num=" & myLength _
& "&min=" & myMin _
& "&max=" & myMax _
& "&col=1&base=10&format=plain&rnd=new"
strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL, False
objHTTP.SetRequestHeader "User-Agent", strAgent
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
arrResult = Split( strResult )
ReDim Preserve arrResult( myLength - 1 )
On Error Goto 0
If intStatus = 200 Then
RndIntArr = arrResult
Else
RndIntArr = Array( "Error (Status " & intStatus & ")" )
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Sample Script
VBScript Code:
Option Explicit
Dim arrTest
' Cast 1 die with the RndInt function,
' which returns a single random integer
WScript.Echo RndInt( 1, 6 )
' Cast 2 dice with the RndIntArr function, which
' returns multiple random integers in an array
arrTest = RndIntArr( 1, 6, 2 )
WScript.Echo arrTest(0) & vbCrLf & arrTest(1)
Sample output:
4
6
6
True Random Numbers (Class)
Random (WinHTTP & Random.org)
VBScript Code:
Class Random
' This class uses random.org to retrieve true random integers
'
' Properties:
' Busy R [boolean] If TRUE results aren't available yet
' Debug R [string] Debugging information
' Error R [boolean] If TRUE check Debug property for description
' LowerLimit R/W [integer] Lower limit of the integer to be returned
' NumRequests R/W [integer] Number of integers to be returned (default=1)
' Result R [array int] Resulting random integers
' UpperLimit R/W [integer] Upper limit of the integer to be returned
' Version R [string] This class' version number
'
' Methods:
' Query( ) Start the request for (a) new random integer(s)
' Init( ) Reset all properties
'
' Change Log:
' August 12, 2007 First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Local variables holding the values for the public properties
Private m_LowerLimit, m_UpperLimit, m_NumRequests
Private m_Result, m_Busy, m_Debug, m_Error, m_Version
' Local variables for the Query subroutine (cannot use Private
' inside a subroutine, and using Dim would expose the variables)
Private arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
' Initialize the variables when the class is initialized
Private Sub Class_Initialize
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Class initialization started"
m_Version = "1.00"
Init
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Class initialization ended normally"
End Sub
' Get the LowerLimit value
Public Property Get LowerLimit
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] LowerLimit value read (" & m_LowerLimit & ")"
LowerLimit = m_LowerLimit
End Property
' Set the LowerLimit value
Public Property Let LowerLimit( myLimit )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Trying to set LowerLimit value to " _
& myLimit & vbCrLf _
& Space(22) & "Resetting Result value"
m_Result = Array( "N/A" )
If IsNumeric( myLimit ) Then
If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
m_LowerLimit = myLimit
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] LowerLimit value set to " & myLimit
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified LowerLimit (" _
& myLimit & ") is not an integer"
m_Error = True
End If
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified LowerLimit (" _
& myLimit & ") is not a number"
m_Error = True
End If
End Property
' Get the UpperLimit value
Public Property Get UpperLimit
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] UpperLimit value read (" & m_UpperLimit & ")"
UpperLimit = m_UpperLimit
End Property
' Set the UpperLimit value
Public Property Let UpperLimit( myLimit )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Trying to set UpperLimit value to " _
& myLimit & vbCrLf _
& Space(22) & "Resetting Result value"
m_Result = Array( "N/A" )
If IsNumeric( myLimit ) Then
If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
m_UpperLimit = myLimit
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] UpperLimit value set to " & myLimit
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified UpperLimit (" _
& myLimit & ") is not an integer"
m_Error = True
End If
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified UpperLimit (" _
& myLimit & ") is not a number"
m_Error = True
End If
End Property
' Get the NumRequests value
Public Property Get NumRequests
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] NumRequests value read (" & m_NumRequests & ")"
NumRequests = m_NumRequests
End Property
' Set the NumRequests value
Public Property Let NumRequests( myNum )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Trying to set NumRequests value to " _
& myNum & vbCrLf _
& Space(22) & "Resetting Result value"
m_Result = Array( "N/A" )
If IsNumeric( myNum ) Then
If CStr( CInt( myNum ) ) = CStr( myNum ) And myNum > 0 Then
m_NumRequests = myNum
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] NumRequests value set to " & myNum
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified NumRequests (" _
& myNum & ") is not an integer greater than zero"
m_Error = True
End If
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Specified NumRequests (" _
& myNum & ") is not a number"
m_Error = True
End If
End Property
' Get the Busy value
Public Property Get Busy
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Busy value read (" & m_Busy & ")"
Busy = m_Busy
End Property
' Get the Debug value
Public Property Get Debug
' m_Debug = m_Debug & vbCrLf _
' & "[" & Now & "] Debug value read (" & m_Debug & ")"
Debug = m_Debug
End Property
' Get the Error value
Public Property Get Error
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Error value read (" & m_Error & ")"
Error = m_Error
End Property
' Get the Result value
Public Property Get Result
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Result value read (" & Join( m_Result, " " ) & ")"
Result = m_Result
End Property
' Get the Version value
Public Property Get Version
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Version value read (" & m_Version & ")"
Version = m_Version
End Property
' Start the HTTP request to random.org
Public Sub Query( )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Query method started" & vbCrLf _
& Space(22) & "Resetting Result value"
m_Result = Array( "N/A" )
' Check if a valid LowerLimit was specified
If Not IsNumeric( m_LowerLimit ) Then
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] LowerLimit value not set (" & m_LowerLimit & ")"
m_Error = True
End If
' Check if a valid UpperLimit was specified
If Not IsNumeric( m_UpperLimit ) Then
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] UpperLimit value not set (" & m_UpperLimit & ")"
m_Error = True
End If
' Check for ANY error
If m_Error Then
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] An error has occurred (Error=" _
& m_Error & ")" & vbCrLf _
& Space(22) & "Aborting Query method"
m_Result = Array( "N/A" )
m_NumRequests = 1
Exit Sub
End If
' Format the URL for a HTTP request to random.org
strURL = "http://www.random.org/integers/" _
& "?num=" & m_NumRequests _
& "&min=" & m_LowerLimit _
& "&max=" & m_UpperLimit _
& "&col=1&base=10&format=plain&rnd=new"
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] URL string set to:" & vbCrLf _
& Space(22) & " & strURL & "
' User agent string (not critical)
strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Agent string set to:" & vbCrLf _
& Space(22) & " & strAgent & "
' Prepare the HTTP request to random.org
On Error Resume Next
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
If Err Then
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Could not instantiate WinHTTPRequest object " _
& "(error: " & Err.Number & ")" & vbCrLf _
& Space(22) & "Aborting Query method"
Exit Sub
Else
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] WinHTTPRequest object instantiated successfully"
End If
objHTTP.Open "GET", strURL, False
objHTTP.SetRequestHeader "User-Agent", strAgent
' Set Busy status
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Set Busy status"
m_Busy = True
' Send the HTTP request and store the results
objHTTP.Send
If Err Then
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Error sending WinHTTPRequest" & vbCrLf _
& Space(22) & "Error Number : " & Err.Number & vbCrLf _
& Space(22) & "Error Description : " & Err.Description & vbCrLf _
& Space(22) & "Error Source : " & Err.Source & vbCrLf _
& Space(22) & "Returned Status : " & objHTTP.Status & vbCrLf _
& Space(22) & "Returned Response : " & objHTTP.ResponseText & vbCrLf _
& Space(22) & "Aborting Query method"
Exit Sub
Else
intStatus = objHTTP.Status
strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
arrResult = Split( strResult )
ReDim Preserve arrResult( m_NumRequests - 1 )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] WinHTTPRequest sent" & vbCrLf _
& Space(22) & "Returned Status : " & intStatus & vbCrLf _
& Space(22) & "Returned Response : " & strResult
End If
On Error Goto 0
If intStatus = 200 Then
m_Result = arrResult
Else
' Debug info
m_Result = Array( "N/A" )
m_NumRequests = 1
m_Error = True
End If
' Clear Busy status and release WinHTTPRequest object
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Clear Busy status"
m_Busy = False
Set objHTTP = Nothing
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Query method ended normally"
End Sub
' Reinitialize all properties
Public Sub Init( )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Init method started"
m_Busy = False
m_Error = False
m_LowerLimit = "N/A"
m_NumRequests = 1
m_UpperLimit = "N/A"
m_Result = Array( "N/A" )
m_Debug = m_Debug & vbCrLf _
& "[" & Now & "] Init method ended normally"
End Sub
End Class
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Sample Script
VBScript Code:
Option Explicit
Dim intRequests
intRequests = 10
Test
intRequests = 0
Test
Sub Test( )
' This is a demo/test subroutine for the Random class
Dim arrTest, clsRandom, i, intTest
Set clsRandom = New Random
clsRandom.LowerLimit = 1
clsRandom.UpperLimit = 6
clsRandom.NumRequests = intRequests
clsRandom.Query
WScript.Echo "Version : " & clsRandom.Version
WScript.Echo "NumRequests: " & intRequests
WScript.Echo "Lower Limit: " & clsRandom.LowerLimit
WScript.Echo "Upper Limit: " & clsRandom.UpperLimit
WScript.Echo "Error : " & clsRandom.Error & vbCrLf
intTest = 0
arrTest = clsRandom.Result
If IsNumeric( arrTest(0) ) Then
For i = 0 To clsRandom.NumRequests -1
WScript.Echo "Result " & i & " : " & arrTest(i)
intTest = intTest + arrTest(i)
Next
WScript.Echo "Average : " & ( intTest / clsRandom.NumRequests )
End If
WScript.Echo vbCrLf & "Debug Info : " & clsRandom.Debug & vbCrLf
Set clsRandom = Nothing
End Sub
Sample output:
Version : 1.00
NumRequests: 10
Lower Limit: 1
Upper Limit: 6
Error : False
Result 0 : 1
Result 1 : 3
Result 2 : 1
Result 3 : 6
Result 4 : 1
Result 5 : 6
Result 6 : 5
Result 7 : 6
Result 8 : 1
Result 9 : 4
Average : 3.4
Debug Info :
[13-08-2007 10:53:03] Class initialization started
[13-08-2007 10:53:03] Init method started
[13-08-2007 10:53:03] Init method ended normally
[13-08-2007 10:53:03] Class initialization ended normally
[13-08-2007 10:53:03] Trying to set LowerLimit value to 1
Resetting Result value
[13-08-2007 10:53:03] LowerLimit value set to 1
[13-08-2007 10:53:03] Trying to set UpperLimit value to 6
Resetting Result value
[13-08-2007 10:53:03] UpperLimit value set to 6
[13-08-2007 10:53:03] Trying to set NumRequests value to 10
Resetting Result value
[13-08-2007 10:53:03] NumRequests value set to 10
[13-08-2007 10:53:03] Query method started
Resetting Result value
[13-08-2007 10:53:03] URL string set to:
"http://www.random.org/integers/?num=10&min=1&max=6&col=1&base=10&format=plain&rnd=new"
[13-08-2007 10:53:03] Agent string set to:
"Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
[13-08-2007 10:53:03] WinHTTPRequest object instantiated successfully
[13-08-2007 10:53:03] Set Busy status
[13-08-2007 10:53:06] WinHTTPRequest sent
Returned Status : 200
Returned Response : 1 3 1 6 1 6 5 6 1 4
[13-08-2007 10:53:06] Clear Busy status
[13-08-2007 10:53:06] Query method ended normally
[13-08-2007 10:53:06] Version value read (1.00)
[13-08-2007 10:53:06] LowerLimit value read (1)
[13-08-2007 10:53:06] UpperLimit value read (6)
[13-08-2007 10:53:06] Error value read (False)
[13-08-2007 10:53:06] Result value read (1 3 1 6 1 6 5 6 1 4)
[13-08-2007 10:53:06] NumRequests value read (10)
[13-08-2007 10:53:06] NumRequests value read (10)
Version : 1.00
NumRequests: 0
Lower Limit: 1
Upper Limit: 6
Error : True
Debug Info :
[13-08-2007 10:53:06] Class initialization started
[13-08-2007 10:53:06] Init method started
[13-08-2007 10:53:06] Init method ended normally
[13-08-2007 10:53:06] Class initialization ended normally
[13-08-2007 10:53:06] Trying to set LowerLimit value to 1
Resetting Result value
[13-08-2007 10:53:06] LowerLimit value set to 1
[13-08-2007 10:53:06] Trying to set UpperLimit value to 6
Resetting Result value
[13-08-2007 10:53:06] UpperLimit value set to 6
[13-08-2007 10:53:06] Trying to set NumRequests value to 0
Resetting Result value
[13-08-2007 10:53:06] Specified NumRequests (0) is not an integer greater than zero
[13-08-2007 10:53:06] Query method started
Resetting Result value
[13-08-2007 10:53:06] An error has occurred (Error=True)
Aborting Query method
[13-08-2007 10:53:06] Version value read (1.00)
[13-08-2007 10:53:06] LowerLimit value read (1)
[13-08-2007 10:53:06] UpperLimit value read (6)
[13-08-2007 10:53:06] Error value read (True)
[13-08-2007 10:53:06] Result value read (N/A)
Convert decimal numbers to Roman Numerals vv.
In this section I'll introduce two code snippets to convert 2007 to MMVII to 2007 again.
Only "basic" VBScript is used, so this code should work in any Windows version, in stand-alone scripts, HTAs, or even ASP.
More information on Roman numerals can be found on WikiPedia.
Decimal2Roman
VBScript Code:
Function Decimal2Roman( ByVal intDecimal )
' This Function converts intDecimal to its Roman numeral value.
' Written by: Rob van der Woude, http://www.robvanderwoude.com
'
' intDecimal should be an integer in the range of 1..4999.
'
' For the Roman numeral "modern" notation is used, i.e. 1999
' will be written as MCMXCIX, not MIM.
'
' More information on Roman numerals can be found on WikiPedia:
' http://en.wikipedia.org/wiki/Roman_numerals
' Some housekeeping
Dim strRoman
strRoman = ""
' First, add an "M" for every multiple of 1000
Do While intDecimal >= 1000
intDecimal = intDecimal - 1000
strRoman = strRoman & "M"
Loop
' Next, add "CM" for 900, or "D" for 500, or "CD" for 400
If intDecimal >= 900 Then
intDecimal = intDecimal - 900
strRoman = strRoman & "CM"
ElseIf intDecimal >= 500 Then
intDecimal = intDecimal - 500
strRoman = strRoman & "D"
ElseIf intDecimal >= 400 Then
intDecimal = intDecimal - 400
strRoman = strRoman & "CD"
End If
' Add a "C" for every remaining multiple of 100
Do While intDecimal >= 100
intDecimal = intDecimal - 100
strRoman = strRoman & "C"
Loop
' Add "XC" for 90, or "L" for 50, or "XL" for 40
If intDecimal >= 90 Then
intDecimal = intDecimal - 90
strRoman = strRoman & "XC"
ElseIf intDecimal >= 50 Then
intDecimal = intDecimal - 50
strRoman = strRoman & "L"
ElseIf intDecimal >= 40 Then
intDecimal = intDecimal - 40
strRoman = strRoman & "XL"
End If
' Add an "X" for every remaining multiple of 10
Do While intDecimal >= 10
intDecimal = intDecimal - 10
strRoman = strRoman & "X"
Loop
' Add "IX" for 9, or "V" for 5, or "IV" for 4
If intDecimal >= 9 Then
intDecimal = intDecimal - 9
strRoman = strRoman & "IX"
ElseIf intDecimal >= 5 Then
intDecimal = intDecimal - 5
strRoman = strRoman & "V"
ElseIf intDecimal >= 4 Then
intDecimal = intDecimal - 4
strRoman = strRoman & "IV"
End If
' Finally, add an "I" for every remaining multiple of 1
Do While intDecimal >= 1
intDecimal = intDecimal - 1
strRoman = strRoman & "I"
Loop
' Return the result
Decimal2Roman = strRoman
End Function
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version, with any scripting engine.
Roman2Decimal
VBScript Code:
Function Roman2Decimal( ByVal strRoman )
' This Function converts strRoman to its decimal numerical value.
' Written by: Rob van der Woude, http://www.robvanderwoude.com
'
' Roman numerals "old style" will still be converted correctly
' into decimal numbers. However, numerals like "MIIIM" for 1997
' would be invalid in any notation, and consequently will
' return invalid results.
'
' More information on Roman numerals can be found on WikiPedia:
' http://en.wikipedia.org/wiki/Roman_numerals
' Some housekeeping
Dim arrRoman( ), intRoman
ReDim arrRoman( Len( strRoman ) -1 )
intRoman = 0
' Store each "digit" of the Roman numeral in an array
For i = 0 To UBound( arrRoman )
arrRoman( i ) = Mid( strRoman, i + 1, 1 )
Next
' Then convert each "digit" to its numeric value
For i = 0 To UBound( arrRoman )
Select Case arrRoman( i )
Case "M"
arrRoman( i ) = 1000
Case "D"
arrRoman( i ) = 500
Case "C"
arrRoman( i ) = 100
Case "L"
arrRoman( i ) = 50
Case "X"
arrRoman( i ) = 10
Case "V"
arrRoman( i ) = 5
Case "I"
arrRoman( i ) = 1
End Select
Next
' Now comes the hard part: for each "digit" decide if it will be
' added or subtracted, based on the value of the following "digit"
For i = 0 To UBound( arrRoman ) - 1
If arrRoman( i ) < arrRoman( i + 1 ) Then
' E.g. "I" in "IX" (9): subtract 1
intRoman = intRoman - arrRoman( i )
ElseIf arrRoman( i ) = arrRoman( i + 1 ) Then
' E.g. "I" in "XII" (12), "III" (3) or in "IIX" (ancient notation for 8).
' The latter should actually be "VIII" in "modern" roman numerals, but
' "IIX" was used in ancient times, so let's just be prepared.
' We'll add the value to the next position in the array, so it will be
' reevaluated in the next iteration of the loop.
' Note: this trick will definitely fail on invalid notations like "IIIX".
arrRoman( i + 1 ) = arrRoman( i ) + arrRoman( i + 1 )
arrRoman( i ) = 0
Else ' arrRoman( i ) > arrRoman( i + 1 )
' E.g. "V" in "XV" (15): add 5
intRoman = intRoman + arrRoman( i )
End If
Next
' The last "digit" doesn't have a following "digit" so it
' can, be added without having to test a following "digit"
intRoman= intRoman + arrRoman( UBound( arrRoman ) )
' Return the calculated value
Roman2Decimal = intRoman
End Function
Sub Syntax( ByVal strErr )
If strErr <> "" Then
strMsg = vbCrLf & strErr & vbCrLf & vbCrLf
Else
strMsg = vbCrLf
End If
strMsg = strMsg _
& "Romans.vbs, Version 1.01" & vbCrLf _
& "Convert between Roman and decimal numerals." & vbCrLf & vbCrLf _
& "Usage: ROMANS.VBS numeral" & vbCrLf & vbCrLf _
& "Where: ""numeral"" is either a (decimal) integer in the" & vbCrLf _
& " range of 1..4999, or a Roman numeral." & vbCrLf & vbCrLf _
& "Notes: [1] Returned Roman numerals follow ""modern"" conventions," & vbCrLf _
& " i.e. 1999 will be written as ""MCMXCIX"" instead of ""MIM""." & vbCrLf _
& " However, these Roman numerals ""old style"" will still be" & vbCrLf _
& " converted correctly into decimal numbers." & vbCrLf _
& " Numerals like ""MIIIM"" for 1997 would be invalid in any" & vbCrLf _
& " notation, and consequently will return invalid results." & vbCrLf _
& " [2] More information on Roman numerals can be found on WikiPedia:" & vbCrLf _
& " http://en.wikipedia.org/wiki/Roman_numerals" & vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit( 1 )
End Sub
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version, with any scripting engine.
Strings
Denis St-Pierre's Val( ) functionPad strings
Val( )
VBScript Code:
Function Val( myString )
' Val Function for VBScript (aka ParseInt Function in VBScript).
' By Denis St-Pierre.
' Natively VBScript has no function to extract numbers from a string.
' Based shamelessly on MS' Helpfile example on RegExp object.
' CAVEAT: Returns only the *last* match found
' (or, with objRE.Global = False, only the *first* match)
Dim colMatches, objMatch, objRE, strPattern
' Default if no numbers are found
Val = 0
strPattern = "[-+0-9]+" ' Numbers positive and negative; use
' "ˆ[-+0-9]+" to emulate Rexx' Value()
' function, which returns 0 unless the
' string starts with a number or sign.
Set objRE = New RegExp ' Create regular expression object.
objRE.Pattern = strPattern ' Set pattern.
objRE.IgnoreCase = True ' Set case insensitivity.
objRE.Global = True ' Set global applicability:
' True => return last match only,
' False => return first match only.
Set colMatches = objRE.Execute( myString ) ' Execute search.
For Each objMatch In colMatches ' Iterate Matches collection.
Val = objMatch.Value
Next
Set objRE= Nothing
End Function
Requirements:
Windows version:Windows 2000 or later, or Internet Explorer 5.0 or later
Network:any
Client software:Internet Explorer 5.0 or later for pre-Windows 2000
Script Engine:any
Summarized:Works in Windows 2000 or later, or Internet Explorer 5.0 or later.
Sample Script
VBScript Code:
Option Explicit
WScript.Echo Val( "That 18 year old is darned hot." )
WScript.Echo Val( "That 18 year old is darned hot. She was born in 1980" )
Sample output:
18
1980
Pad strings
Sometimes I need to display results in columns.
Using tabs may help but isn't exactly "fail-safe".
For that reason I wrote the VBScript functions
LeftPad and
RightPad.
Some examples to explain their usage:
myString = "ABCDEF"
WScript.Echo Left( myString, 3 )
WScript.Echo Left( myString, 9 )
will display:
ABC
ABCDEF
myString = "ABCDEF"
WScript.Echo LeftPad( myString, 3, "+" )
WScript.Echo LeftPad( myString, 9, "+" )
will display:
ABC
ABCDEF+++
LeftPad will often be used to pad strings with spaces.
RightPad is LeftPad's counterpart:
myString = "ABCDEF"
WScript.Echo Right( myString, 3 )
WScript.Echo Right( myString, 9 )
will display:
DEF
ABCDEF
myString = "ABCDEF"
WScript.Echo RightPad( myString, 3, "+" )
WScript.Echo RightPad( myString, 9, "+" )
will display:
ABC
+++ABCDEF
RightPad will often be used to pad numbers (in strings) with zeroes.
Look at this combination:
Dim arrName(1)
Dim arrAge(1)
arrName(0) = "John Doe"
arrName(1) = "Vanessa James"
arrAge(0) = 9
arrAge(1) = 65
WScript.Echo LeftPad( "NAME:", 20, " " ) & RightPad( "AGE:", 4, " " )
For i = 0 To UBound( arrName )
WScript.Echo LeftPad( arrName(i), 20, " " ) & RightPad( arrAge(i), 4, " " )
Next
will display:
NAME: AGE:
John Doe 9
Vanessa James 65
LeftPad, optionally combined with RightPad, is perfect for
displaying lists, e.g. WMI class properties and their values.
VBScript code:
Function LeftPad( strText, intLen, chrPad )
'LeftPad( "1234", 7, "x" ) = "1234xxx"
'LeftPad( "1234", 3, "x" ) = "123"
LeftPad = Left( strText & String( intLen, chrPad ), intLen )
End Function
Function RightPad( strText, intLen, chrPad )
'RightPad( "1234", 7, "x" ) = "xxx1234"
'RightPad( "1234", 3, "x" ) = "234"
RightPad = Right( String( intLen, chrPad ) & strText, intLen )
End Function
Environment Variables
There are several ways to read or write environment variables:
Use the WSH Shell object
Use WMI's Win32_Environment class
Read/write the variables directly from/to the registry
As directly accessing the registry is both risky and usually requires a reboot for the changes to take effect, I would not recommend using it, unless all other methods fail.
WSH Shell Object
Read Environment Variables
Reading an environment variable is simple:
Set wshShell = CreateObject( "WScript.Shell" )
WScript.Echo wshShell.ExpandEnvironmentStrings( "%PATHEXT%" )
wshShell = Nothing
The output will look like this:
.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH
The ExpandEnvironmentStrings method can expand environment variables embedded in a string too:
Set wshShell = CreateObject( "WScript.Shell" )
WScript.Echo wshShell.ExpandEnvironmentStrings( "PATH=%PATH%" )
wshShell = Nothing
The output will look like this (but probably longer):
PATH=C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem
This behaviour is exactly like that of a batch file: the environment variable is replaced by its value when the string is processed.
Some environment variables are actually the result of two variables being merged.
The environment variable PATH, for example, is defined in the system environment as well as in the user environment, as can be seen in this screenshot of the "System" Control Panel applet.
In this case, if we query the PATH environment variable like we did just before, the result will look like this:
PATH=C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem;D:\Test
As we can see, the PATH value from the user environment was appended to the value from the system environment.
Other user variables, like TEMP, overwrite their system counterpart:
Set wshShell = CreateObject( "WScript.Shell" )
WScript.Echo wshShell.ExpandEnvironmentStrings( "TEMP=%TEMP%" )
wshShell = Nothing
The output will look like this:
TEMP=C:\DOCUME~1\You\LOCALS~1\Temp
Note:In fact, it gets even more complicated: if you look in the "System" Control Panel applet, you'll notice that the TEMP value in the user environment displays the long path name, not the short 8.3 notation.
Only the system environment values will be available to other users logging on to the same computer, the user environment values are part of the (roaming) profile and hence will be different or even absent for other users.
As you may already have guessed, this technique is not suited for setting environment variables.
To set an environment variable, we first need to find a way to specify in which environment we would like to set that variable.
That is where we use the WSH Shell's Environment method:
Set wshShell = CreateObject( "WScript.Shell" )
Set wshSystemEnv = wshShell.Environment( "SYSTEM" )
WScript.Echo "SYSTEM: TEMP=" & wshSystemEnv( "TEMP" )
Set wshSystemEnv = Nothing
Set wshShell = Nothing
Valid parameters for Environment are PROCESS, SYSTEM, USER and VOLATILE.
The resulting output will look like this:
SYSTEM: TEMP=%SystemRoot%\TEMP
Had we used the PROCESS parameter, the output would have looked like this:
PROCESS: TEMP=C:\DOCUME~1\Rob\LOCALS~1\Temp
This is the value the WSH Shell's ExpandEnvironmentStrings method would return; ExpandEnvironmentStrings can only read the process environment.
OK, time for a demonstration:
Set wshShell = CreateObject( "WScript.Shell" )
WScript.Echo Left( "Expanded" & Space( 12 ), 12 ) & wshShell.ExpandEnvironmentStrings( "TEMP=%TEMP%" )
arrEnvironments = Array( "PROCESS", "SYSTEM", "USER", "VOLATILE" )
For Each strEnv In arrEnvironments
Set wshEnv = wshShell.Environment( strEnv )
WScript.Echo Left( strEnv & Space( 12 ), 12 ) & "TEMP=" & wshEnv( "TEMP" )
Next
Set wshEnv = Nothing
Set wshShell = Nothing
This is what the resulting output will look like:
Expanded TEMP=C:\DOCUME~1\You\LOCALS~1\Temp
PROCESS TEMP=C:\DOCUME~1\You\LOCALS~1\Temp
SYSTEM TEMP=%SystemRoot%\TEMP
USER TEMP=%USERPROFILE%\Local Settings\Temp
VOLATILE TEMP=
Experiment, play with the code.
So far all we did is read environment variables, which is absolutely harmless.
Set Environment Variables
After having read the chapter on reading environment variables, setting them is only a small step.
We will use the WSH Shell's Environment method again:
Set wshShell = CreateObject( "WScript.Shell" )
Set wshSystemEnv = wshShell.Environment( "SYSTEM" )
' Display the current value
WScript.Echo "TestSystem=" & wshSystemEnv( "TestSystem" )
' Set the environment variable
wshSystemEnv( "TestSystem" ) = "Test System"
' Display the result
WScript.Echo "TestSystem=" & wshSystemEnv( "TestSystem" )
' Delete the environment variable
wshSystemEnv.Remove( "TestSystem" )
' Display the result once more
WScript.Echo "TestSystem=" & wshSystemEnv( "TestSystem" )
Set wshSystemEnv = Nothing
Set wshShell = Nothing
The output should look like this:
TestSystem=
TestSystem=Test System
TestSystem=
List Environment Variables
To list all variables in the user environment:
Set wshShell = CreateObject( "WScript.Shell" )
Set wshUserEnv = wshShell.Environment( "USER" )
For Each strItem In wshUserEnv
WScript.Echo strItem
Next
Set wshUserEnv = Nothing
Set wshShell = Nothing
The result will look like this:
TEMP=%USERPROFILE%\Local Settings\Temp
TMP=%USERPROFILE%\Local Settings\Temp
If you read the previous chapters you will know how to list the variables from the other environments too.
WMI's Win32_Environment Class
Besides being able to access environment variables on remote computers, WMI's Win32_Environment class also allows us to access (read and set) environment variables for other users!
See MSDN for detailed information on this class' properties.
Read or List Environment Variables
The following code, created with the help of Scriptomatic, lists all TEMP variables on the local computer:
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
strQuery = "SELECT * FROM Win32_Environment WHERE Name='TEMP'"
Set colItems = objWMIService.ExecQuery( strQuery, "WQL", 48 )
For Each objItem In colItems
WScript.Echo "Caption : " & objItem.Caption
WScript.Echo "Description : " & objItem.Description
WScript.Echo "Name : " & objItem.Name
WScript.Echo "Status : " & objItem.Status
WScript.Echo "SystemVariable : " & objItem.SystemVariable
WScript.Echo "UserName : " & objItem.UserName
WScript.Echo "VariableValue : " & objItem.VariableValue
WScript.Echo
Next
Set colItems = Nothing
Set objWMIService = Nothing
Set Environment Variables
To set a variable, specify new values for its Name, UserName and/or VariableValue properties.
The following code, from the book Windows Server Cookbook by Robbie Allen, creates a new system environment variable called FOOBAR:
strVarName = "FOOBAR"
strVarValue = "Foobar Value"
Set objVarClass = GetObject( "winmgmts://./root/cimv2:Win32_Environment" )
Set objVar = objVarClass.SpawnInstance_
objVar.Name = strVarName
objVar.VariableValue = strVarValue
objVar.UserName = "<SYSTEM>"
objVar.Put_
WScript.Echo "Created environment variable " & strVarName
Set objVar = Nothing
Set objVarClass = Nothing
And the following code removes the environment variable again by giving it an empty value:
strVarName = "FOOBAR"
Set objVarClass = GetObject( "winmgmts://./root/cimv2:Win32_Environment" )
Set objVar = objVarClass.SpawnInstance_
objVar.Name = strVarName
objVar.VariableValue = ""
objVar.UserName = "<SYSTEM>"
objVar.Put_
WScript.Echo "Removed environment variable " & strVarName
Set objVar = Nothing
Set objVarClass = Nothing
Replace the dot in the GetObject commands by a remote computer name to manage environment variables on that remote computer.
Read MS-Access databases
ADODB
VBScript Code:
Option Explicit
Dim arrTables( ), i, idxTables, intValidArgs
Dim blnContent, blnFieldNames
Dim objConn, objFSO, objRS, objSchema
Dim strConnect, strHeader, strOutput
Dim strFile, strResult, strSQL, strTable
Const adSchemaTables = 20
' Check command line arguments
With WScript.Arguments
If .Unnamed.Count = 1 Then
strFile = .Unnamed(0)
Else
Syntax
End If
blnFieldNames = True
blnContent = True
If .Named.Count > 0 Then
intValidArgs = 0
If .Named.Exists( "T" ) Then
blnFieldNames = False
blnContent = False
intValidArgs = intValidArgs + 1
End If
If .Named.Exists( "TF" ) Then
blnContent = False
intValidArgs = intValidArgs + 1
End If
If intValidArgs <> .Named.Count Then Syntax
End If
End With
' Check if the specified database file exists
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
If Not objFSO.FileExists( strFile ) Then Syntax
Set objFSO = Nothing
' Connect to the MS-Access database
Set objConn = CreateObject( "ADODB.Connection" )
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
objConn.Open strConnect
' Search for user tables and list them in an array
Set objSchema = objConn.OpenSchema( adSchemaTables )
idxTables = -1
Do While Not objSchema.EOF
If objSchema.Fields.Item(3).Value = "TABLE" Then
idxTables = idxTables + 1
ReDim Preserve arrTables( idxTables )
arrTables( idxTables ) = objSchema.Fields.Item(2).Value
End If
objSchema.MoveNext
Loop
' List all tables, their column names and their contents
For Each strTable In arrTables
strSQL = "Select * From " & strTable
Set objRS = objConn.Execute( strSQL )
If IsObject( objRS ) Then
' Display the current table's name
If blnContent Then
WScript.Echo "Table: " & strTable & "
Else
WScript.Echo " & strTable & "
End If
If blnFieldNames Then
strOutput = "
Do While Not objRS.EOF
' Create a header line with the column names and data types
strHeader = "
For i = 0 To objRS.Fields.Count - 1
strHeader = strHeader & ","[" _
& GetDataTypeDesc( objRS.Fields.Item(i).Type ) & "] " _
& objRS.Fields.Item(i).Name & "
Next
strHeader = Mid( strHeader, 2 )
If blnContent Then
' List the fields of the current record in comma delimited format
strResult = "
For i = 0 To objRS.Fields.Count - 1
strResult = strResult & "," & objRS.Fields.Item(i).Value & "
Next
' Add the current record to the output string
strOutput = strOutput & Mid( strResult, 2 ) & vbCrLf
End If
' Next record
objRS.MoveNext
Loop
' List the results for the current table
WScript.Echo strHeader & vbCrLf & strOutput & vbCrLf
End If
End If
Next
objRS.Close
objSchema.Close
objConn.Close
Set objRS = Nothing
Set objSchema = Nothing
Set objConn = Nothing
Function GetDataTypeDesc( myTypeNum )
Dim arrTypes( 8192 ), i
For i = 0 To UBound( arrTypes )
arrTypes( i ) = "????"
Next
arrTypes(0) = "Empty"
arrTypes(2) = "SmallInt"
arrTypes(3) = "Integer"
arrTypes(4) = "Single"
arrTypes(5) = "Double"
arrTypes(6) = "Currency"
arrTypes(7) = "Date"
arrTypes(8) = "BSTR"
arrTypes(9) = "IDispatch"
arrTypes(10) = "Error"
arrTypes(11) = "Boolean"
arrTypes(12) = "Variant"
arrTypes(13) = "IUnknown"
arrTypes(14) = "Decimal"
arrTypes(16) = "TinyInt"
arrTypes(17) = "UnsignedTinyInt"
arrTypes(18) = "UnsignedSmallInt"
arrTypes(19) = "UnsignedInt"
arrTypes(20) = "BigInt"
arrTypes(21) = "UnsignedBigInt"
arrTypes(64) = "FileTime"
arrTypes(72) = "GUID"
arrTypes(128) = "Binary"
arrTypes(129) = "Char"
arrTypes(130) = "WChar"
arrTypes(131) = "Numeric"
arrTypes(132) = "UserDefined"
arrTypes(133) = "DBDate"
arrTypes(134) = "DBTime"
arrTypes(135) = "DBTimeStamp"
arrTypes(136) = "Chapter"
arrTypes(138) = "PropVariant"
arrTypes(139) = "VarNumeric"
arrTypes(200) = "VarChar"
arrTypes(201) = "LongVarChar"
arrTypes(202) = "VarWChar"
arrTypes(203) = "LongVarWChar"
arrTypes(204) = "VarBinary"
arrTypes(205) = "LongVarBinary"
arrTypes(8192) = "Array"
GetDataTypeDesc = arrTypes( myTypeNum )
End Function
Sub Syntax
Dim strMsg
strMsg = strMsg & vbCrLf _
& "AccessRd.vbs, Version 1.01" & vbCrLf _
& "Display MS Access database (user) tables and, optionally, their contents" _
& vbCrLf & vbCrLf _
& "Usage: CSCRIPT //NOLOGO ACCESSRD.VBS access_db_file [ /T | /TF ]" _
& vbCrLf & vbCrLf _
& "Where: "access_db_file" is an MS-Access database file" & vbCrLf _
& " /T list table names only" & vbCrLf _
& " /TF list table and field names only" & vbCrLf _
& " (default is list tables, field names AND contents)" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit(1)
End Sub
Requirements:
Windows version:2000 with MDAC 2.8, XP (SP1 or later), Server 2003, or Vista
Network:any
Client software:MDAC 2.8 for Windows 2000
Script Engine:any
Summarized:Works in Windows 2000 or later, Windows 2000 requires MDAC 2.8.
Note:This source code does not contain the full list of constants, only the one used in this sample.
If you intend to experiment with this code, download and use the full source code.
Read Excel files
ADODB
VBScript Code:
Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function : ReadExcel
' Version : 3.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile [string] The path and file name of the Excel file
' mySheet [string] The name of the worksheet used (e.g. "Sheet1")
' my1stCell [string] The index of the first cell to be read (e.g. "A1")
' myLastCell [string] The index of the last cell to be read (e.g. "D100")
' blnHeader [boolean] True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrData( ), i, j
Dim objExcel, objRS
Dim strHeader, strRange
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
' Define header parameter string for Excel object
If blnHeader Then
strHeader = "HDR=YES;"
Else
strHeader = "HDR=NO;"
End If
' Open the object for the Excel file
Set objExcel = CreateObject( "ADODB.Connection" )
' IMEX=1 includes cell content of any format; tip by Thomas Willig.
' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" & _
strHeader & """"
' Open a recordset object for the sheet and range
Set objRS = CreateObject( "ADODB.Recordset" )
strRange = mySheet & "$" & my1stCell & ":" & myLastCell
objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic
' Read the data from the Excel sheet
i = 0
Do Until objRS.EOF
' Stop reading when an empty row is encountered in the Excel sheet
If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
' Add a new row to the output array
ReDim Preserve arrData( objRS.Fields.Count - 1, i )
' Copy the Excel sheet's row values to the array "row"
' IsNull test credits: Adriaan Westra
For j = 0 To objRS.Fields.Count - 1
If IsNull( objRS.Fields(j).Value ) Then
arrData( j, i ) = ""
Else
arrData( j, i ) = Trim( objRS.Fields(j).Value )
End If
Next
' Move to the next row
objRS.MoveNext
' Increment the array "row" number
i = i + 1
Loop
' Close the file and release the objects
objRS.Close
objExcel.Close
Set objRS = Nothing
Set objExcel = Nothing
' Return the results
ReadExcel = arrData
End Function
Requirements:
Windows version:2000 with MDAC 2.8, XP (SP1 or later), Server 2003, or Vista
Network:any
Client software:MDAC 2.8 for Windows 2000
Script Engine:any
Summarized:Works in Windows 2000 or later, Windows 2000 requires MDAC 2.8.
Sample Script
VBScript Code:
Option Explicit
Dim arrSheet, intCount
' Read and display columns A,B, rows 2..6 of "ReadExcelTest.xlsx"
arrSheet = ReadExcel( "ReadExcelTest.xlsx", "Sheet1", "A1", "B6", True )
For intCount = 0 To UBound( arrSheet, 2 )
WScript.Echo arrSheet( 0, intCount ) & vbTab & arrSheet( 1, intCount )
Next
WScript.Echo "==============="
' An alternative way to get the same results
arrSheet = ReadExcel( "ReadExcelTest.xlsx", "Sheet1", "A2", "B6", False )
For intCount = 0 To UBound( arrSheet, 2 )
WScript.Echo arrSheet( 0, intCount ) & vbTab & arrSheet( 1, intCount )
Next
Note:The source code can be downloaded here.
XML
To test the code on this page yourself will require some preparation.
I will be using an XML file created by exporting data from DVD Profiler.
So you may want to download the free version first, and start creating your own database.
As an alternative, you can copy and paste this single record from my own DVD database, but it doesn't demonstrate the queries quite as good as a "real" populated database does.
Next you may want to download and install Microsoft's free XML Notepad 2007.
It can be used to display the XML file in tree view and XSL view, which makes it easier to see and understand the queries we are going to build.
Or as alternatives, download XMLFox, or use your browser, or Notepad, or any other text or programmer's editor (or for the diehards: TYPE and MORE).
Checklist:
Let's get started.
In your editor, IDE or whatever, type the following code:
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
xmlDoc.Load( "dvdcoll.xml" )
If you have an integrated object browser, you'll probably see a reference to MSXML being inserted.
We'll start with simple query, display each DVD's title:
strQuery = "/Collection/DVD/Title"
Set colNodes = xmlDoc.selectNodes( strQuery )
For Each objNode in colNodes
WScript.Echo objNode.nodeName & ": " & objNode.text
Next
Save the code as a VBScript file and run it.
The result will look like this:
Title: Wild Down Under
Title: Pride
Title: Gandhi
Title: The Abyss
Title: Shouf Shouf Habibi
So, why was the query built like this?
Take a look at the image on the right, a fragment of a screenshot of XML Notepad's "XSL Output" window with our XML file loaded (or open the XML file in a plain text editor).
What we see is an opening tag <Collection> as the first tag.
This translates to /Collection in the query.
Then, between the opening <Collection> and closing </Collection> tags ("inside" the Collection), note the "recordsets" of <DVD> and </DVD> tags.
These translate to the DVD part of the query: in the root we find Collections, and inside (or under) Collections we find DVD — just like a directory structure on a disk.
Inside (or under) DVD there are several tags, Title being one of them.
So now we have /Collection/DVD/Title.
Note:Queries are case sensitive!
Capitalization must match the XML tags exactly.
Now let's move to the next level of complexity for our queries, display multiple properties:
strQuery = "/Collection/DVD/ ( Title | Genres )"
Note:This is the query definition only.
Replace the previous query definition by this new one.
The rest of the script remains unaltered.
The part of the query between parentheses is a list of choices, separated by "pipe" characters (|).
Tags will be listed if they match any of these choices, so Title as well as Genres will be shown for each DVD in the collection.
The result will look like this:
Title: Wild Down Under
Genres: Documentary Special Interest
Title: Pride
Genres: Documentary
Title: Gandhi
Genres: Drama Classic
Title: The Abyss
Genres: Science-Fiction Suspense/Thriller
Title: Shouf Shouf Habibi
Genres: Comedy
The genres are listed as single lines, where each line can contain one (or zero) or more genres.
If you look further down in the XML structure, you'll notice that some keys or tags have subkeys: Genres for example uses Genre subkeys.
Subkeys are used when multiple values are possible.
They can be viewed best in XML Notepad's treeview.
To list each individual genre we must use /Collection/DVD/Genres/Genre.
So next, let's display the Title and each individual Genre:
strQuery = "/Collection/DVD/ ( Title | Genres/Genre )"
Roughly translated: display anything that matches "/Collection/DVD/Title" or "/Collection/DVD/Genres/Genre"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: Gandhi
Genre: Drama
Genre: Classic
Title: The Abyss
Genre: Science-Fiction
Genre: Suspense/Thriller
Title: Shouf Shouf Habibi
Genre: Comedy
Note how some DVDs have multiple Genres.
OK, listing properties for each item in a collection no longer has any secrets for you.
Let's select specific items (DVDs) from the collection.
List the titles and genres of all documentaries:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] / ( Title | Genres/Genre )"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: March of the Penguins
Genre: Documentary
Title: Alaska: Spirit of the Wild
Genre: Documentary
Genre: Special Interest
Title: Wilderness Journey - Canyon Suites
Genre: Documentary
Genre: Special Interest
Genre: Music
It is possible to select based on genre without displaying it:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] /Title"
would only display the titles of the documentaries.
Finally, the selection can be narrowed down by using and and or.
Note that these are case sensitive, so And will not work.
List titles and all formats for each documentary that supports 16x9 format:
strQuery = "/Collection/DVD " _
& "[ Genres/Genre = 'Documentary' and Format/Format16X9 = 'True' ] " _
& "/ ( Title | Format/* )"
The result will look like this:
Title: Wild Down Under
FormatAspectRatio: 1.78
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: False
Format16X9: True
FormatDualSided: False
FormatDualLayered: False
FormatFlipper: False
Title: Pride
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: True
Format16X9: True
FormatDualSided: False
FormatDualLayered: True
FormatFlipper: False
. . . TO BE CONTINUED . . .
There are several valid reasons to demand that a script runs in CSCRIPT instead of WSCRIPT, like for example to allow the use of Standard Input or to prevent a separate popup for each WScript.Echo line.
The following code can be copied and pasted at the top of your own scripts to force them to run in CSCRIPT:
Dim strArgs, strCmd, strEngine, i, objDebug, wshShell
Set wshShell = CreateObject( "WScript.Shell" )
strEngine = UCase( Right( WScript.FullName, 12 ) )
If strEngine <> "\CSCRIPT.EXE" Then
' Recreate the list of command line arguments
strArgs = "
If WScript.Arguments.Count > 0 Then
For i = 0 To WScript.Arguments.Count - 1
strArgs = strArgs & " " & WScript.Arguments(i)
Next
End If
' Create the complete command line to rerun this script in CSCRIPT
strCmd = "CSCRIPT.EXE //NoLogo " & WScript.ScriptFullName & " & strArgs
' Rerun the script in CSCRIPT
Set objDebug = wshShell.Exec( strCmd )
' Wait until the script exits
Do While objDebug.Status = 0
WScript.Sleep 100
Loop
' Exit with CSCRIPT's return code
WScript.Quit objDebug.ExitCode
End If
The code may look more complicated than necessary, that's because it returns CSCRIPT's return code to the WSCRIPT engine, just in case this return code is monitored by the program that started the script in WSCRIPT.
In case you want to force a script to run in WSCRIPT instead, just substitute WSCRIPT.EXE for CSCRIPT.EXE.
Thanks to Howard Bayne who corrected an error in the code (I had forgotten to subtract 1 from the WScript.Arguments.Count in the loop, causing an out-of-range error).
Handle DOS Wildcards
RegExp: GetFiles
List matching file names, absolute or relative path allowed in input filespec, output contains fully qualified paths
VBScript Code:Download💾Option Explicit WScript.EchoJoin( GetFiles( WScript.Arguments.Unnamed.Item(0)), vbCrLf )Function GetFiles( strFilespec )' Name : GetFiles' Function : List all files matching the specified filespec, all DOS wildcards allowed' Returns : An array of fully qualified paths of all matching files, or a single element array with the text "Error"' Remarks : If no folder is specified, the current directory will be assumed.' DOS wildcards "*" and "?" are allowed in the FILE name and/or extension, but NOT in the DIRECTORIES.' E.g. "D:\folder\*file*_*.??" is allowed, but "D:\folder\*\file*.??" is NOT.' Author : Rob van der Woude, http://www.robvanderwoude.com' Version : 1.00, 2017-01-31Dim colFiles, objFile, objFolder, objFSO, objRE, wshShellDim strFiles, strFolder, strPattern GetFiles = Array("Error")' Return "Error" if no filespec is specifiedIfTrim( strFilespec ) = "ThenExitFunction' Handle (unlikely) error in specified UNC pathSet objRE = New RegExpobjRE.Pattern = "^\\\\"' Check if filespec starts with double backslashIf objRE.Test( strFilespec )Then' Check if filespec is a valid UNC path: \\server\share\relativepathobjRE.Pattern = "^\\\\[\w-]+\\[\w\$-]+\\[^\\]"IfNot objRE.Test( strFilespec )ThenSet objRE = NothingExitFunctionEndIfEndIfSet wshShell = CreateObject("WScript.Shell")Set objFSO = CreateObject("Scripting.FileSystemObject")IfInStr( strFilespec, "\")And Len( strFilespec )>1Then' If filespec starts with single backslash, prefix it with current directory's driveIfLeft( strFilespec, 1) = "\"AndNotLeft( strFilespec, 2) = "\\"ThenstrFilespec = objFSO.GetDriveName( wshShell.CurrentDirectory) & strFilespecEndIf' Split filespec into parent directory and actual FILE specstrFolder = Mid( strFilespec, 1, InStrRev( strFilespec, "\"))strFilespec = Mid( strFilespec, InStrRev( strFilespec, "\")+1)EndIf' Assume current directory if no parent directory is specifiedIf strFolder = "Then strFolder = wshShell.CurrentDirectory' Quit if folder does not existIfNot objFSO.FolderExists( strFolder )ThenSet objRE = NothingSet objFSO = NothingSet wshShell = NothingExitFunctionEndIf' Convert DOS wildcards to regex patternobjRE.Pattern = "([\.\(\)\[\]\{\}\$])"objRE.Global = TrueobjRE.IgnoreCase = TruestrPattern = objRE.Replace( strFilespec, "\$1")strPattern = Replace( strPattern, "?", "[^\\]")strPattern = Replace( strPattern, "*", "[^\\]*")objRE.Pattern = "(^|\\)" & strPattern & "$"' Get a collection of filesSet objFolder = objFSO.GetFolder( strFolder )Set colFiles = objFolder.FilesstrFiles = "' Iterate through the list of filesForEach objFile In colFiles' Check if the file name matches filespecIf objRE.Test( objFile.Path)Then' Add the file to the liststrFiles = strFiles & ";" & objFile.PathEndIfNext' Return the list of files as an arrayGetFiles = Split( Mid( strFiles, 2), ";")' CleanupSet colFiles = NothingSet objFolder = NothingSet objRE = NothingSet objFSO = NothingSet wshShell = NothingEndFunction
Requirements:
Windows version:any
Network:any
Script Engine:any
Summarized:Works in all Windows versions with all scripting engines.
RegExp: GetFilesLE
GetFiles Light Edition: file names only for input (no path), output contains matching file names (and extensions) only
VBScript Code:Download💾Option Explicit WScript.EchoJoin( GetFilesLE( WScript.Arguments.Unnamed.Item(0)), vbCrLf )Function GetFilesLE( strFilespec )' Name : GetFilesLE' Function : List all files matching the specified filespec, all DOS wildcards allowed;' Light Edition of GetFiles( ) function, but FILE names only, no directories' Returns : An array of all matching file names (no path), or a single element array with the text "Error"' Remarks : Since no folder can be specified, the current directory will be assumed.' DOS wildcards "*" and "?" are allowed in the file name as well as in the extension.' Author : Rob van der Woude, http://www.robvanderwoude.com' Version : 1.00, 2017-02-02Dim colFiles, objFile, objFSO, objRE, wshShellDim strFiles, strPattern ' Return "Error" on missing or invalid filespecGetFilesLE = Array("Error")IfTrim( strFilespec ) = "ThenExitFunctionIfInStr( strFilespec, "\")ThenExitFunctionSet wshShell = CreateObject("WScript.Shell")Set objFSO = CreateObject("Scripting.FileSystemObject")Set objRE = New RegExp ' Convert DOS wildcards to regex patternobjRE.Pattern = "([\.\(\)\[\]\{\}\$])"objRE.Global = TrueobjRE.IgnoreCase = TruestrPattern = objRE.Replace( strFilespec, "\$1")strPattern = Replace( strPattern, "?", "[^\\]")strPattern = Replace( strPattern, "*", "[^\\]*")objRE.Pattern = "(^|\\)" & strPattern & "$"' Get a collection of filesSet colFiles = objFSO.GetFolder( wshShell.CurrentDirectory).FilesstrFiles = "' Iterate through the list of filesForEach objFile In colFiles' Check if the file name matches filespecIf objRE.Test( objFile.Path)Then' Add the file to the liststrFiles = strFiles & ";" & objFile.NameEndIfNext' Return the list of files as an arrayGetFilesLE = Split( Mid( strFiles, 2), ";")' CleanupSet colFiles = NothingSet objRE = NothingSet objFSO = NothingSet wshShell = NothingEndFunction
Requirements:
Windows version:any
Network:any
Script Engine:any
Summarized:Works in all Windows versions with all scripting engines.
Getting started with Regular Expressions
Interpreter:
The interpreter is the "engine" that executes scripts.
Regular expressions are used in other languages, so you only need an interpreter for that language.
For scripting languages without built-in regular expression support, you'll need additional software, like Patrick McPhee's RexxRE for Rexx, or EGREP or RxGrep for DOS/Windows.
Development software:
EDIT (MS-DOS), Notepad (Windows), E (OS/2), or any other ASCII editor will do, as will your editor or IDE for your scripting language.
Like the scripts themselves, a regular expression is "just" a string of text.
To help you write your regular expressions, several expression builders & evaluators are available.
Create CAB files with MakeCabExtract CAB files with System.Shell Folders' CopyHere method
MakeCab
VBScript Code:
CabCreate "D:\test.cab", Array( "D:\test.bat", "D:\Test.pdf" )
Sub CabCreate( myCabFile, arrFiles )
' This function creates a CAB file and adds a
' number of files from an array to the CAB file.
'
' Arguments:
' myCabFile The fully qualified path for the CAB file to be created
' arrFiles An array of fully qualified paths of the files to be added
'
' Requirements:
' MakeCab requires .NET FrameWork 2.0 or later
'
' Based on a script by Rinaldo Ferreira
' http://www.codecomments.com/archive299-2006-1-783560.html
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim i, objCab, objFSO
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objCab = CreateObject( "MakeCab.MakeCab.1" )
' CStr() is necessary, because MakeCab object
' only accepts string arguments, not variants
objCab.CreateCab CStr( myCabFile ), False, False, False
For i = 0 To UBound( arrFiles )
objCab.AddFile CStr( arrFiles(i) ), _
CStr( objFSO.GetFileName( arrFiles(i) ) )
Next
objCab.CloseCab
End Sub
Requirements:
Windows version:2000, XP, Server 2003, or Vista
Network:any
Client software:.NET FrameWork 2.0
Script Engine:any
Summarized:Works in Windows 2000 or later with .NET FrameWork 2.0 or later installed.
Read & Write INI Files
ReadINIWriteINIDeleteINISample ScriptRelated stuff
ReadINI
VBScript Code:
Function ReadIni( myFilePath, mySection, myKey )
' This function returns a value read from an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be returned
'
' Returns:
' the [string] value for the specified key in the specified section
'
' CAVEAT: Will return a space if key exists but value is blank
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre and Rob van der Woude
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
Requirements:
Windows version:any
Network:any
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version, with any engine.
WriteINI
VBScript Code:
Sub WriteIni( myFilePath, mySection, myKey, myValue )
' This subroutine writes a value to an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be written
' myValue [string] the value to be written (myKey will be
' deleted if myValue is <DELETE_THIS_VALUE>)
'
' Returns:
' N/A
'
' CAVEAT: WriteIni function needs ReadIni function to run
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
Dim intEqualPos
Dim objFSO, objNewIni, objOrgIni, wshShell
Dim strFilePath, strFolderPath, strKey, strLeftString
Dim strLine, strSection, strTempDir, strTempFile, strValue
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
strValue = Trim( myValue )
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set wshShell = CreateObject( "WScript.Shell" )
strTempDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
blnInSection = False
blnSectionExists = False
' Check if the specified key already exists
blnKeyExists = ( ReadIni( strFilePath, strSection, strKey ) <> " )
blnWritten = False
' Check if path to INI file exists, quit if not
strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
If Not objFSO.FolderExists ( strFolderPath ) Then
WScript.Echo "Error: WriteIni failed, folder path (" _
& strFolderPath & ") to ini file " _
& strFilePath & " not found!"
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
WScript.Quit 1
End If
While objOrgIni.AtEndOfStream = False
strLine = Trim( objOrgIni.ReadLine )
If blnWritten = False Then
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
blnSectionExists = True
blnInSection = True
ElseIf InStr( strLine, "[" ) = 1 Then
blnInSection = False
End If
End If
If blnInSection Then
If blnKeyExists Then
intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
If LCase( strLeftString ) = LCase( strKey ) Then
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
End If
If Not blnWritten Then
objNewIni.WriteLine strLine
End If
Else
objNewIni.WriteLine strLine
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
Else
objNewIni.WriteLine strLine
End If
Wend
If blnSectionExists = False Then ' section doesn't exist
objNewIni.WriteLine
objNewIni.WriteLine "[" & strSection & "]"
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
End If
objOrgIni.Close
objNewIni.Close
' Delete old INI file
objFSO.DeleteFile strFilePath, True
' Rename new INI file
objFSO.MoveFile strTempFile, strFilePath
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
Set wshShell = Nothing
End Sub
Requirements:
Windows version:any
Network:any
Client software:Requires the ReadINI function
Script Engine:any
Summarized:Works in any Windows version, with any engine; requires the ReadINI function.
DeleteINI
To delete a key in an INI file, use WriteINI with a value"<DELETE_THIS_VALUE>".
Sample Script
VBScript Code:
WriteIni "C:\test.ini", "TEST1", "My1stKey", "My1stValue"
WriteIni "C:\test.ini", "TEST2", "My1stKey", "My1stValue"
WScript.Echo ReadIni( "C:\test.ini", "TEST1", "My1stKey" )
WriteIni "C:\test.ini", "TEST1", "My1stKey", "My2ndValue"
WScript.Echo ReadIni( "C:\test.ini", "TEST1", "My1stKey" )
Sample output:
My1stValue
My2ndValue
Related Stuff:
Use KiXtart's easy INI access in VBScript with KixINI.vbs
Adriaan Westra's WriteIni function
Calculate MD5 Checksums
X-MD5
VBScript Code:
WScript.Echo "Comparing 2 strings:"
strString = "Meet John Doe"
WScript.Echo "MD5 Checksum for """ & strString _
& """: " & GetStringCheckSum( strString )
strString = "meet John Doe"
WScript.Echo "MD5 Checksum for """ & strString _
& """: " & GetStringCheckSum( strString )
WScript.Echo
WScript.Echo "Comparing 2 files:"
strFile1 = "C:\WINDOWS\System32\wmpcore.dll"
strFile2 = "C:\WINDOWS\System32\dllcache\wmpcore.dll"
WScript.Echo "MD5 Checksum for " & strFile1 _
& ": " & GetFileCheckSum( strFile1 )
WScript.Echo "MD5 Checksum for " & strFile2 _
& ": " & GetFileCheckSum( strFile2 )
Function GetFileCheckSum( myFile )
' This function uses X-standards.com's X-MD5 component to calculate
' the MD5 checksum of a file.
'
' Argument:
' myFile [string] the file name whose checksum is to be calculated
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-MD5 component is available at:
' http://www.xstandard.com/page.asp?p=C8AACBA3-702F-4BF0-894A-B6679AA949E6
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=44AFBB03-EDC1-49FE-94CC-333AE728331E
Dim objMD5
Set objMD5 = CreateObject( "XStandard.MD5" )
GetFileCheckSum = objMD5.GetCheckSumFromFile( myFile )
Set objMD5 = Nothing
End Function
Function GetStringCheckSum( myString )
' This function uses X-standards.com's X-MD5 component to calculate
' the MD5 checksum of a string.
'
' Argument:
' myString [string] the string whose checksum is to be calculated
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-MD5 component is available at:
' http://www.xstandard.com/page.asp?p=C8AACBA3-702F-4BF0-894A-B6679AA949E6
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=44AFBB03-EDC1-49FE-94CC-333AE728331E
Dim objMD5
Set objMD5 = CreateObject( "XStandard.MD5" )
GetStringCheckSum = objMD5.GetCheckSumFromString( myString )
Set objMD5 = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:X-MD5 component
Script Engine:any
Summarized:Works in any Windows version with the X-MD5 component installed.
File Encoding
Check a file's Byte Order Mark (BOM) to determine its text encodingADODB.Stream
VBScript Code:
' Based on information from
' https://en.wikipedia.org/wiki/Byte_order_mark
'
'Encoding Hex BOM
'======== =======
'BOCU-1 FB EE 28
'GB-18030 84 31 95 33
'SCSU 0E FE FF
'UTF-1 F7 64 4C
'UTF-7 2B 2F 76 (38|39|2B|2F)
'UTF-8 EF BB BF
'UTF-16 (BE) FE FF
'UTF-16 (LE) FF FE
'UTF-32 (BE) 00 00 FE FF
'UTF-32 (LE) FF FE 00 00
'UTF-EBCDIC DD 73 66 73
Option Explicit
Const adTypeBinary = 1
Const adTypeText = 2
Dim i, intRC
Dim dicBOMs, objFSO, objStream
Dim strBOM, strFile, strHead, strType, strUTF7
If WScript.Arguments.Unnamed.Count <> 1 Then Syntax
If WScript.Arguments.Named.Count > 0 Then Syntax
intRC = 0
strFile = WScript.Arguments.Unnamed(0)
strType = "Unknown"
strUTF7 = "38;39;2B;2F" ' Allowed values for 4th byte of UTF-7 BOM
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
If Not objFSO.FileExists( strFile ) Then Syntax
Set objFSO = Nothing
Set dicBOMs = CreateObject( "Scripting.Dictionary" )
dicBOMs.Add "0000FEFF", "UTF-32 (BE)"
dicBOMs.Add "0EFEFF", "SCSU"
dicBOMs.Add "2B2F76", "UTF-7" ' First 3 bytes of BOM only, 4th byte can have several values
dicBOMs.Add "84319533", "GB-18030"
dicBOMs.Add "DD736673", "UTF-EBCDIC"
dicBOMs.Add "EFBBBF", "UTF-8"
dicBOMs.Add "F7644C", "UTF-1"
dicBOMs.Add "FBEE28", "BOCU-1"
dicBOMs.Add "FEFF", "UTF-16 (BE)"
dicBOMs.Add "FFFE", "UTF-16 (LE)"
dicBOMs.Add "FFFE0000", "UTF-32 (LE)"
On Error Resume Next
Set objStream = CreateObject( "ADODB.Stream" )
objStream.Open
objStream.Type = adTypeBinary
objStream.LoadFromFile strFile
If Err Then intRC = 1
objStream.Position = 0
strHead = "
For i = 0 To 3
strHead = strHead & UCase( Right( "0" & Hex( AscB( objStream.Read( 1 ) ) ), 2 ) )
If Err Then intRC = 1
Next
objStream.Close
Set objStream = Nothing
On Error Goto 0
If intRC = 1 Then Syntax
For i = 8 To 4 Step -2 ' Try the longest match (4 bytes) first, next try 3 bytes, finally try 2 bytes
If strType = "Unknown" Then
strBOM = Left( strHead, i )
If dicBOMs.Exists( strBOM ) Then
If dicBOMs( strBOM ) = "UTF-7" Then
If InStr( strUTF7, Right( strHead, 2 ) ) Then strType = "UTF-7"
Else
strType = dicBOMs( strBOM )
End If
End If
End If
Next
If strType = "Unknown" Then intRC = 1
WScript.Echo "File Name : " & strFile & vbcrlf _
& "First 4 bytes : " & strHead & vbcrlf _
& "Matching BOM : " & strBOM & vbcrlf _
& "File Encoding : " & strType
WScript.Quit intRC
Sub Syntax
Dim strMsg
strMsg = vbCrLf _
& "CheckBOM.vbs, Version 1.00" _
& vbCrLf _
& "Check a file's Byte Order Mark (BOM) to determine its text encoding" _
& vbCrLf & vbCrLf _
& "Usage: CheckBOM.vbs textfilename" _
& vbCrLf & vbCrLf _
& "Note: The file encoding is displayed on screen, e.g. "UTF-7" or" _
& vbCrLf _
& " "UTF-32 (LE)", or "Unknown" if not recognized." _
& vbCrLf _
& " Check this script's source code for a list of recognized BOMs." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
Requirements:
Windows version:2000 and later
Network:any
Client software:MDAC 2.8 for Windows 2000
Script Engine:any
Summarized:Works in Windows 2000 or later, Windows 2000 requires MDAC 2.8.
Convert ASCII to UTF-8
Convert plain text files to UTF-8 with ADODB.Stream
VBScript Code:
Option Explicit
Dim objFSO, strFileIn, strFileOut
strFileIn = WScript.ScriptName
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
strFileOut = objFSO.GetBaseName( strFileIn ) & "_utf8.txt"
Set objFSO = Nothing
UTF8 strFileIn, strFileOut
Function UTF8( myFileIn, myFileOut )
' UTF8() Version 1.00
' Open a "plain" text file and save it again in UTF-8 encoding
' (overwriting an existing file without asking for confirmation).
'
' Based on a sample script from JTMar:
' http://bytes.com/groups/asp/52959-save-file-utf-8-format-asp-vbscript
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objStream
' Valid Charset values for ADODB.Stream
Const CdoBIG5 = "big5"
Const CdoEUC_JP = "euc-jp"
Const CdoEUC_KR = "euc-kr"
Const CdoGB2312 = "gb2312"
Const CdoISO_2022_JP = "iso-2022-jp"
Const CdoISO_2022_KR = "iso-2022-kr"
Const CdoISO_8859_1 = "iso-8859-1"
Const CdoISO_8859_2 = "iso-8859-2"
Const CdoISO_8859_3 = "iso-8859-3"
Const CdoISO_8859_4 = "iso-8859-4"
Const CdoISO_8859_5 = "iso-8859-5"
Const CdoISO_8859_6 = "iso-8859-6"
Const CdoISO_8859_7 = "iso-8859-7"
Const CdoISO_8859_8 = "iso-8859-8"
Const CdoISO_8859_9 = "iso-8859-9"
Const cdoKOI8_R = "koi8-r"
Const cdoShift_JIS = "shift-jis"
Const CdoUS_ASCII = "us-ascii"
Const CdoUTF_7 = "utf-7"
Const CdoUTF_8 = "utf-8"
' ADODB.Stream file I/O constants
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
On Error Resume Next
Set objStream = CreateObject( "ADODB.Stream" )
objStream.Open
objStream.Type = adTypeText
objStream.Position = 0
objStream.Charset = CdoUTF_8
objStream.LoadFromFile myFileIn
objStream.SaveToFile myFileOut, adSaveCreateOverWrite
objStream.Close
Set objStream = Nothing
If Err Then
UTF8 = False
Else
UTF8 = True
End If
On Error Goto 0
End Function
Requirements:
Windows version:Windows XP SP2 and later, or Windows 2000 with MDAC 2.8 SP1 installed
Network:any
Client software:MDAC 2.8 component
Script Engine:any
Summarized:Works in any Windows 2000 with MDAC 2.8 SP1 installed, or Windows XP SP2 and later.
Base64 Encode & Decode Files
X-Base64
VBScript Code:
Option Explicit
Dim errResult
WScript.Echo "Base64 encoding . . ."
errResult = Base64Encode( "b64coder.vbs", "b64coder.enc" )
If errResult <> 0 Then
ShowError errResult
End If
WScript.Echo "Decoding again . . ."
errResult = Base64Decode( "b64coder.enc", "b64coder.dec" )
If errResult <> 0 Then
ShowError errResult
Else
WScript.Echo "Done." & vbCrLf _
& "Compare the files ""b64coder.vbs"" and " _
& """b64coder.dec"", they should be identical."
End If
Sub ShowError( myError )
On Error Resume Next
Err.Raise myError
WScript.Echo "ERROR " & Err.Number & ": " & Err.Description
Err.Clear
On Error Goto 0
WScript.Quit
End Sub
Function Base64Encode( myFileIn, myFileOut )
' This function uses Belus Technology's XBase64 component to Base64 encode a file.
' The XBase64 component is available at
' http://www.xstandard.com/en/documentation/xbase64/
'
' Arguments:
' myFileIn [string] the file to be encoded
' myFileOut [string] the encoded file to be created
'
' Return Code:
' 0 if all goes well, otherwise the appropriate error number
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim i, objBase64, objFSO, objFileIn, objFileOut
Dim objStreamIn, strCode, strText
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateFalse = 0
Const TristateMixed = -2
Const TristateTrue = -1
Const TristateUseDefault = -2
Const otSafeArray = 0
Const otString = 2
' Use custom error handling
'On Error Resume Next
' Open a file system object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Open the input file if it exists
If objFSO.FileExists( myFileIn ) Then
Set objFileIn = objFSO.GetFile( myFileIn )
Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TristateFalse )
Else
' Error 53: File not found
Base64Encode = 53
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
End If
' Create the output file, unless it already exists
If objFSO.FileExists( myFileOut ) Then
' Error 58: File already exists
Base64Encode = 58
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
Else
Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
End If
' Read the text from the input file and close the file
strText = objStreamIn.ReadAll( )
objStreamIn.Close
' Base64 encode the text stream
Set objBase64 = CreateObject( "XStandard.Base64" )
strCode = objBase64.Encode( strText, otString )
Set objBase64 = Nothing
' Write the result to the output file and close the file
objFileOut.Write strCode
objFileOut.Close
' Release the objects
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFileOut = Nothing
Set objFSO = Nothing
' Return any error codes
Base64Encode = Err.Number
On Error Goto 0
End Function
Function Base64Decode( myFileIn, myFileOut )
' This function uses Belus Technology's XBase64 component to Base64 decode a file.
' The XBase64 component is available at
' http://www.xstandard.com/en/documentation/xbase64/
'
' Arguments:
' myFileIn [string] the file to be decoded
' myFileOut [string] the decoded file to be created
'
' Return Code:
' 0 if all goes well, otherwise the appropriate error number
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim i, objBase64, objFSO, objFileIn, objFileOut
Dim objStreamIn, strCode, strText
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateFalse = 0
Const TristateMixed = -2
Const TristateTrue = -1
Const TristateUseDefault = -2
Const otSafeArray = 0
Const otString = 2
' Use custom error handling
'On Error Resume Next
' Open a file system object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Open the input file if it exists
If objFSO.FileExists( myFileIn ) Then
Set objFileIn = objFSO.GetFile( myFileIn )
Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TristateFalse )
Else
' Error 53: File not found
Base64Decode = 53
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
End If
' Create the output file, unless it already exists
If objFSO.FileExists( myFileOut ) Then
' Error 58: File already exists
Base64Decode = 58
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
Else
Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
End If
' Read the encoded text from the input file and close the file
strCode = objStreamIn.ReadAll( )
objStreamIn.Close
' Base64 decode the text stream
Set objBase64 = CreateObject( "XStandard.Base64" )
strText = objBase64.Decode( strCode, otString )
Set objBase64 = Nothing
' Write the result to the output file and close the file
objFileOut.Write strText
objFileOut.Close
' Release the objects
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFileOut = Nothing
Set objFSO = Nothing
' Return any error codes
Base64Decode = Err.Number
On Error Goto 0
End Function
Requirements:
Windows version:any
Network:any
Client software:X-Base64 component
Script Engine:any
Summarized:Works in any Windows version with the X-Base64 component installed.
XOR
Encrypt Files Using Exclusive OR
XOR
VBScript Code:
Option Explicit
Dim arrKey, errResult
arrKey = GetKey( "This is a short and simple ""passphrase""" )
WScript.Echo "Encoding . . ."
errResult = Encode( "coder.vbs", "coder.enc", arrKey )
If errResult <> 0 Then
ShowError errResult
End If
WScript.Echo "Decoding again . . ."
errResult = Encode( "coder.enc", "coder.dec", arrKey )
If errResult <> 0 Then
ShowError errResult
Else
WScript.Echo "Done." & vbCrLf _
& "Compare the files ""coder.vbs"" and ""coder.dec"", " _
& "they should be identical."
End If
Sub ShowError( myError )
On Error Resume Next
Err.Raise myError
WScript.Echo "ERROR " & Err.Number & ": " & Err.Description
Err.Clear
On Error Goto 0
WScript.Quit
End Sub
Function Encode( myFileIn, myFileOut, arrCode )
' This function provides a simple (ASCII) text encoder/decoder using XOR.
' Because it uses XOR, both encoding and decoding can be performed by the
' same function, with the same key.
'
' Arguments:
' myFileIn [string] input text file (file to be encoded)
' myFileOut [string] output file (encoded text)
' arrCode [array of int] "key", consisting of any number of integers
' from 1 to 255; avoid 0, though it can be used,
' it doesn't encode anything.
' Use any number of elements in the "key" array,
' each element multiplies the number of possible
' keys by 255 (not 256 since 0 is avoided).
' If only a single element is used, it may be
' passed either as an array or as a single integer.
'
' Return code:
' 0 if all went well, otherwise the appropriate error number.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim i, objFSO, objFileIn, objFileOut, objStreamIn
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateFalse = 0
Const TristateMixed = -2
Const TristateTrue = -1
Const TristateUseDefault = -2
' Use custom error handling
On Error Resume Next
' If the "key" is a single digit, convert it to an array
If Not IsArray( arrCode ) Then
arrCode = Array( arrCode )
End If
' Check if a valid "key" array is used
For i = 0 To UBound( arrCode )
If Not IsNumeric( arrCode(i) ) Then
' 1032 Invalid character
Encode = 1032
Exit Function
End If
If arrCode(i) < 0 Or arrCode(i) > 255 Then
' 1031 Invalid number
Encode = 1031
Exit Function
End If
Next
' Open a file system object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Open the input file if it exists
If objFSO.FileExists( myFileIn ) Then
Set objFileIn = objFSO.GetFile( myFileIn )
Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse )
Else
' Error 53: File not found
Encode = 53
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
End If
' Create the output file, unless it already exists
If objFSO.FileExists( myFileOut ) Then
' Error 58: File already exists
Encode = 58
' Close input file and release objects
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFSO = Nothing
' Abort
Exit Function
Else
Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
End If
' Encode the text from the input file and write it to the output file
i = 0
Do Until objStreamIn.AtEndOfStream
i = ( i + 1 ) \ ( UBound( arrCode ) + 1 )
objFileOut.Write Chr( Asc( objStreamIn.Read( 1 ) ) Xor arrCode(i) )
Loop
' Close files and release objects
objFileOut.Close
objStreamIn.Close
Set objStreamIn = Nothing
Set objFileIn = Nothing
Set objFileOut = Nothing
Set objFSO = Nothing
' Return the error number as status information
Encode = Err.Number
' Done
Err.Clear
On Error Goto 0
End Function
Function GetKey( myPassPhrase )
' This function converts a password or passphrase
' into a "key" array for the Encode function.
Dim i, arrCode( )
ReDim arrCode( Len( myPassPhrase ) - 1 )
For i = 0 To UBound( arrCode )
arrCode(i) = Asc( Mid( myPassPhrase, i + 1, 1 ) )
Next
GetKey = arrCode
End Function
Requirements:
Windows version:any
Network:any
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version, with any scripting engine.
Self-Destruct
WSH (WScript.ScriptFullName)
VBScript Code:
' Author: Denis St-Pierre
' Function: Make a script delete itself
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
objFSO.DeleteFile WScript.ScriptFullName
WScript.Quit
Requirements:
Windows version:any
Network:any
Client software:N/A
Script Engine:WSH
Summarized:Works in any Windows version, with WSH script engine (WSCRIPT.EXE and CSCRIPT.EXE).
XML
To test the code on this page yourself will require some preparation.
I will be using an XML file created by exporting data from DVD Profiler.
So you may want to download the free version first, and start creating your own database.
As an alternative, you can copy and paste this single record from my own DVD database, but it doesn't demonstrate the queries quite as good as a "real" populated database does.
Next you may want to download and install Microsoft's free XML Notepad 2007.
It can be used to display the XML file in tree view and XSL view, which makes it easier to see and understand the queries we are going to build.
Or as alternatives, download XMLFox, or use your browser, or Notepad, or any other text or programmer's editor (or for the diehards: TYPE and MORE).
Checklist:
Let's get started.
In your editor, IDE or whatever, type the following code:
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
xmlDoc.Load( "dvdcoll.xml" )
If you have an integrated object browser, you'll probably see a reference to MSXML being inserted.
We'll start with simple query, display each DVD's title:
strQuery = "/Collection/DVD/Title"
Set colNodes = xmlDoc.selectNodes( strQuery )
For Each objNode in colNodes
WScript.Echo objNode.nodeName & ": " & objNode.text
Next
Save the code as a VBScript file and run it.
The result will look like this:
Title: Wild Down Under
Title: Pride
Title: Gandhi
Title: The Abyss
Title: Shouf Shouf Habibi
So, why was the query built like this?
Take a look at the image on the right, a fragment of a screenshot of XML Notepad's "XSL Output" window with our XML file loaded (or open the XML file in a plain text editor).
What we see is an opening tag <Collection> as the first tag.
This translates to /Collection in the query.
Then, between the opening <Collection> and closing </Collection> tags ("inside" the Collection), note the "recordsets" of <DVD> and </DVD> tags.
These translate to the DVD part of the query: in the root we find Collections, and inside (or under) Collections we find DVD — just like a directory structure on a disk.
Inside (or under) DVD there are several tags, Title being one of them.
So now we have /Collection/DVD/Title.
Note:Queries are case sensitive!
Capitalization must match the XML tags exactly.
Now let's move to the next level of complexity for our queries, display multiple properties:
strQuery = "/Collection/DVD/ ( Title | Genres )"
Note:This is the query definition only.
Replace the previous query definition by this new one.
The rest of the script remains unaltered.
The part of the query between parentheses is a list of choices, separated by "pipe" characters (|).
Tags will be listed if they match any of these choices, so Title as well as Genres will be shown for each DVD in the collection.
The result will look like this:
Title: Wild Down Under
Genres: Documentary Special Interest
Title: Pride
Genres: Documentary
Title: Gandhi
Genres: Drama Classic
Title: The Abyss
Genres: Science-Fiction Suspense/Thriller
Title: Shouf Shouf Habibi
Genres: Comedy
The genres are listed as single lines, where each line can contain one (or zero) or more genres.
If you look further down in the XML structure, you'll notice that some keys or tags have subkeys: Genres for example uses Genre subkeys.
Subkeys are used when multiple values are possible.
They can be viewed best in XML Notepad's treeview.
To list each individual genre we must use /Collection/DVD/Genres/Genre.
So next, let's display the Title and each individual Genre:
strQuery = "/Collection/DVD/ ( Title | Genres/Genre )"
Roughly translated: display anything that matches "/Collection/DVD/Title" or "/Collection/DVD/Genres/Genre"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: Gandhi
Genre: Drama
Genre: Classic
Title: The Abyss
Genre: Science-Fiction
Genre: Suspense/Thriller
Title: Shouf Shouf Habibi
Genre: Comedy
Note how some DVDs have multiple Genres.
OK, listing properties for each item in a collection no longer has any secrets for you.
Let's select specific items (DVDs) from the collection.
List the titles and genres of all documentaries:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] / ( Title | Genres/Genre )"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: March of the Penguins
Genre: Documentary
Title: Alaska: Spirit of the Wild
Genre: Documentary
Genre: Special Interest
Title: Wilderness Journey - Canyon Suites
Genre: Documentary
Genre: Special Interest
Genre: Music
It is possible to select based on genre without displaying it:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] /Title"
would only display the titles of the documentaries.
Finally, the selection can be narrowed down by using and and or.
Note that these are case sensitive, so And will not work.
List titles and all formats for each documentary that supports 16x9 format:
strQuery = "/Collection/DVD " _
& "[ Genres/Genre = 'Documentary' and Format/Format16X9 = 'True' ] " _
& "/ ( Title | Format/* )"
The result will look like this:
Title: Wild Down Under
FormatAspectRatio: 1.78
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: False
Format16X9: True
FormatDualSided: False
FormatDualLayered: False
FormatFlipper: False
Title: Pride
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: True
Format16X9: True
FormatDualSided: False
FormatDualLayered: True
FormatFlipper: False
. . . TO BE CONTINUED . . .
To test the code on this page yourself will require some preparation.
I will be using an XML file created by exporting data from DVD Profiler.
So you may want to download the free version first, and start creating your own database.
As an alternative, you can copy and paste this single record from my own DVD database, but it doesn't demonstrate the queries quite as good as a "real" populated database does.
Next you may want to download and install Microsoft's free XML Notepad 2007.
It can be used to display the XML file in tree view and XSL view, which makes it easier to see and understand the queries we are going to build.
Or as alternatives, download XMLFox, or use your browser, or Notepad, or any other text or programmer's editor (or for the diehards: TYPE and MORE).
Checklist:
Let's get started.
In your editor, IDE or whatever, type the following code:
Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = "False"
xmlDoc.Load( "dvdcoll.xml" )
If you have an integrated object browser, you'll probably see a reference to MSXML being inserted.
We'll start with simple query, display each DVD's title:
strQuery = "/Collection/DVD/Title"
Set colNodes = xmlDoc.selectNodes( strQuery )
For Each objNode in colNodes
WScript.Echo objNode.nodeName & ": " & objNode.text
Next
Save the code as a VBScript file and run it.
The result will look like this:
Title: Wild Down Under
Title: Pride
Title: Gandhi
Title: The Abyss
Title: Shouf Shouf Habibi
So, why was the query built like this?
Take a look at the image on the right, a fragment of a screenshot of XML Notepad's "XSL Output" window with our XML file loaded (or open the XML file in a plain text editor).
What we see is an opening tag <Collection> as the first tag.
This translates to /Collection in the query.
Then, between the opening <Collection> and closing </Collection> tags ("inside" the Collection), note the "recordsets" of <DVD> and </DVD> tags.
These translate to the DVD part of the query: in the root we find Collections, and inside (or under) Collections we find DVD — just like a directory structure on a disk.
Inside (or under) DVD there are several tags, Title being one of them.
So now we have /Collection/DVD/Title.
Note:Queries are case sensitive!
Capitalization must match the XML tags exactly.
Now let's move to the next level of complexity for our queries, display multiple properties:
strQuery = "/Collection/DVD/ ( Title | Genres )"
Note:This is the query definition only.
Replace the previous query definition by this new one.
The rest of the script remains unaltered.
The part of the query between parentheses is a list of choices, separated by "pipe" characters (|).
Tags will be listed if they match any of these choices, so Title as well as Genres will be shown for each DVD in the collection.
The result will look like this:
Title: Wild Down Under
Genres: Documentary Special Interest
Title: Pride
Genres: Documentary
Title: Gandhi
Genres: Drama Classic
Title: The Abyss
Genres: Science-Fiction Suspense/Thriller
Title: Shouf Shouf Habibi
Genres: Comedy
The genres are listed as single lines, where each line can contain one (or zero) or more genres.
If you look further down in the XML structure, you'll notice that some keys or tags have subkeys: Genres for example uses Genre subkeys.
Subkeys are used when multiple values are possible.
They can be viewed best in XML Notepad's treeview.
To list each individual genre we must use /Collection/DVD/Genres/Genre.
So next, let's display the Title and each individual Genre:
strQuery = "/Collection/DVD/ ( Title | Genres/Genre )"
Roughly translated: display anything that matches "/Collection/DVD/Title" or "/Collection/DVD/Genres/Genre"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: Gandhi
Genre: Drama
Genre: Classic
Title: The Abyss
Genre: Science-Fiction
Genre: Suspense/Thriller
Title: Shouf Shouf Habibi
Genre: Comedy
Note how some DVDs have multiple Genres.
OK, listing properties for each item in a collection no longer has any secrets for you.
Let's select specific items (DVDs) from the collection.
List the titles and genres of all documentaries:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] / ( Title | Genres/Genre )"
The result will look like this:
Title: Wild Down Under
Genre: Documentary
Genre: Special Interest
Title: Pride
Genre: Documentary
Title: March of the Penguins
Genre: Documentary
Title: Alaska: Spirit of the Wild
Genre: Documentary
Genre: Special Interest
Title: Wilderness Journey - Canyon Suites
Genre: Documentary
Genre: Special Interest
Genre: Music
It is possible to select based on genre without displaying it:
strQuery = "/Collection/DVD [ Genres/Genre = 'Documentary' ] /Title"
would only display the titles of the documentaries.
Finally, the selection can be narrowed down by using and and or.
Note that these are case sensitive, so And will not work.
List titles and all formats for each documentary that supports 16x9 format:
strQuery = "/Collection/DVD " _
& "[ Genres/Genre = 'Documentary' and Format/Format16X9 = 'True' ] " _
& "/ ( Title | Format/* )"
The result will look like this:
Title: Wild Down Under
FormatAspectRatio: 1.78
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: False
Format16X9: True
FormatDualSided: False
FormatDualLayered: False
FormatFlipper: False
Title: Pride
FormatVideoStandard: PAL
FormatLetterBox: True
FormatPanAndScan: False
FormatFullFrame: True
Format16X9: True
FormatDualSided: False
FormatDualLayered: True
FormatFlipper: False
. . . TO BE CONTINUED . . .
ZIP files and/or folders with X-ZIPZIP folders with System.Shell Folders' CopyHere methodUNZIP with X-ZIPUNZIP with System.Shell Folders' CopyHere method
ZIP files with
X-ZIP
VBScript Code:
Zip "C:\boot.ini", "C:\testzip.zip"
Function Zip( myFileSpec, myZip )
' This function uses X-standards.com's X-zip component to add
' files to a ZIP file.
' If the ZIP file doesn't exist, it will be created on-the-fly.
' Compression level is set to maximum, only relative paths are
' stored.
'
' Arguments:
' myFileSpec [string] the file(s) to be added, wildcards allowed
' (*.* will include subdirectories, thus
' making the function recursive)
' myZip [string] the fully qualified path to the ZIP file
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-zip component is available at:
' http://www.xstandard.com/en/documentation/xzip/
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=C9891D8A-5390-44ED-BC60-2267ED6763A7
Dim objZIP
On Error Resume Next
Err.Clear
Set objZIP = CreateObject( "XStandard.Zip" )
objZIP.Pack myFileSpec, myZip, , , 9
Zip = Err.Number
Err.Clear
Set objZIP = Nothing
On Error Goto 0
End Function
Requirements:
Windows version:any
Network:any
Client software:X-ZIP component
Script Engine:any
Summarized:Works in any Windows version with the X-ZIP component installed.
ZIP folders with System.Shell Folder's CopyHere method
VBScript Code:
Option Explicit
Dim arrResult
arrResult = ZipFolder( "C:\Documents and Settings\MyUserID\Application Data", "C:\MyUserID.zip" )
If arrResult(0) = 0 Then
If arrResult(1) = 1 Then
WScript.Echo "Done; 1 empty subfolder was skipped."
Else
WScript.Echo "Done; " & arrResult(1) & " empty subfolders were skipped."
End If
Else
WScript.Echo "ERROR " & Join( arrResult, vbCrLf )
End If
Function ZipFolder( myFolder, myZipFile )
' This function recursively ZIPs an entire folder into a single ZIP file,
' using only Windows' built-in ("native") objects and methods.
'
' Last Modified:
' October 12, 2008
'
' Arguments:
' myFolder [string] the fully qualified path of the folder to be ZIPped
' myZipFile [string] the fully qualified path of the target ZIP file
'
' Return Code:
' An array with the error number at index 0, the source at index 1, and
' the description at index 2. If the error number equals 0, all went well
' and at index 1 the number of skipped empty subfolders can be found.
'
' Notes:
' [1] If the specified ZIP file exists, it will be overwritten
' (NOT APPENDED) without notice!
' [2] Empty subfolders in the specified source folder will be skipped
' without notice; lower level subfolders WILL be added, whether
' empty or not.
' [3] There seems to be an undocumented limit to the number of files
' that can be added, possibly due to timeouts; limits may vary from
' 200 to 700 files; better stay well below 200 files just to be safe.
' [4] ZIP files can NEVER exceed 2 GB! This is a limitation in the ZIP
' format itself.
'
' Based on a VBA script (http://www.rondebruin.nl/win/s7/win001.htm)
' by Ron de Bruin, http://www.rondebruin.nl
'
' (Re)written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim intSkipped, intSrcItems
Dim objApp, objFolder, objFSO, objItem, objTxt
Dim strSkipped
Const ForWriting = 2
intSkipped = 0
' Make sure the path ends with a backslash
If Right( myFolder, 1 ) <> "\" Then
myFolder = myFolder & "\"
End If
' Use custom error handling
On Error Resume Next
' Create an empty ZIP file
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
objTxt.Close
Set objTxt = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
' Create a Shell object
Set objApp = CreateObject( "Shell.Application" )
' Copy the files to the compressed folder
For Each objItem in objApp.NameSpace( myFolder ).Items
If objItem.IsFolder Then
' Check if the subfolder is empty, and if
' so, skip it to prevent an error message
Set objFolder = objFSO.GetFolder( objItem.Path )
If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
intSkipped = intSkipped + 1
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Else
objApp.NameSpace( myZipFile ).CopyHere objItem
End If
Next
Set objFolder = Nothing
Set objFSO = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Set objApp = Nothing
Err.Clear
On Error Goto 0
Exit Function
End If
' Keep script waiting until compression is done
intSrcItems = objApp.NameSpace( myFolder ).Items.Count
Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
WScript.Sleep 200
Loop
Set objApp = Nothing
' Abort on errors
If Err Then
ZipFolder = Array( Err.Number, Err.Source, Err.Description )
Err.Clear
On Error Goto 0
Exit Function
End If
' Restore default error handling
On Error Goto 0
' Return message if empty subfolders were skipped
If intSkipped = 0 Then
strSkipped = "
Else
strSkipped = "skipped empty subfolders"
End If
' Return code 0 (no error occurred)
ZipFolder = Array( 0, intSkipped, strSkipped )
End Function
Requirements:
Windows version:Windows 2000, XP, Server 2003 & Vista
Network:any
Client software:N/A
Script Engine:any
Summarized:Should work in Windows 2000 and later.
Will not work in Windows 95, 98, ME or NT.
UNZIP with X-ZIP
VBScript Code:
UnZip "C:\testzip.zip", "D:\", "*.ini"
Function UnZip( myZip, myTargetDir, myFileSpec )
' This function uses X-standards.com's X-zip component to extract files from a ZIP file.
'
' Arguments:
' myZip [string] the fully qualified path to the ZIP file
' myTargetDir [string] the directory where the extracted files will be located
' myFileSpec [string] the file(s) to be extracted, wildcards allowed
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-zip component is available at:
' http://www.xstandard.com/en/documentation/xzip/
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=C9891D8A-5390-44ED-BC60-2267ED6763A7
Dim objZIP
On Error Resume Next
Err.Clear
Set objZIP = CreateObject( "XStandard.Zip" )
objZIP.UnPack myZip, myTargetDir, myFileSpec
UnZip = Err.Number
Err.Clear
Set objZIP = Nothing
On Error Goto 0
End Function
Requirements:
Windows version:any
Network:any
Client software:X-ZIP component
Script Engine:any
Summarized:Works in any Windows version with the X-ZIP component installed.
UNZIP with System.Shell Folder's CopyHere method
(can also be used to extract CAB files and other archives,
or to copy folders while displaying a progress bar)
VBScript Code:
Option Explicit
' UnZip "C:\test.zip" into the folder "C:\test1"
Extract "C:\test.zip", "C:\test1"
' Extract "C:\test.cab" into the folder "C:\test2"
Extract "C:\test.cab", "C:\test2"
' Copy the contents of folder "C:\test2" to the folder "C:\test3"
Extract "C:\test2", "C:\test3"
Sub Extract( ByVal myZipFile, ByVal myTargetDir )
' Function to extract all files from a compressed "folder"
' (ZIP, CAB, etc.) using the Shell Folders' CopyHere method
' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).
' All files and folders will be extracted from the ZIP file.
' A progress bar will be displayed, and the user will be
' prompted to confirm file overwrites if necessary.
'
' Note:
' This function can also be used to copy "normal" folders,
' if a progress bar and confirmation dialog(s) are required:
' just use a folder path for the "myZipFile" argument.
'
' Arguments:
' myZipFile [string] the fully qualified path of the ZIP file
' myTargetDir [string] the fully qualified path of the (existing) destination folder
'
' Based on an article by Gerald Gibson Jr.:
' http://www.codeproject.com/csharp/decompresswinshellapics.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim intOptions, objShell, objSource, objTarget
' Create the required Shell objects
Set objShell = CreateObject( "Shell.Application" )
' Create a reference to the files and folders in the ZIP file
Set objSource = objShell.NameSpace( myZipFile ).Items( )
' Create a reference to the target folder
Set objTarget = objShell.NameSpace( myTargetDir )
' These are the available CopyHere options, according to MSDN
' (http://msdn2.microsoft.com/en-us/library/ms723207.aspx).
' On my test systems, however, the options were completely ignored.
' 4: Do not display a progress dialog box.
' 8: Give the file a new name in a move, copy, or rename
' operation if a file with the target name already exists.
' 16: Click "Yes to All" in any dialog box that is displayed.
' 64: Preserve undo information, if possible.
' 128: Perform the operation on files only if a wildcard file
' name (*.*) is specified.
' 256: Display a progress dialog box but do not show the file
' names.
' 512: Do not confirm the creation of a new directory if the
' operation requires one to be created.
' 1024: Do not display a user interface if an error occurs.
' 4096: Only operate in the local directory.
' Don't operate recursively into subdirectories.
' 8192: Do not copy connected files as a group.
' Only copy the specified files.
intOptions = 256
' UnZIP the files
objTarget.CopyHere objSource, intOptions
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
End Sub
Requirements:
Windows version:Windows 2000, XP, Server 2003 & Vista
Network:any
Client software:N/A
Script Engine:any
Summarized:Should work in Windows 2000 and later.
Will not work in Windows 95, 98, ME or NT.
File Versions
Shell.Application: ProductVersionWindowsInstaller.Installer: ProductVersion (*.msi)
Scripting.FileSystemObject: GetFileVersionScripting.FileSystemObject: DateLastModifiedCompareVersions compares two version strings digit by digit
Shell.Application: ProductVersion
Return a file's product version
VBScript Code:Download💾Function GetProductVersion( myFile )' Based on code by Maputi on StackOverflow.com:' http://stackoverflow.com/a/2990698Dim arrTranslationsDim iDim objFolder, objFolderItem, objShellDim strFileName, strPropertyName, strParentFolder, strVersion' Note that property names are language dependent, so you may have to add the lower case property name for your own languageSet arrTranslations = CreateObject("System.Collections.ArrayList")arrTranslations.Add"product version"' EnglisharrTranslations.Add"productversie"' DutchstrVersion = "strFileName = objFSO.GetFileName( myFile )strParentFolder = objFSO.GetParentFolderName( myFile )Set objShell = CreateObject("Shell.Application")Set objFolder = objShell.Namespace( strParentFolder )Set objFolderItem = objFolder.ParseName( strFileName )For i = 0To300strPropertyName = objFolder.GetDetailsOf( objFolder.Items, i )If arrTranslations.Contains(LCase( strPropertyName ))Then' Product VersionstrVersion = objFolder.GetDetailsOf( objFolderItem, i )ExitForEndIfNextSet objFolderItem = NothingSet objFolder = NothingSet objShell = NothingSet arrTranslations = Nothing' Replace commas by dotsstrVersion = Replace( strVersion, ",", ".")' Remove spacesstrVersion = Replace( strVersion, " ", ")GetProductVersion = strVersionEndFunction
Requirements:
Windows version:2000 and later with .NET Framework 2.0 or later
Network:any
Script Engine:any
Summarized:Works in Windows 2000 and later versions with .NET Framework 2.0 or later installed;
works with all scripting engines;
may require the addition of a translation for "Product Version" in languages other than English and Dutch.
WindowsInstaller.Installer: ProductVersion
Rerurn an MSI file's product version
VBScript Code:
Function GetMSIProductVersion( myFile )' Code by Arnout Grootveld' http://stackoverflow.com/a/328710Const msiOpenDatabaseModeReadOnly = 0Dim objMSI, objDB, objView, strVersionGetMSIProductVersion = "Set objMSI = CreateObject("WindowsInstaller.Installer")Set objDB = objMSI.OpenDataBase( myFile, msiOpenDatabaseModeReadOnly )Set objView = objDB.OpenView("SELECT `Value` FROM `Property` WHERE `Property` = 'ProductVersion'")Call objView.Execute()strVersion = objView.Fetch().StringData(1)' Replace commas by dotsstrVersion = Replace( strVersion, ",", ".")' Remove spacesstrVersion = Replace( strVersion, " ", ")GetMSIProductVersion = strVersionEndFunction
Requirements:
Windows version:Windows XP or later
Network:any
Script Engine:any
Summarized:Works in Windows XP and later versions with all scripting engines.
Scripting.FileSystemObject: GetFileVersion
Rerurn a file's file version
VBScript Code:
Dim objFSO, strFileNamestrFileName = "C:\Windows\notepad.exe"Set objFSO = CreateObject("Scripting.FileSystemObject")WScript.Echo objFSO.GetFileVersion( strFileName )Set objFSO = Nothing
Requirements:
Windows version:any
Network:any
Script Engine:any
Summarized:Works in all Windows versions with all scripting engines.
Scripting.FileSystemObject: DateLastModified
Rerurn a file's timestamp
VBScript Code:
Dim objFSO, strFileNamestrFileName = "C:\Windows\notepad.exe"Set objFSO = CreateObject("Scripting.FileSystemObject")WScript.Echo objFSO.GetFile( strFileName ).DateLastModifiedSet objFSO = Nothing
Requirements:
Windows version:any
Network:any
Script Engine:any
Summarized:Works in all Windows versions with all scripting engines.
CompareVersions
Compare two version strings digit by digit
VBScript Code:
Function CompareVersions( myVer1, myVer2 )' Function : CompareVersions compares 2 version strings and returns' an integer value telling you which version is higher.' Returns : A positive value means myVer1 is higher than myVer2,' a negative value means myVer1 is lower than myVer2,' zero means the versions are equal.' If the absolute value of the result equals 2, only the' number of digits from the shortes of versions were compared;' if the absolute value equals 1, the shortest of versions had a' number of zeroes appended before the comparison was conclusive.' Examples : CompareVersions( "10.2.0", "10.1.1900" ) returns 2' CompareVersions( "10.1.0.1900", "10.1" ) returns 1' CompareVersions( "10.00.0.0.0", "10.0" ) returns 0' CompareVersions( "10.0", "10.0.0.1850" ) returns -1' CompareVersions( "9.9.99.9999", "10.1" ) returns -2' Version : 1.00 (2017-02-17)' Author : Rob van der Woude' http://www.robvanderwoude.com/'Dim arrVer1, arrVer2Dim i, intCompare, intMax, intMinintCompare = 0If myVer1 <> myVer2 ThenarrVer1 = Split( myVer1, ".")arrVer2 = Split( myVer2, ".")IfUBound( arrVer1 )>UBound( arrVer2 )ThenintMax = UBound( arrVer1 )intMin = UBound( arrVer2 )For i = intMin To intMaxmyVer2 = myVer2 & ".0"NextarrVer2 = Split( myVer2, ".")ElseIfUBound( arrVer1 )<UBound( arrVer2 )ThenintMax = UBound( arrVer2 )intMin = UBound( arrVer1 )For i = intMin To intMaxmyVer1 = myVer1 & ".0"NextarrVer1 = Split( myVer1, ".")ElseintMax = UBound( arrVer1 )intMin = intMaxEndIfFor i = 0To intMinIfCInt( arrVer1(i))>CInt( arrVer2(i))ThenintCompare = 2ExitForElseIfCInt( arrVer1(i))<CInt( arrVer2(i))ThenintCompare = -2ExitForEndIfNextIf intCompare = 0ThenFor i = intMin +1To intMaxIfCInt( arrVer1(i))>CInt( arrVer2(i))ThenintCompare = 1ExitForElseIfCInt( arrVer1(i))<CInt( arrVer2(i))ThenintCompare = -1ExitForEndIfNextEndIfEndIfCompareVersions = intCompareEndFunction
Requirements:
Windows version:any
Network:any
Script Engine:any
Summarized:Works in all Windows versions with all scripting engines.
Create Folders
the way CMD.EXE's MD does
This script by Todd Reeves allows us to create folders several levels deep all in one go, like CMD.EXE's internal MD command does.
CreateDirs (Scripting.FileSystemObject)
VBScript Code:
Option Explicit
' UNC path
CreateDirs "\\MYSERVER\D$\Test01\Test02\Test03\Test04"
' Absolute path
CreateDirs "D:\Test11\Test12\Test13\Test14"
' Relative path
CreateDirs "Test21\Test22\Test23\Test24"
Sub CreateDirs( MyDirName )
' This subroutine creates multiple folders like CMD.EXE's internal MD command.
' By default VBScript can only create one level of folders at a time (blows
' up otherwise!).
'
' Argument:
' MyDirName [string] folder(s) to be created, single or
' multi level, absolute or relative,
' "d:\folder\subfolder" format or UNC
'
' Written by Todd Reeves
' Modified by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild
' Create a file system object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Convert relative to absolute path
strDir = objFSO.GetAbsolutePathName( MyDirName )
' Split a multi level path in its "components"
arrDirs = Split( strDir, "\" )
' Check if the absolute path is UNC or not
If Left( strDir, 2 ) = "\\" Then
strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
idxFirst = 4
Else
strDirBuild = arrDirs(0) & "\"
idxFirst = 1
End If
' Check each (sub)folder and create it if it doesn't exist
For i = idxFirst to Ubound( arrDirs )
strDirBuild = objFSO.BuildPath( strDirBuild, arrDirs(i) )
If Not objFSO.FolderExists( strDirBuild ) Then
objFSO.CreateFolder strDirBuild
End if
Next
' Release the file system object
Set objFSO= Nothing
End Sub
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version, with any scripting engine.
Delete Folders
including subfolders
This script deletes folders, empty or not, all in one go, like DOS' DELTREE command does.
DelTree
VBScript Code:
Option Explicit
Dim objFSO, objTempFolder, strTempFolder
Const TEMP_FOLDER = 2
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set objTempFolder = objFSO.GetSpecialFolder( TEMP_FOLDER )
strTempFolder = objTempFolder.Path
DelTree strTempFolder, True
Sub DelTree( myFolder, blnKeepRoot )
' With this subroutine you can delete folders and their content,
' including subfolders.
' You can specify if you only want to empty the folder, and thus
' keep the folder itself, or to delete the folder itself as well.
' Root directories and some (not all) vital system folders are
' protected: if you try to delete them you'll get a message that
' deleting these folders is not allowed.
'
' Arguments:
' myFolder [string] the folder to be emptied or deleted
' blnKeepRoot [boolean] if True, the folder is emptied only,
' otherwise it will be deleted itself too
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
Dim arrSpecialFolders(3)
Dim objMyFSO, objMyFile, objMyFolder, objMyShell
Dim objPrgFolder, objPrgFolderItem, objSubFolder, wshMyShell
Dim strPath, strSpecialFolder
Const WINDOWS_FOLDER = 0
Const SYSTEM_FOLDER = 1
Const PROGRAM_FILES = 38
' Use custom error handling
On Error Resume Next
' List the paths of system folders that should NOT be deleted
Set wshMyShell = CreateObject( "WScript.Shell" )
Set objMyFSO = CreateObject( "Scripting.FileSystemObject" )
Set objMyShell = CreateObject( "Shell.Application" )
Set objPrgFolder = objMyShell.Namespace( PROGRAM_FILES )
Set objPrgFolderItem = objPrgFolder.Self
arrSpecialFolders(0) = wshMyShell.SpecialFolders( "MyDocuments" )
arrSpecialFolders(1) = objPrgFolderItem.Path
arrSpecialFolders(2) = objMyFSO.GetSpecialFolder( SYSTEM_FOLDER ).Path
arrSpecialFolders(3) = objMyFSO.GetSpecialFolder( WINDOWS_FOLDER ).Path
Set objPrgFolderItem = Nothing
Set objPrgFolder = Nothing
Set objMyShell = Nothing
Set wshMyShell = Nothing
' Check if a valid folder was specified
If Not objMyFSO.FolderExists( myFolder ) Then
WScript.Echo "Error: path not found (" & myFolder & ")"
WScript.Quit 1
End If
Set objMyFolder = objMyFSO.GetFolder( myFolder )
' Protect vital system folders and root directories from being deleted
For Each strSpecialFolder In arrSpecialFolders
If UCase( strSpecialFolder ) = UCase( objMyFolder.Path ) Then
WScript.Echo "Error: deleting " _
& objMyFolder.Path & " is not allowed"
WScript.Quit 1
End If
Next
' Protect root directories from being deleted
If Len( objMyFolder.Path ) < 4 Then
WScript.Echo "Error: deleting root directories is not allowed"
WScript.Quit 1
End If
' First delete the files in the directory specified
For Each objMyFile In objMyFolder.Files
strPath = objMyFile.Path
objMyFSO.DeleteFile strPath, True
If Err Then
WScript.Echo "Error # " & Err.Number & vbCrLf _
& Err.Description & vbCrLf _
& "(" & strPath & ")" & vbCrLf
End If
Next
' Next recurse through the subfolders
For Each objSubFolder In objMyFolder.SubFolders
DelTree objSubFolder, False
Next
' Finally, remove the "root" directory unless it should be preserved
If Not blnKeepRoot Then
strPath = objMyFolder.Path
objMyFSO.DeleteFolder strPath, True
If Err Then
WScript.Echo "Error # " & Err.Number & vbCrLf _
& Err.Description & vbCrLf _
& "(" & strPath & ")" & vbCrLf
End If
End If
' Cleaning up the mess
On Error Goto 0
Set objMyFolder = Nothing
Set objMyFSO = Nothing
End Sub
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Should work in any Windows version, with any scripting engine.
HTAs
HTAs (HTML Applications) are webpages (forms), with access to local resources.
Though the engine that executes HTAs (MSHTA.EXE) shares a lot of code with Internet Explorer, it doesn't have Internet Explorer's tight security restrictions.
In fact, if run with elevated privileges, HTAs have access to every resource that administrators have access to!
If you want to build a nice looking user interface for your VBScript scripts collection, try an HTA (or rewrite them in Visual Basic).
If you need to build a proof of concept for a new program, consider an HTA.
Microsoft's Visual Studio 2010 Express Edition installer is an example of a great looking HTA.
HTAEdit (now seamlessly integrated in VBSEdit)
On this page, I intend to show some of the pitfalls I encountered in building HTAs, and some solutions or work-arounds.
My preferred tool for developing HTAs is VBSEdit.
It used to come with a separate program HTAEdit in a single package, but recently these programs have been merged, and the new VBSEdit now handles HTAs too.
VBSEdit comes with a built-in debugger, but debugging an HTA is much harder then debugging VBScript code, so I usually write and test VBScript code in VBSEdit, and when ready, use it in an HTA's subroutines.
HTAs aren't restricted to HTML and VBScript, you can use JScript and JavaScript without the need to install anything, and PerlScript if you install Perl.
Note:When using multiple scripting languages in a single HTA, allevent handlers (e.g. onclick) must always specify the language for the called commands, e.g.:
<input type="button" value="Click Me" onclick="vbscript:MsgBox 'Click Me (VBScript)'" />
<input type="button" value="No, Me" onclick="javascript:alert('No, Me (JavaScript)');" />
Building Your HTA
Each HTA is actually an HTML page with one or more HTA specific code blocks.
Code DescriptionRemarks
<!DOCTYPE HTML>Document Type DeclarationOptional but recommended for IE versions > 6
<html lang="en">HTML begin<html> required, language (lang property) optional but recommended
<head>HTML head beginRequired
<title>My HTML application</title>HTML/HTA title bar captionOptional but recommended, will also show up in Windows' task bar, can be read or set with document.title
<HTA:APPLICATIONHTA definition block beginRequired; for a detailed list of all available properties see Microsoft's HTML Applications Reference
APPLICATIONNAME="HTA Name"HTA nameRequired; can be read by script with HTAID.ApplicationName
ID="HTAID"HTA unique IDRequired
VERSION="1.0"HTA versionRequired; can be read by script with HTAID.Version
BORDER="none"
SCROLL="auto"
SINGLEINSTANCE="yes"Only one HTA with this HTA's ID can run at any timeIf omitted or "no", multiple instances of this HTA can run simultaneously
WINDOWSTATE="maximize"Maximize the HTA window when openedOptional; not recommended if the HTA window must be resizable, as the window may resize spontaneously when dragged
NAVIGABLE="yes"
/>End of HTA definition block
<meta http-equiv="x-ua-compatible" content="ie=9" />Compatibility meta tagOptional; this will enable many CSS 3 and HTML 5 features, but you will need to adjust your event handlers
<style type="text/css">Stylesheet beginOptional; external stylesheets are allowed too
•
•
•CSS style definitions
</style>End of stylesheet
</head>End of HTML headRequired
<script language="VBScript">WSH (VBScript) code beginUnlike JavaScript in web pages, which is located either inside the HTML head or inside the HTML body, the HTA's code (usually VBScript, but may also be JScript or PerlScript or any WSH supported scripting language) is positioned between the HTML head and body
Option Explicit
Dim global_variablesGlobal variables declarationDeclare global variables here, set them in Window_OnLoad (or elsewhere)
Sub window_onloadUse this code block to initialize objects and variables, parse the (optional) command line, etc.
'This method will be called
'when the application loads
End Sub
•
•
•Place your other subroutines here
Sub window_onunloadUse this code block to clean up objects, close files, etc.
'This method will be called
'when the application exits
End Sub
</script>End of WSH (VBScript) code
<script type="text/javascript">JavaScript code beginOptional; external javascripts are allowed too, inside the head or body;
unlike "true" web pages, in HTA's the JavaScript code may be located between the head and the body as well as inside.
•
•
•JavaScript code
</script>End of JavaScript code
<body>HTML bodyUse the HTML body to build the HTA's user interface
•
•
•
</body>
</html>End of file
Adding Controls
In an HTA, you can add elements and controls just like you would in a web form.
You can reference an element directly by its ID, e.g. if you have a textbox with ID "MyTextBox" you can read its value with the following code:
strText = MyTextBox.value
Or:
strText = document.getElementById( "MyTextBox" ).value
The latter is much easier to debug in VBSEdit.
Global Variables
Using local variables inside subroutines is a piece of cake.
Global variables in HTAs, on the other hand, require some extra attention.
Start the VBScript code block wit the declaration of all global variables (Dim statements) and all constants (Const statements).
I recommend using a variable naming convention that clearly shows whether a variable is global or local.
I use 3 letter prefixes for all variables in my VBScript scripts, e.g. strVar for strings, objVar for objects, arrVar for arrays...
In HTAs, however, I use those prefixes for local variables only, and use prefixes starting with gv for global variables, e.g. gvsVar for strings, gvoVar for objects, gvaVar for arrays...
This is not required, you are even free to use no prefixes at all, but these naming conventions do make debugging a lot easier.
Though not recommended, you could choose to set a global variable right after declaring it, e.g.
Dim gvoFSO
Set gvoFSO = CreateObject( "Scripting.FileSystemObject" )
The recommended way, however, is to declare the global variable at the top of the VBScript code block, and set it in the window_onload (or any other) subroutine.
Setting a global variable using a subroutine (or setting a Control property) should be done in the window_onload subroutine, which is executed after the entire HTA window is loaded.
MSHTA.EXE reads the entire VBScript code block linearly, from top to bottom, loading subroutines and executing non-subroutine code immediately.
Once the entire HTA is loaded, it executes the window_onload subroutine.
MSHTA.EXE cannot execute subroutines it hasn't read and loaded yet; likewise, it cannot set a property of a control, as these have not been created yet.
Summarizing:For easier maintenance, declare your global variables at the top of the VBScript code block, and set them in the window_onload subroutine (or in other subroutines).
Demo Project: My First HTML Application
For this demo, we will create an HTA that accepts a number as input, and then checks if it is a prime number.
Yes, if you are new to HTAs, the following code might look rather overwhelming.
Don't worry, I will explain most of it.
And you don't have to retype the code, it can be downloaded here.
<!DOCTYPE HTML><html><head><title>My First HTML Application</title><HTA:APPLICATION APPLICATIONNAME="My First HTML Application"ID="MyFirstHTA"VERSION="1.0" SCROLL="no"/><styletype="text/css">body {background-color:#fdfeff;color:darkblue;font-family: Calibri;font-size:12pt;margin:4em3em;}</style></head><scriptlanguage="VBScript">OptionExplicitSub CheckIfPrime( )Dim i, intInputintInput = document.getElementById( "InputNumber" ).valueIf intInput < 3 Thendocument.getElementById( "OutputResult" ).innerHTML = "Yes, " & intInput & " is a prime number."ElseFor i = 2 To intInput - 1If intInput Mod i = 0 Thendocument.getElementById( "OutputResult" ).innerHTML = "No, " & intInput & " is not a prime number."ExitSubEndIfNextdocument.getElementById( "OutputResult" ).innerHTML = "Yes, " & intInput & " is a prime number."EndIfEndSubSub ValidateInput( )Dim objRE, strInputstrInput = document.getElementById( "InputNumber" ).valueSet objRE = New RegExpobjRE.Global = TrueobjRE.Pattern = "[^\d]+"If objRE.Test( strInput ) ThenstrInput = objRE.Replace( strInput, " )document.getElementById( "InputNumber" ).value = strInputdocument.getElementById( "OutputResult" ).innerHTML = "Enter a number, and click the "Check" button to check if it is a prime number."EndIfIf strInput = "Thendocument.getElementById( "OutputResult" ).innerHTML = "Enter a number, and click the "Check" button to check if it is a prime number."EndIfSet objRE = NothingEndSubSub Window_OnLoadwindow.resizeTo 640, 480document.title = document.title & ", Version " & MyFirstHTA.VersionEndSub</script><body><p><inputtype="text"id="InputNumber"onchange="ValidateInput"onkeyup="ValidateInput"/> <inputtype="button"value="Check"onclick="CheckIfPrime"/></p><p> </p><pid="OutputResult">Enter a number, and click the "Check" button to find out if it is a prime number.</p></body></html>
Explanation:
As mentioned earlier, the HTA starts with an HTML like head.
Specifying a DocType (line 1) is optional, but it may help getting more predictable results when running the HTA in different Windows versions.
Unlike "true" web pages, you don't have to include a <title> tag here, you can set it later, on-the-fly, which is demonstrated in the Window_OnLoad subroutine, on line 61.
In the head we also find the mandatory <HTA:APPLICATION> tag (lines 6..10);
Copy and paste it from this page or from any other HTA and use Microsoft's HTML Applications Reference to add or modify its properties.
Just for the sake of demonstration, I also included an optional stylesheet (lines 12..20).
The body (lines 65..75) contains 3 main elements:
A textbox (line 67, ID InputNumber) to enter the number in; note that HTML 5's type="number" is ignored in HTAs, that is why we call the ValidateInput subroutine using the onchange and onkeyup event handlers.
A button (line 69) that will call the CheckIfPrime subroutine when clicked.
A text paragraph (line 73, ID OutputResult) that can be modified on-the-fly.
Between the head and the body we have a (VBScript) code block (lines 23..63).
Option Explicit (line 24) is optional, but you really should include this, if only for debugging purposes.
Subroutine CheckIfPrime( ) (lines 26..40) is the main program, checking the number and returning the result.
It reads the entered number using the code in line 28:
intInput = document.getElementById( "InputNumber" ).value
There is no need to check if the input actually is a positive integer, since validation is already handled by the ValidateInput( ) helper subroutine.
After checking if the number is a prime number, the result has to be presented (lines 30, 34 & 38):
document.getElementById( "OutputResult" ).innerHTML = "Yes, " & intInput & " is a prime number."
This will replace the text in the ouput text paragraph (line 73, ID OutputResult).
Subroutine ValidateInput( ) (lines 42..57) is a helper subroutine, filtering out everything from the input but numbers.
It is triggered when the content of the textbox (line 67, ID InputNumber) is changed (onchange event handler, i.e. on change of typed input, but also when new input is pasted from the clipboard) or when a key is pressed (onkeyup event handler).
The code in line 44 reads the input just like the CheckIfPrime( ) does.
The subroutine then uses a regular expression to remove everything but numbers (line 49).
The code in line 50 writes the corrected input back into the textbox.
The code in lines 51 and 54 changes the output text from result to description.
Subroutine Sub Window_OnLoad (lines 59..62) is executed when the HTA is loaded.
In our demo it resizes the HTA's window (line 60) and sets the HTA's title (line 61).
Investigate the demo script, play with it, e.g. change the presentation of the results, or try making it accept hexadecimal numbers, or trigger CheckIfPrime( ) when pressing the Enter key . . .
Whatever you like.
HTA's Path
Getting the full path to the HTA is easy:
strHTAPath = Self.location.pathname
Note:Keep in mind that, when running an HTA in VBSEdit, it runs a copy of the HTA in a different location!
Command Line Arguments
Handling command line arguments in HTAs is not as sophisticated as it is in "pure" VBScript, but it is "doable".
You can read the command line as a property of the HTA, so you need to use the HTA's ID:
strCommandLine = MY_HTA_ID.CommandLine
where MY_HTA_ID is the HTA's ID as defined in the HTA's head.
The string returned as command line starts with the HTA's full path, followed by the command line arguments, if any.
The HTA's path may be in doublequotes.
To get the command line arguments only you could use the following code:
If Left( MY_HTA_ID.CommandLine, 1 ) = """" Then
strCommandLineArguments = Trim( Mid( MY_HTA_ID.CommandLine, Len( Self.location.pathname ) + 3 ) )
Else
strCommandLineArguments = Trim( Mid( MY_HTA_ID.CommandLine, Len( Self.location.pathname ) + 1 ) )
End If
Close the HTA
Closing the HTA is simple, use either:
Self.close
or:
window.close True
I could not find documentation on the optional True argument of window.close.
I have once been told it forces the window to close, and my extemely limited testing showed that:
it sometimes seems to do just that
most of the times it makes no difference
so far it never hurt
But, since VBSEdit only "recognizes" Self.close I would recommend using that.
In case you run the HTA in compatibility mode you may sometimes have to use window.close( ) (e.g. when using it in an event handler, <input type="button" value="Quit" onclick="window.close( )" /> otherwise you might get a "Self is not defined" error message)
Resize the HTA
To resize the HTA window, use the following code (e.g. in the Window_OnLoad subroutine):
window.resizeTo width, height
e.g.:
window.resizeTo 640, 480
Instead of placing the VBScript code in Window_OnLoad, you may also place it in the HTA's head as JavaScript:
<script type="text/javascript">window.resizeTo(640, 480);</script>
Important:Do not set the WINDOWSTATE in your HTA definition block when using code to resize the HTA's window.
Get the HTA Window's Dimensions
The current width of the HTA can be obtained using the following VBScript code:
intWidth = document.body.offsetWidth
Likewise, the current height of the HTA can be obtained using:
intHeight = document.body.offsetHeight
Add a CSS style to allow measuring the window dimensions even if all content fits in the window:
body, html { width: 100%; height: 100%; }
Center the HTA on Screen
To center the HTA on screen, use the following VBScript code:
posX = CInt( ( window.screen.width - document.body.offsetWidth ) / 2 )
posY = CInt( ( window.screen.height - document.body.offsetHeight ) / 2 )
If posX < 0 Then posX = 0
If posY < 0 Then posY = 0
window.moveTo posX, posY
Add a CSS style to allow measuring the window dimensions even if all content fits in the window:
body, html { width: 100%; height: 100%; }
Minimize or Maximize the HTA
To make the HTA minimize its own window, place the following code between the HTA's head and its VBScript section:
<!-- This "HHCtrlMinimizeWindowObject" works together with the JavaScript function "_jsMinWin()" and -->
<!-- the hidden input "MinimizeWindow" to minimize the HTA window (use "MinimizeWindow.click" in VBScript) -->
<object id="HHCtrlMinimizeWindowObject" classid="clsid:adb880a6-d8ff-11cf-9377-00aa003b7a11">
<param name="command" value="minimize" />
</object>
<script type="text/javascript">
function _jsMinWin( ) {
try {
HHCtrlMinimizeWindowObject.Click( );
}
catch ( err ) {
alert( err.message );
}
}
</script>
Place the following code in the HTA's body:
<!-- This hidden input works together with the JavaScript function "_jsMinWin()" and the object -->
<!-- "HHCtrlMinimizeWindowObject" to minimize the HTA window (e.g. use "MinimizeWindow.click" in VBScript) -->
<input type="hidden" name="MinimizeWindow" id="MinimizeWindow" onclick="javascript:_jsMinWin();" />
You can now have the HTA minimize itself using the VBScript code MinimizeWindow.click or document.getElementById( "MinimizeWindow" ).click
The code required to maximize the HTA again is very similar; place the following code between the HTA's head and its VBScript section:
<!-- This "HHCtrlMaximizeWindowObject" works together with the JavaScript function "_jsMaxWin()" and -->
<!-- the hidden input "MaximizeWindow" to maximize the HTA window (use "MaximizeWindow.click" in VBScript) -->
<object id="HHCtrlMaximizeWindowObject" classid="clsid:adb880a6-d8ff-11cf-9377-00aa003b7a11">
<param name="command" value="maximize" />
</object>
<script type="text/javascript">
function _jsMaxWin( ) {
try {
HHCtrlMaximizeWindowObject.Click( );
}
catch ( err ) {
alert( err.message );
}
};
</script>
Place the following code in the HTA's body:
<!-- This hidden input works together with the JavaScript function "_jsMaxWin()" and the object -->
<!-- "HHCtrlMaximizeWindowObject" to maximize the HTA window (e.g. use "MaximizeWindow.click" in VBScript) -->
<input type="hidden" name="MaximizeWindow" id="MaximizeWindow" onclick="javascript:_jsMaxWin();" />
You can now have the HTA maximize itself using the VBScript code MaximizeWindow.click or document.getElementById( "MaximizeWindow" ).click
Important:Do not set the WINDOWSTATE in your HTA definition block when using this code.
Minimizing or maximizing the HTA window using this code will fail if the HTA lost focus.
So to keep on the safe side, insert a line window.focus just before the M**imizeWindow.click code.
Improve Loading Speed With MultiThreading
When an HTA loads, it won't show its interface untill all work has been done, i.e. untill the code in the Window_OnLoad subroutine, and all other code called from there, has been executed.
From the outside, it may look like the HTA loads an empty window "frame" and then waits for several seconds before showing its inteface elements.
You can speed up the loading of the interface by only executing the code to build the interface in the Window_OnLoad subroutine, and then start a new thread to initialize the "background" code.
Starting a new thread is not that complicated:
window.setTimeout "subroutine", 1000, "VBScript"
This will start subroutine after a 1 second (1000 milliseconds) delay, allowing the HTA enough time to render its interface before continuing.
The first argument for window.setTimeout, the command or subroutine to be started, may have some arguments of its own, replacing the doublequotes on subroutines's command line by singlequotes, e.g.:
window.setTimeout "MsgBox 'This MsgBox was started in a separate thread', vbOKOnly, 'Test'", 1000, "VBScript"
As you can see from the example, finding typos may be a bit harder than usual.
The third argument for window.setTimeout will be "VBScript" in most cases.
However, it also opens up a way to start a JavaScript code block, by using "JavaScript".
Embedding Images
As one might expect, it is possible to use images in HTAs with the <img src="..." /> tag.
Personally I prefer to distribute HTAs as a single file.
The good news: it is possible with inline-images.
The bad news: your HTA may become huge!
First compress your image as much as is acceptable (e.g. JPEG compression, decrease color depth, etc.).
To convert the image to a string that can be embedded in the HTA you can use base64 encoding.
Assuming you have the b64 utility from SourceFourge.net, use b64 -e image.gif image.b64 to encode the image, and embed the image like this (string marked red is the content of image.b64):
<img src="data:image/gif;base64,R0lGODlhIAAgAOYAAABbAIiwiER8RADMANbW1gCZAGaZZsXFxR3oHTrWOgCDAK60rgD0AA6dDmm+aRZmFlDBPubm5gDoACKN
Ir7mvlCeUACjAGb/ZqK0ojz4PAB1ACbUJgC1AESSRA7DDgDeAA+FD9jl2FbSVmmtab29vUS6PhqnGj62Poi2iACZAO7u7hPSE8zMzABmAN3d3VCsUHj4eH6/fqfMp1q+
WiL/In6ufh1xHXGccUzXTBqwAADuAAC9AAD/AADVAN7w3gtlC0mHSR3FHYjDiAqnAAWSBQB6AB6nHl62XpWmlQCLADfpN3WwdSJsIkSNRB/4H6fEp1DqUEH/QQicCDPM
M0mpSQDDAEmUSSKTIpWxlS1xLQBmAACwAMPqvlCkUFGyUZWwlQuiC3G/ahKlEg+MDz7JPhWvFafWp3u4ewtpCx+rH3a1dv///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAUUAGsALAAAAAAgACAAAAf/gGuCg4SFhoeIiYqLjI2Oj5CRhFwQORSSiBQlQ0NhFjOYhBQnFqVn
B0YFXiqYPjMFYAUFSwcuDrIvrI+uBWIiaQ01tWtmBWQFuY0+RwUNODAmUljDgkkJCUnJictJRFMXUA1jXwcRhFRlURtJXbqFKmHdQRlRSkRXGCzmhEJENDQrFLQjpCLG
mCQenPxDQGTCAn2GQij4wIPHAAUVWBUEkaQKg4oWFTiEeGgCB5ADilRQA6LIjo8oi3R4uO/QiCQMcjKoUqSIBQk6c/LsQIKAu0MyNHzQwVRHj6VNmVrQ0KToUUQadkjY
yrWrhAIablhtZCXJh7No0xZocYNaIxRKYtOi7VGErdtGIVps6cG3L100SO46spFkgGHDVTT8COwCk4EWhwdwaPEACUlJTwBwqFJlSwsmNEMJAlBgh4XPoUWvAVKkAIAs
qVUHAABAQNGaqkMAADJWNaEIBIz6Hk68eKhAADs=" title="Embedded icon" />
And this is what our example looks like:
And if you aren't convinced yet, check the properties of the demo project screenshotabove . . .
Or check the source code of my Attic Numerals Converter.
Embed an Icon
Assume you have an icon d:\iconsfolder\myicon.ico that you want to use for your HTA d:\scriptsfolder\myhta.hta.
If you don't mind having the icon in a separate file, add the following code to the HTA's HTA:APPLICATION block:
ICON="D:\iconsfolder\myicon.ico"
and you're done.
Instead of an absolute path, you can use a relative path, and the easiest relative path is the HTA's parent folder.
Move the icon to the HTA's parent folder and add this code to the HTA's HTA:APPLICATION block:
ICON="myicon.ico"
If you prefer to distribute your HTA as a single self-contained file, it is possible to embed an icon (or, unfortunately, any type of binary payload, including malware), by prepending it to the HTA.
I found this trick by Emeric Nasi to embed an icon in the HTA at Sevagas.com.
Add the following code to the HTA's HTA:APPLICATION block:
ICON="#"
Then embed the icon using the following command on a CMD prompt:
COPY /B d:\iconsfolder\myicon.ico + d:\scriptsfolder\myhta.hta d:\scriptsfolder\_myhta.hta
The new HTA d:\scriptsfolder\_myhta.hta will have the icon embedded.
If you want to edit the HTA later, use the original one or remove all binary code before the <html> opening tag, as most text editors will corrupt the embedded icon.
When you are finished editing the HTA, use the same command once more to embed an icon.
Warning:Because of the ability to embed malware, you may seriously want to consider not using this technique!
Most AntiVirus software will be triggered by the prepended binary payload.
Get the HTA's Process ID
Insert the following function in you HTA's VBScript block, and call MyPID( ) when you need the HTA's process ID:
Function MyPID( )
Dim colItems, intCount, intPID, objItem, objWMIService, strQuery
intCount = 0 ' Keeps track of the number of simultaneous instances of this HTA
intPID = -1
' WMI query must be escaped, hence the replacement of single backslashes by double backslashes
strQuery = "Select * From Win32_Process Where CommandLine Like '%" & Replace( self.location.pathname, "\", "\\" ) & "%'"
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( strQuery )
For Each objItem in colItems
intCount = intCount + 1
intPID = objItem.ProcessId
Next
Set colItems = Nothing
Set objWMIService = Nothing
' Set result to -1 in case of zero or multiple simultaneous instances of this HTA
If intCount <> 1 Then intPID = -1
MyPID = intPID
End Function
Note that this function will return -1 if multiple instances of the same HTA are running simultaneously.
HTA Quirks and Restrictions
By default, HTAs display webpages in Compatibility View, which displays standards-mode content in IE7 Standards mode and quirks mode content in IE5 (Quirks) mode.
Rounded corners, rotated text, HTML 5's new input types, and other HTML 5 and CSS 3 features are ignored in this default mode.
The solution is to insert the following meta tag in the head of the HTA:
<meta http-equiv="x-ua-compatible" content="ie=9" />
This will enable HTML 5 and CSS 3 support in your HTA (though <input type="number" /> still seems to be ignored).
You may change content="ie=9" to content="ie=10" if you want, higher is not recommended because it introduces new serious challenges and quirks.
Some errors that may occur, and that are easy to prevent:
window_onload is not exetuted: with content="ie=11" or content="ie=edge", VBScript code no longer seems to be recognized; either revert to content="ie=9" or convert all code to JavaScript
Object doesn't support this property or method for HTAID.version: revert to content="ie=9"'Window_OnLoad' is not defined: rename your subroutines Window_OnLoad and Window_OnUnload to window_onload and window_onunload respectively (lower case)
'Self' is not defined: when called directly in event handlers (e.g. onclick) make sure to use self in lower case (e.g. onclick="self.close( )")
Other not defined errors in subroutines called by event handlers: make sure the case of the subroutine's name matches, and that the language is defined, and add parentheses (e.g. onclick="vbscript:MySubroutine( )")
Warning:Some versions of VBSEdit may sometimes revert your case changes while editing (e.g. Self), so stay alert!
Make sure you also use the proper document type declaration at the top of the HTA:
<!DOCTYPE HTML>
Note, however, that in Windows 7 (and possibly in Windows 8 too) you now need to adjust all event handlers!
E.g. the "old" code:
<input type="button" value="Check" onclick="CheckIfPrime" />
must be changed into the "new" code:
<input type="button" value="Check" onclick="vbscript:CheckIfPrime( )" />
In Windows 10 this is not required (though it won't hurt), unless you use both VBScript and JavaScript.
VBSEdit Limitations
Testing your HTAs in VBSEdit is great, much faster than having to switch from the editor to a command line or Windows Explorer and vice versa.
Keep in mind, though, that when you click the "Run" button (or hit F5), VBSEdit will open and run a copy of the HTA in a different location!
Though the order of your HTA's subroutines is not critical to run it, VBSEdit's debugger treats them rather "linearly", e.g. if a global variable/object is set in line 100 in the Window_OnLoad subroutine, and referred to in another subroutine in line 50, VBSEdit's debugger will consider the variable/object not set.
So, for debugging purposes, you may want to change the order of the subroutines, as explained in the next paragraph.
Compatibility mode is great if you want to use rounded corners, rotated text and many other CSS 3 features, but it may make debugging a challenge in VBSEdit.
Compare the error messages when clicking the "Test" button in the following demo HTA, for quirks mode and for compatibility mode.
Quirks Mode (disabled meta tag in line 4)
<!DOCTYPE HTML><htmllang="en"><head><!--<meta http-equiv="x-ua-compatible" content="ie=9" />--><title>My HTML application</title><HTA:APPLICATION APPLICATIONNAME="My HTML application"ID="MyHTMLapplication"VERSION="1.0"/></head><scriptlanguage="VBScript">Sub TestDebugging( )document.getElementById( "DoesNotExist" ).value = "Error"EndSub</script><body><inputtype="button"value="Test"onclick="vbscript:TestDebugging( )"/></body></html>
The following error message appears when the "Test" button is clicked:
The error message points out the exact line where the error occurred.
Compatibility Mode (enabled meta tag in line 4)
<!DOCTYPE HTML><htmllang="en"><head><meta http-equiv="x-ua-compatible" content="ie=9" /><title>My HTML application</title><HTA:APPLICATION APPLICATIONNAME="My HTML application"ID="MyHTMLapplication"VERSION="1.0"/></head><scriptlanguage="VBScript">Sub TestDebugging( )document.getElementById( "DoesNotExist" ).value = "Error"EndSub</script><body><inputtype="button"value="Test"onclick="vbscript:TestDebugging( )"/></body></html>
The following error message appears when the "Test" button is clicked:
Now the error message points to the line calling the subroutine that contains the error!
This gets even worse when nesting subroutines...
The work-around for this limitation is to temporarily disable compatibility mode until all VBScript code has been debugged.
Unfortunately, after enabling compatibility mode, you still have to debug all code once more, to test for compatibility issues...
Debugging
Editors like VBSEdit make debugging HTAs easier, but not quite as easy as "normal" VBScript code.
Some tips:
All advices for debugging VBScript are valid for debugging HTAs too.
When using global variables in HTAs, declare them at the top of the code block, set them in the window_onload subroutine, and clear objects in the window_onunload subroutine.
Place the window_onload subroutine just below the global declarations, the window_onunload subroutine at the end of the code block, and all other subroutines in between.
Why? Because VBSEdit's built-in debugger doesn't recognize objects in code lines after the one where they are cleared, i.e. Set object = Nothing.
Though multithreading is quite easy in HTAs, debugging a separate thread is impossible in VBSEdit's debugger.
So you'd better postpone using multithreading untill all debugging has been done.
Global variables will not be shown in VBSEdit's debugger window when hitting a breakpoint in a subroutine.
It may be useful to declare a dummy variable in the subroutine you are debugging, and then set its value to that of the global variable just before the breakpoint.
Clean Up Your Code
More, even, then "normal" VBScript code, HTA code can have some stray code left after making changes: undeclared new variables, unused variables, or even entire unused subroutines.
This will increase maintenance complexity of your HTA.
Using an editor like VBSEdit you will get warnings when trying to use undeclared variables, including typos in variable names (assuming Option Explicit is your first line of code in the VBScript block, which is highly recommended).
Use my CheckVarsVBS.exe to check for unused variables and subroutines.
WinHTTP
VBScript Code:
HTTPDownload "http://www.robvanderwoude.com/files/wmigen.zip", "C:\"
Sub HTTPDownload( myURL, myPath )
' This Sub downloads the FILE specified in myURL to the path specified in myPath.
'
' myURL must always end with a file name
' myPath may be a directory or a file name; in either case the directory must exist
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' Based on a script found on the Thai Visa forum
' http://www.thaivisa.com/forum/index.php?showtopic=21832
' Standard housekeeping
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Create a File System Object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Check if the specified target file or folder exists,
' and build the fully qualified path of the target file
If objFSO.FolderExists( myPath ) Then
strFile = objFSO.BuildPath( myPath, Mid( myURL, InStrRev( myURL, "/" ) + 1 ) )
ElseIf objFSO.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
strFile = myPath
Else
WScript.Echo "ERROR: Target folder not found."
Exit Sub
End If
' Create or open the target file
Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
' Create an HTTP object
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
' Download the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
' Write the downloaded byte stream to the target file
For i = 1 To LenB( objHTTP.ResponseBody )
objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
Next
' Close the target file
objFile.Close( )
End Sub
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
X-HTTP
VBScript Code:
Download "http://www.robvanderwoude.com/files/hardwinv.zip", "C:\hardwinv.zip"
Sub Download( myFileURL, myDestFile )
' This function uses X-standards.com's X-HTTP component to download a file
'
' Arguments:
' myFileURL [string] the URL of the file to be downloaded
' myDestFile [string] the fully qualified path of the downloaded "target" file
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-HTTP component is available at:
' http://www.xstandard.com/page.asp?p=C8AACBA3-702F-4BF0-894A-B6679AA949E6
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=32ADACB9-6093-452A-9464-9269867AB16E
Dim objHTTP
Set objHTTP = CreateObject("XStandard.HTTP")
objHTTP.Get myFileURL
objHTTP.SaveResponseToFile myDestFile
Set objHTTP = Nothing
End Sub
Requirements:
Windows version:any
Network:any
Client software:X-HTTP component
Script Engine:any
Summarized:Works in any Windows version with the X-HTTP component installed.
Note:For large files, WinHTTP may prove far too slow.
Better use this MSXML2.XMLHTTP/ADODB based code by Wataru Uda instead.
FTP
ChilkatFTPChilkatFTP
VBScript Code:
Option Explicit
' Upload the file "test.txt" from the current (local) directory to
' "ftp.myServer.myTld/www/testdir/test.txt"; create the directory
' "testdir" if it doesn't exist; login as "myid" with password "secret".
WScript.Echo FTPUpload( "test.txt", "/www/testdir", _
"ftp.myServer.myTld", _
"myid", "secret", True )
Function FTPUpload( locFile, targetDir, host, user, password, blnMkDir )
' This function uses the free ChilkatFTP ActiveX component
' to upload a single file.
' The remote directory can be specified, but the remote
' file name will be the same as the local file name.
' The function is based on Chilkat's own sample for the ChilkatFTP2 component
' (which is not free): http://www.example-code.com/vbscript/ftpPutFile.asp
'
' Arguments:
' locFile [string] the (path and) file name of the file to be uploaded
' targetDir [string] the (relative) path of the remote target directory;
' if empty, the current remote directory will be used
' host [string] the remote host name (e.g. "ftp.mydomain.org")
' user [string] the login name for the remote host
' password [string] the password for the login account
' blnMkDir [boolean] if True, the remote directory will be created if it
' doesn't exist, otherwise the function will fail if
' the remote directory doesn't exist
'
' The ChilkatFTP ActiveX component can be downloaded from:
' http://www.chilkatsoft.com/download/FtpActiveX.msi
' Documentation can be found at:
' http://www.chilkatsoft.com/refdoc/xChilkatFtpRef.html
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objFSO, objFTP, ok, strRemFile
' Extract the local file name and extension only from its path
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
With objFSO
strRemFile = .BuildPath( targetDir, .GetFileName( locFile ) )
End With
Set objFSO = Nothing
' Create a ChilkatFTP object
Set objFTP = CreateObject( "ChilkatFTP.ChilkatFTP.1" )
' pass the connection properties to the object
objFTP.Username = user
objFTP.Password = password
objFTP.Hostname = host
' Connect, abort and return error message on failure
ok = objFTP.Connect( )
If ( ok <> 1 ) Then
FTPUpload = objFTP.LastErrorText
Set objFTP = Nothing
Exit Function
End If
If targetDir <> "" Then
' If specified, create target directory
If blnMkDir = True Then
objFTP.CreateRemoteDir targetDir
End If
' Change directory remotely, abort and return error message on failure
ok = objFTP.ChangeRemoteDir( targetDir )
If ( ok <> 1 ) Then
FTPUpload = objFTP.LastErrorText
objFTP.Disconnect()
Set objFTP = Nothing
Exit Function
End If
End If
' Upload the file, abort and return error message on failure
ok = objFTP.PutFile( locFile, strRemFile )
If ( ok <> 1 ) Then
FTPUpload = objFTP.LastErrorText
End If
' Disconnect,and release the object
objFTP.Disconnect( )
Set objFTP = Nothing
' Return result
FTPUpload = "Upload succeeded"
End Function
Requirements:
Windows version:any
Network:any
Client software:ChilkatFTP ActiveX component
Script Engine:any
Summarized:Works in any Windowsversion, requires ChilkatFTP ActiveX component.
Send e-Mail
CDOSYS
VBScript Code:
WScript.Echo EMail( "John Doe <john@home.now>", _
"Jane Doe <jane@work.now>", _
"Hi", _
"Miss you!" & vbCrLf & "Love, John", _
"", _
"", _
"smtp.home.now", _
25 )
Function EMail( myFrom, myTo, mySubject, myTextBody, myHTMLBody, myAttachment, mySMTPServer, mySMTPPort )
' This function sends an e-mail message using CDOSYS
'
' Arguments:
' myFrom = Sender's e-mail address ("John Doe <jdoe@mydomain.org>" or "jdoe@mydomain.org")
' myTo = Receiver's e-mail address ("John Doe <jdoe@mydomain.org>" or "jdoe@mydomain.org")
' mySubject = Message subject (optional)
' myTextBody = Actual message (text only, optional)
' myHTMLBody = Actual message (HTML, optional)
' myAttachment = Attachment as fully qualified file name, either string or array of strings (optional)
' mySMTPServer = SMTP server (IP address or host name)
' mySMTPPort = SMTP server port (optional, default 25)
'
' Returns:
' status message
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim i, objEmail
' Use custom error handling
On Error Resume Next
' Create an e-mail message object
Set objEmail = CreateObject( "CDO.Message" )
' Fill in the field values
With objEmail
.From = myFrom
.To = myTo
' Other options you might want to add:
' .Cc = ...
' .Bcc = ...
.Subject = mySubject
.TextBody = myTextBody
.HTMLBody = myHTMLBody
If IsArray( myAttachment ) Then
For i = 0 To UBound( myAttachment )
.AddAttachment Replace( myAttachment( i ), "\", "\\" ),"",""
Next
ElseIf myAttachment <> "" Then
.AddAttachment Replace( myAttachment, "\", "\\" ),"",""
End If
If mySMTPPort = "" Then
mySMTPPort = 25
End If
With .Configuration.Fields
.Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ) = 2
.Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ) = mySMTPServer
.Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ) = mySMTPPort
.Update
End With
' Send the message
.Send
End With
' Return status message
If Err Then
EMail = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear
Else
EMail = "Message sent ok"
End If
' Release the e-mail message object
Set objEmail = Nothing
' Restore default error handling
On Error Goto 0
End Function
Requirements:
Windows version:2000, XP, Server 2003, or Vista
Network:any
Client software:N/A
Script Engine:any
Summarized:Works in Windows 2000 or later.
Won't work in Windows 95, 98, ME, or NT 4.
Related links:Sending e-mail with CDOSYSE-mails generated by batch filesAutomate reading Outlook mail
Retrieve your WAN IP address
WinHTTPXMLHTTPInternet ExplorerSample usageWinHttp.WinHttpRequest.5.1
VBScript Code:
Function MyIP_WinHTTP( )
' Name: MyIP_WinHTTP
' Function: Display your WAN IP address using WinHTTP
' Usage: ret = MyIP_WinHTTP( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim lngStatus, objHTTP, objMatch, objRE, strText, strURL
' Return value in case the IP address could not be retrieved
MyIP_WinHTTP = "0.0.0.0"
' Retrieve the URL's text
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL
objHTTP.Send
' Check if the result was valid, and if so return the result
If objHTTP.Status = 200 Then MyIP_WinHTTP = objHTTP.ResponseText
Set objHTTP = Nothing
End Function
Requirements:
Windows version:Windows 2000 SP3 or later
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Microsoft.XMLHTTP
VBScript Code:
Function MyIP_XMLHTTP( )
' Name: MyIP_XMLHTTP
' Function: Display your WAN IP address using XMLHTTP
' Usage: ret = MyIP_XMLHTTP( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Original script written in JScript by Isaac Zelf
' "Translated" to VBScript by Rob van der Woude
' http://www.robvanderwoude.com
Dim objRequest, strURL
' Return value in case the IP address could not be retrieved
MyIP_XMLHTTP = "0.0.0.0"
' Retrieve the URL's text
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objRequest = CreateObject( "Microsoft.XMLHTTP" )
objRequest.open "GET", strURL, False
objRequest.send vbNull
If objRequest.status = 200 Then MyIP_XMLHTTP = objRequest.responseText
Set objRequest = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 5 or later
Script Engine:any
Summarized:Works in any Windows version with Internet Explorer 5 or later.
InternetExplorer.Application
VBScript Code:
Function MyIP_IE( )
' Name: MyIP_IE
' Function: Display your WAN IP address using Internet Explorer
' Usage: ret = MyIP_IE( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim blnTimedOut, i, objIE, objMatch, objRE, strText, strURL
' Return value if IP address couldn't be retrieved
MyIP_IE = "0.0.0.0"
' Open the appropriate URL in Internet Explorer
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Visible = False
objIE.Navigate2 strURL
' Wait till IE is ready
i = 0
blnTimedOut = False
Do While objIE.Busy
WScript.Sleep 100
i = i + 1
' Time out after 10 seconds
If i > 100 Then
blnTimedOut = True
Exit Do
End If
Loop
' Retrieve the URL's text
If Not blnTimedOut Then MyIP_IE = objIE.Document.Body.InnerText
' Close the Internet Explorer session
objIE.Quit
Set objIE = Nothing
End Function
Requirements:
Windows version:Windows 98 or later
Network:any
Client software:Internet Explorer
Script Engine:any
Summarized:Works in Windows 98 and later with Internet Explorer.
Sample usage
VBScript Code:
Option Explicit
Dim dtmStart, lngSeconds
WScript.Echo "Comparing 3 ways to retrieve your WAN IP address:" & vbCrLf
dtmStart = Now
WScript.Echo "InternetExplorer.Application " _
& MyIP_IE( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
dtmStart = Now
WScript.Echo "Microsoft.XMLHTTP " _
& MyIP_XMLHTTP( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
dtmStart = Now
WScript.Echo "WinHttp.WinHttpRequest.5.1 " _
& MyIP_WinHTTP( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
Sample output:
Comparing 3 ways to retrieve your WAN IP address:
InternetExplorer.Application 124.244.199.182 (2 seconds)
Microsoft.XMLHTTP 124.244.199.182 (1 seconds)
WinHttp.WinHttpRequest.5.1 124.244.199.182 (0 seconds)
Retrieve Geographical Information
GeoIP COM
(GeoIP database & COM wrapper
& System Scripting Runtime)
VBScript Code:
Function GeoIP( myHost )
' This function returns an array with the IP address, host name, city name,
' country name and country code for a specified IP address or host name.
'
' Argument:
' [string] IP address or host name
'
' Returns:
' [array of string] host name, IP address, city, country, country code
'
' Required software:
' MaxMind's GeoIP* database: http://www.maxmind.com/app/installation?city=1
' MaxMind's GeoIP COM wrapper: https://github.com/maxmind/geoip-api-mscom
' System Scripting Runtime: http://www.netal.com/ssr.htm
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objGeoIP, objDNS, objRE, strDNS, strHost, strIP
Set objDNS = CreateObject( "SScripting.IPNetwork" )
Set objGeoIP = CreateObject( "GeoIPCOMEx.GeoIPEx" )
Set objRE = New RegExp
' Resolve the specified host name or IP address
strDNS = objDNS.DNSLookup( myHost )
' Check if the argument is a host name or an IP address
objRE.Pattern = "ˆ[1-9][0-9]{0,2}(\.[0-9]{1,2}){3}$"
If objRE.Test( myHost ) Then
strIP = myHost
strHost = strDNS
Else
strIP = strDNS
strHost = myHost
End If
With objGeoIP
' Modify the path if you installed the GeoIP* database elsewhere
.set_db_path "C:\Program Files\GeoIP\"
.find_by_addr strIP
GeoIP = Array( strHost, strIP, .city, .country_name, .country_code )
End With
Set objDNS = Nothing
Set objGeoIP = Nothing
Set objRE = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:MaxMind's GeoIP* database and GeoIP COM wrapper, and Franz Krainer's System Scripting Runtime.
Script Engine:any
Summarized:Works in any Windows version.
Requires MaxMind's GeoIP* database and GeoIP COM wrapper, and Franz Krainer's System Scripting Runtime.
Sample Script
VBScript Code:
Option Explicit
WScript.Echo Join( GeoIP( "www.amazon.com" ), ", " )
WScript.Echo Join( GeoIP( "208.67.219.101" ), ", " )
Sample output:
www.amazon.com, 207.171.166.252, Seattle, United States, US
www.opendns.com, 208.67.219.101, San Francisco, United States, US
Use Google Calculator for unit conversion
Note:Unlike WinHTTP, X-HTTP and XMLHTTP, the InternetExplorer object retrieves the "interpreted" page instead of the page source code.
This makes it the best, if not the only way to retrieve Google Calculator output, which is a 100% JavaScript generated page.
InternetExplorer.Application
VBScript Code:
Function GoogleUnitConversion( myQuery )
' Name: GoogleUnitConversion
' Function: Convert units using Google Calculator and Internet Explorer
' Usage: WScript.Echo GoogleUnitConversion( "10+cm+in+inches" )
' Returns: 10 centimeters = 3.93700787 inches
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim blnTimedOut, i, j, objIE, objMatches, objRE, strAllText, strMatch, strPattern, strURL
' Open the appropriate URL in Internet Explorer
strURL = "//www.google.com/search?q=" & myQuery & "&pws=0&hl=en&num=1"
strPattern = "\)\s*" & Left( myQuery, InStr( myQuery, "+" ) -1 ) & "\s*[ˆ=]+\s*=\s*[\d\., ]+(\s+[a-z]+)*\s*" _
& Right( myQuery, Len( myQuery ) - InStrRev( myQuery, "+" ) )
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Visible = False
objIE.Navigate2 strURL
' Wait till IE is ready
i = 0
blnTimedOut = False
Do While objIE.Busy
WScript.Sleep 100
i = i + 1
' Time out after 10 seconds
If i > 100 Then
blnTimedOut = True
Exit Do
End If
Loop
' Retrieve the URL's text
If Not blnTimedOut Then strAllText = objIE.Document.Body.InnerText
' Close the Internet Explorer session
objIE.Quit
Set objIE = Nothing
' Use a regular expression to extract the result from the web page
Set objRE = New RegExp
objRE.Global = True
objRE.IgnoreCase = True
objRE.Pattern = strPattern
Set objMatches = objRE.Execute( strAllText )
j = objMatches.Count - 1
If j < 0 Then
strMatch = ""
Else
strMatch = Trim( Mid( objMatches.Item(j).Value, 2 ) )
End If
Set objMatches = Nothing
Set objRE = Nothing
GoogleUnitConversion = strMatch
End Function
Requirements:
Windows version:Windows 98 or later
Network:any
Client software:Internet Explorer
Script Engine:any
Summarized:Works in Windows 98 and later with Internet Explorer.
Sample usage
VBScript Code:
' Command line arguments assumed in this example: 10 cm in inches
WScript.Echo GoogleUnitConversion( MakeQuery( WScript.Arguments.UnNamed ) )
Function MakeQuery( ByRef objArgs )
Dim i, strQuery
If objArgs.Count <> 4 Then Syntax
If Not IsNumeric( objArgs(0) ) Then WScript.Quit 1
If UCase( objArgs(2) ) <> "IN" Then WScript.Quit 1
For i = 0 To objArgs.Count - 1
strQuery = strQuery & "+" & objArgs(i)
Next
MakeQuery = Mid( strQuery, 2 )
End Function
Sample output:
10 centimeters = 3.93700787 inches
Read the Latest Version Number from a Web Page
Get the latest Foxit Reader version with WinHTTPGet the latest VBSEdit version with WinHTTPGet the latest Revo Uninstaller version with WinHTTPWinHTTP (Foxit Reader)
VBScript Code:
WScript.Echo "Latest version of Foxit Reader: " & GetFoxitReaderVersion( )
Function GetFoxitReaderVersion( )
' This function returns the current Foxit Reader version
' as string by reading Foxit's version history page.
' If an error occurs, the returned version will be "0".
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objHTTP, objMatch, objRE, strHTML, strUserAgent, strVersion
' Initial return string, in case an error occurs
GetFoxitReaderVersion = "0"
' Use WinHTTP to read the text from Foxit's download page
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
'objHTTP.Open "GET", "http://www.foxitsoftware.com/pdf/reader_2/down_reader.htm", False
objHTTP.Open "GET", "http://www.foxitsoftware.com/Secure_PDF_Reader/version_history.php", False
strUserAgent = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.3) Gecko/2008092417 Firefox/3.0.3"
objHTTP.SetRequestHeader "UserAgent", strUserAgent
objHTTP.Send
If objHTTP.Status = 200 Then
' If the page was returned, use a regular expression
' to extract Foxit Reader's latest version number
strHTML = objHTTP.ResponseText
Set objRE = New RegExp
objRE.Pattern = "<h[ˆ>]+>Version History</h\d+>[\n\r\s]+<h[ˆ>]+>What's New in Foxit Reader (\d+\.\d+\.\d+)</h\d+>"
objRE.IgnoreCase = False
objRE.Global = False
Set objMatch = objRE.Execute( strHTML )
If objMatch.Count > 0 Then
strVersion = objMatch.Item(0).Submatches.Item(0)
End If
Set objMatch = Nothing
Set objRE = Nothing
End If
Set objHTTP = Nothing
' Return the result
GetFoxitReaderVersion = strVersion
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
WinHTTP (VBSEdit)
VBScript Code:
WScript.Echo "Latest version of VBSEdit: " & GetVBSEditVersion( )
Function GetVBSEditVersion( )
' This function returns the latest VBSEdit version
' as string by reading Adersoft's download page.
' If an error occurs, the returned version will be "0".
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objHTTP, objMatch, objRE, strHTML, strUserAgent, strVersion
' Initial return string, in case an error occurs
strVersion = "0"
' Use WinHTTP to read the text from Adersoft's download page
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", "http://www.vbsedit.com/", False
strUserAgent = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.3) Gecko/2008092417 Firefox/3.0.3"
objHTTP.SetRequestHeader "UserAgent", strUserAgent
objHTTP.Send
If objHTTP.Status = 200 Then
' If the page was returned, use a regular expression
' to extract Foxit Reader's current version number
strHTML = objHTTP.ResponseText
Set objRE = New RegExp
objRE.Pattern = "Version ([0-9]+(\.[0-9]+))"
objRE.IgnoreCase = False
objRE.Global = True
Set objMatch = objRE.Execute( strHTML )
If objMatch.Count > 0 Then
strVersion = objMatch.Item(0).Submatches.Item(0)
End If
Set objMatch = Nothing
Set objRE = Nothing
End If
Set objHTTP = Nothing
' Return the result
GetVBSEditVersion = strVersion
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
WinHTTP (Revo Uninstaller)
VBScript Code:
WScript.Echo "Latest version of Revo Uninstaller Freeware : " & GetRevoVersion( "Free" )
WScript.Echo "Latest version of Revo Uninstaller Pro : " & GetRevoVersion( "Pro" )
Function GetRevoVersion( myType )
' This function returns the latest Revo Uninstaller (Free/Pro)
' version as string by reading Revo's version history pages.
' If an error occurs, the returned version will be "0".
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objHTTP, objMatch, objRE, strHTML, strUserAgent, strVersion
' Initial return string, in case an error occurs
strVersion = "0"
' Use WinHTTP to read the text from Revo's download page
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
If UCase( myType ) = "PRO" Then
objHTTP.Open "GET", "http://www.revouninstaller.com/revo_uninstaller_pro_full_version_history.html", False
Else
objHTTP.Open "GET", "http://www.revouninstaller.com/revo_uninstaller_full_version_history.html", False
End If
strUserAgent = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.3) Gecko/2008092417 Firefox/3.0.3"
objHTTP.SetRequestHeader "UserAgent", strUserAgent
objHTTP.Send
If objHTTP.Status = 200 Then
' If the page was returned, use a regular expression
' to extract Foxit Reader's current version number
strHTML = objHTTP.ResponseText
Set objRE = New RegExp
If UCase( myType ) = "PRO" Then
objRE.Pattern = "Revo Uninstaller Pro version (\d+\.\d+(\.\d+)?)"
Else
objRE.Pattern = "Revo Uninstaller Freeware version (\d+\.\d+(\.\d+)?)"
End If
objRE.IgnoreCase = False
objRE.Global = False
Set objMatch = objRE.Execute( strHTML )
If objMatch.Count > 0 Then
strVersion = objMatch.Item(0).Submatches.Item(0)
End If
Set objMatch = Nothing
Set objRE = Nothing
End If
Set objHTTP = Nothing
' Return the result
GetRevoVersion = strVersion
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Query freedb.org
FREEDBControl.uFREEDB
VBScript Code:
Option Explicit
If WScript.Arguments.Count > 0 Then Syntax
Dim arrCDROMs, i, j, k, objFreeDB, strMsg
i = 0
Const CDDB_MODE_TEST = 0
Const CDDB_MODE_SUBMIT = 1
' Create a uFREEDB object
Set objFreeDB = CreateObject( "FREEDBControl.uFREEDB" )
With objFreeDB
' Mandatory properties, freedb.freedb.org does not seem to accept the defaults
.AppName = "QueryCD"
.AppVersion = "1.01"
.EmailAddress = "test@scripting.eu"
.CDDBServer = "freedb.freedb.org"
.CDDBMode = CDDB_MODE_TEST ' Use CDDB_MODE_SUBMIT only if you need to
' submit new or modified CD data to freedb.org
' Get an array with all CDROM drive letters
arrCDROMs = Split( .GetCdRoms, "|" )
' Loop through the array of CDROM drives
For j = 0 To UBound( arrCDROMs )
' Media Info "" means there is no CD in drive
If .GetMediaInfo( arrCDROMs(j) ) <> "" Then
' Count the number of CDs found
i = i + 1
' Query the freedb.org database for the CD, based on its TOC
.LookupMediaByToc .GetMediaTOC( arrCDROMs(j) )
' Return Album properties
strMsg = "The CD in drive " & UCase( arrCDROMs(j) ) _
& ": is """ & .GetAlbumName & """ by " _
& .GetArtistName & " (" & .GetAlbumYear & ", " _
& .GetAlbumGenre & ", " _
& .SecondsToTimeString( .GetAlbumLength ) & ")" & vbCrLf & vbCrLf
' Loop through the list of tracks
For k = 1 To .GetAlbumTracks
' Append track properties
strMsg = strMsg & "Track " & Right( " " & k, 2 ) & ": " _
& .GetTrackName( CInt(k) ) _
& " (" & .SecondsToTimeString( .GetTrackTime( CInt(k) ) ) & ")" _
& vbCrLf
Next
End If
Next
If i = 0 Then
strMsg = "No CD found."
End If
End With
' Display the result
WScript.Echo strMsg
' Release the object
Set objFreeDB = Nothing
Sub Syntax
strMsg = "QueryCD.vbs, Version 1.01" & vbCrLf _
& "Display album and track properties for all CDs in all CDROM drives" _
& vbCrLf & vbCrLf _
& "Usage: QUERYCD.VBS" & vbCrLf & vbCrLf _
& "Note: This script requires ufreedb.ocx" & vbCrLf _
& " by Jon F. Zahornacky and Peter Schmiedseder" & vbCrLf _
& " http://www.robvanderwoude.com/vbstech_multimedia_freedb.html" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com" & vbCrLf
WScript.Echo strMsg
WScript.Quit 1
End Sub
Sample output:
The CD in drive F: is "Colors of a New Dawn" by Gandalf (2004, New Age, 55:29)
Track 1: Rhythm of the Tides (6:18)
Track 2: Bridge of Confidence (5:30)
Track 3: In the Presence of Angels (4:55)
Track 4: Iris (8:59)
Track 5: From Distant Shores (6:19)
Track 6: In the Presence of Angels (reprise) (1:34)
Track 7: Hearts in Celestial Unison (5:03)
Track 8: Flowers Along the Way (3:01)
Track 9: Colors of a New Dawn (6:32)
Track 10: Brighter than a Star (7:12)
Requirements:
Windows version:any
Network:any
Client software:uFREEDB.ocx
Script Engine:all
Summarized:Works in all Windows versions, requires
uFREEDB.ocx.
Query WhoIs Database
InternetExplorer.Application (Function)InternetExplorer.Application (Class)InternetExplorer.Application (WSC)
InternetExplorer.Application (Function)
VBScript Code:
Option Explicit
WScript.Echo NetSolWhoIs( "google.com", 10 )
Function NetSolWhoIs( myDomain, myTimeOut )
' This function uses Network Solutions, Inc.'s WhoIs page to
' retrieve information for .com, .org, and .net (and other)
' domains.
' Note that this function will break as soon as Network
' Solution alters the layout of the WhoIs results page.
'
' Arguments:
' myDomain [string] domain name to be queried,
' e.g. "google.com"
' myTimeOut [integer] time-out in seconds
'
' Returns:
' Formatted WhoIs information (multi-line string)
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrLine, arrText, blnTimedOut, i, objIE
' Open the appropriate NetSol WhoIs URL in Internet Explorer
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Visible = False
objIE.Navigate2 "https://www.networksolutions.com/whois/" _
& "registry-data.jsp?domain=" & Trim( myDomain )
' Wait till IE is ready
i = 0
blnTimedOut = False
Do While objIE.Busy
WScript.Sleep 100
i = i + 1
' Time out after the specified number of seconds
If i > CInt( myTimeOut * 10 ) Then
blnTimedOut = True
Exit Do
End If
Loop
' Retrieve the URL's text and save it in an array
If Not blnTimedOut Then
arrText = Split( objIE.Document.Body.InnerText, vbLf )
End If
' Close the Internet Explorer session
objIE.Quit
Set objIE = Nothing
' Check if a time-out occurred, and return the result
If blnTimedOut Then
NetSolWhoIs = "-- timed out --"
Else
' Filter out the lines starting with 3 spaces
For i = 0 To UBound( arrText )
If Left( arrText(i), 3 ) = " " Then
arrLine = Split( arrText(i), ":" )
' Add the line to the function's return value
NetSolWhoIs = NetSolWhoIs _
& Left( Trim( arrLine(0) ) _
& String( 20, " " ), 20 ) _
& arrLine(1)
If UBound( arrLine ) = 2 Then
NetSolWhoIs = NetSolWhoIs _
& ":" & arrLine(2)
End If
NetSolWhoIs = NetSolWhoIs & vbCrLf
End If
Next
End If
End Function
Sample Output:
Domain Name GOOGLE.COM
Registrar MARKMONITOR, INC.
Whois Server whois.markmonitor.com
Referral URL http://www.markmonitor.com
Name Server NS1.GOOGLE.COM
Name Server NS2.GOOGLE.COM
Name Server NS3.GOOGLE.COM
Name Server NS4.GOOGLE.COM
Status clientDeleteProhibited
Status clientTransferProhibited
Status clientUpdateProhibited
Updated Date 10-apr-2006
Creation Date 15-sep-1997
Expiration Date 14-sep-2011
Requirements:
Windows version:any
Network:any (Internet connection)
Client software:Internet Explorer 4 or later
Script Engine:WSH
Summarized:Works in all Windows versions with Internet Explorer 4 or later, and an Internet connection.
Needs to be modified (replace WScript.Sleep) to work in HTAs.
Query Yahoo for Currency Exchange Rates
WinHTTP (Function)
WinHTTP (Class)
WinHTTP (Function)
VBScript Code:
Option Explicit
Dim dblAmount, strFromCurr, strToCurr
dblAmount = 1987.23
strFromCurr = "USD"
strToCurr = "EUR"
WScript.Echo YahooFX( dblAmount, strFromCurr, strToCurr )
dblAmount = 2001.17
strFromCurr = "USD"
strToCurr = "DKK"
WScript.Echo YahooFX( dblAmount, strFromCurr, strToCurr )
Function YahooFX( myAmount, myFromCur, myToCur )
Dim dblConvert, dblExch
If IsNumeric( myAmount ) Then
' Amount should be greater than zero
If myAmount <= 0 Then
YahooFX = "Error: " & myAmount & " is not a valid amount"
Exit Function
End If
Else
' Amount should at least be a number
YahooFX = "Error: " & myAmount & " is not a valid amount"
Exit Function
End If
' Retrieve the exchange rate for these currencies
dblConvert = YahooTrade( myFromCur, myToCur )
If dblConvert = 0 Then
YahooFX = "Error retrieving exchange rate"
Else
' Format the screen output
dblExch = FormatNumber( dblConvert * myAmount, 2, True, False, False )
YahooFX = myFromCur & " " & myAmount & " = " & myToCur & " " & dblExch
End If
End Function
Function YahooTrade( myFromCurr, myToCurr )
' This function retrieves the exchange rate
' for any two currencies from finance.yahoo.com
'
' Arguments:
' myFromCurr [string] ISO 4217 3 letter code for the currency to convert from
' myToCurr [string] ISO 4217 3 letter code for the currency to convert to
'
' Look up currency codes at http://www.oanda.com/site/help/iso_code.shtml
'
' Returns:
' Conversion rate as number
'
' Disclaimer:
' This script uses http://finance.yahoo.com to retrieve exchange rates.
' This script will break when Yahoo changes its web page layout or content.
' The author of this script cannot be held responsible for any damage, direct
' nor consequential, caused by the use of or inability to use this script.
' Do not make any financial decisions based on the output of this script.
' Always use a "second source" before making any decision.
' Use this script entirely at your own risk.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim colMatches, intLastSubMatch, objHTTP, objRE, strConversion
Dim strDecimal, strMyAmount, strResponse, strURL, strUserAgent
' Get the locally used decimal delimiter
strDecimal = Replace( FormatNumber( 0, 1, True ), "0", "" )
' Retrieve Yahoo's web page containing the our currencies' exchange rate
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
strURL = "//finance.yahoo.com/q?s=" & myFromCurr & myToCurr & "=X"
objHTTP.Open "GET", strURL, False
strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)"
objHTTP.SetRequestHeader "UserAgent", strUserAgent
objHTTP.Send
strResponse = objHTTP.ResponseText
Set objHTTP = Nothing
' Extract and return the exchange rate from
' the web page; in case of error return 0
Set objRE = New RegExp
objRE.Global = False
objRE.IgnoreCase = True
objRE.Pattern = ">Last Trade:(<[ˆ>]+>)+([.0-9]+)<[ˆ>]+>"
Set colMatches = objRE.Execute( strResponse )
If colMatches.Count = 1 Then
intLastSubMatch = colMatches.Item(0).Submatches.Count - 1
strConversion = colMatches.Item(0).Submatches( intLastSubMatch )
If IsNumeric( strConversion ) Then
' Convert the match from string to number,
' using the local decimal delimiter
strConversion = CDbl( Replace( strConversion, ".", strDecimal ) )
YahooTrade = strConversion
Else
YahooTrade = 0
End If
Else
YahooTrade = 0
End If
Set colMatches = Nothing
Set objRE = Nothing
End Function
Sample Output:
USD 1987,23 = EUR 1462,40
USD 2001,17 = DKK 10961,01
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
True Random Numbers
RndInt (Function using WinHTTP & Random.org)
RndIntArr (Function using WinHTTP & Random.org)
Random (Class using WinHTTP & Random.org)
Random.wsc (Windows Script Component using WinHTTP & Random.org)
RndInt (WinHTTP & Random.org)
VBScript Code:
Function RndInt( myMin, myMax )
' Retrieves a single TRUE random integer from http://www.random.org/
'
' Arguments:
' myMin [int] lowest possible value for the random integer
' myMax [int] highest possible value for the random integer
'
' Returns:
' [int] random integer within the specified range
' OR a [string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim intStatus, objHTTP, strAgent, strResult, strURL
If Not IsNumeric( myMin ) Then
RndInt = "Error (" & myMin & " is not a number)"
Exit Function
End If
If Not IsNumeric( myMax ) Then
RndInt = "Error (" & myMax & " is not a number)"
Exit Function
End If
If Not CInt( myMin ) = myMin Then
RndInt = "Error (" & myMin & " is not an integer)"
Exit Function
End If
If Not CInt( myMax ) = myMax Then
RndInt = "Error (" & myMax & " is not an integer)"
Exit Function
End If
strURL = "http://www.random.org/integers/?num=1" _
& "&min=" & myMin _
& "&max=" & myMax _
& "&col=1&base=10&format=plain&rnd=new"
strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL, False
objHTTP.SetRequestHeader "User-Agent", strAgent
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
On Error Goto 0
If intStatus = 200 Then
RndInt = strResult
Else
RndInt = "Error (Status " & intStatus & ")"
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
RndIntArr (WinHTTP & Random.org)
VBScript Code:
Function RndIntArr( myMin, myMax, myLength )
' Retrieves TRUE random integers from http://www.random.org/
'
' Arguments:
' myMin [int] lowest possible value for the random integer
' myMax [int] highest possible value for the random integer
' myLength [int] the number of random integers that should be retrieved
'
' Returns:
' [array of int] array with the requested number of random integers within
' the specified range OR an [array of string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
If Not IsNumeric( myMin ) Then
RndInt = "Error (" & myMin & " is not a number)"
Exit Function
End If
If Not IsNumeric( myMax ) Then
RndInt = "Error (" & myMax & " is not a number)"
Exit Function
End If
If Not IsNumeric( myLength ) Then
RndInt = "Error (" & myLength & " is not a number)"
Exit Function
End If
If Not CInt( myMin ) = myMin Then
RndInt = "Error (" & myMin & " is not an integer)"
Exit Function
End If
If Not CInt( myMax ) = myMax Then
RndInt = "Error (" & myMax & " is not an integer)"
Exit Function
End If
If Not Abs( CInt( myLength ) ) = myLength Then
RndInt = "Error (" & myLength & " is not an integer)"
Exit Function
End If
If myLength < 1 Then
RndInt = "Error (" & myLength & " is not a valid number of requests)"
Exit Function
End If
strURL = "http://www.random.org/integers/" _
& "?num=" & myLength _
& "&min=" & myMin _
& "&max=" & myMax _
& "&col=1&base=10&format=plain&rnd=new"
strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL, False
objHTTP.SetRequestHeader "User-Agent", strAgent
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
arrResult = Split( strResult )
ReDim Preserve arrResult( myLength - 1 )
On Error Goto 0
If intStatus = 200 Then
RndIntArr = arrResult
Else
RndIntArr = Array( "Error (Status " & intStatus & ")" )
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Sample Script
VBScript Code:
Option Explicit
Dim arrTest
' Cast 1 die with the RndInt function,
' which returns a single random integer
WScript.Echo RndInt( 1, 6 )
' Cast 2 dice with the RndIntArr function, which
' returns multiple random integers in an array
arrTest = RndIntArr( 1, 6, 2 )
WScript.Echo arrTest(0) & vbCrLf & arrTest(1)
Sample output:
3
2
1
Check Websites
WinHTTPX-HTTP
WinHTTP
VBScript Code:
Dim strWebsite
strWebsite = "www.robvanderwoude.com"
If PingSite( strWebsite ) Then
WScript.Echo "Web site " & strWebsite & " is up and running!"
Else
WScript.Echo "Web site " & strWebsite & " is down!!!"
End If
Function PingSite( myWebsite )
' This function checks if a website is running by sending an HTTP request.
' If the website is up, the function returns True, otherwise it returns False.
' Argument: myWebsite [string] in "www.domain.tld" format, without the
' "http://" prefix.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim intStatus, objHTTP
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", "http://" & myWebsite & "/", False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
On Error Resume Next
objHTTP.Send
intStatus = objHTTP.Status
On Error Goto 0
If intStatus = 200 Then
PingSite = True
Else
PingSite = False
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:2000 SP3, XP, Server 2003, or Vista
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
X-HTTP
VBScript Code:
Dim strWebsite
strWebsite = "www.robvanderwoude.com"
If IsWebsiteUp( strWebsite ) Then
WScript.Echo "Web site " & strWebsite & " is up and running!"
Else
WScript.Echo "Web site " & strWebsite & " is down!!!"
End If
Function IsWebsiteUp( myWebsite )
' This function checks if a website is running by sending an HTTP request.
' If the website is up, the function returns True, otherwise it returns False.
' Argument: myWebsite [string] in "www.domain.tld" format, without the
' "http://" prefix.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
' The X-HTTP component is available at:
' http://www.xstandard.com/page.asp?p=C8AACBA3-702F-4BF0-894A-B6679AA949E6
' For more information on available functionality read:
' http://www.xstandard.com/printer-friendly.asp?id=32ADACB9-6093-452A-9464-9269867AB16E
Dim objHTTP
Set objHTTP = CreateObject( "XStandard.HTTP" )
objHTTP.AddRequestHeader "User-Agent", _
"Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
objHTTP.Get "http://" & myWebsite
If objHTTP.ResponseCode = 200 Then
IsWebsiteUp = True
Else
IsWebsiteUp = False
End If
Set objHTTP = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:X-HTTP component
Script Engine:any
Summarized:Works in any Windows version with the X-HTTP component installed.
Check if a computer is a laptop
WMI (Win32_Battery)
VBScript Code:
If IsLaptop( "." ) Then
WScript.Echo "Laptop"
Else
WScript.Echo "Desktop or server"
End If
Function IsLaptop( myComputer )
' This Function checks if a computer has a battery pack.
' One can assume that a computer with a battery pack is a laptop.
'
' Argument:
' myComputer [string] name of the computer to check,
' or "." for the local computer
' Return value:
' True if a battery is detected, otherwise False
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
On Error Resume Next
Set objWMIService = GetObject( "winmgmts://" & myComputer & "/root/cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_Battery" )
IsLaptop = False
For Each objItem in colItems
IsLaptop = True
Next
If Err Then Err.Clear
On Error Goto 0
End Function
Requirements:
Windows version:2000, XP, Server 2003, or Vista (or NT 4 with WMI CORE 1.5)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:WMI CORE 1.5 for Windows NT 4
Script Engine:any
Summarized:Can work in Windows NT 4 or later, but WMI CORE 1.5 is required for Windows NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work in Windows 95, 98 or ME.
Generate MSInfo Reports
Msinfo32.MSInfo.1
VBScript Code:
Option Explicit
' Create a full MSInfo report of the local
' computer, and save it as C:\msinforeport.txt
MSInfo ".", "C:\msinforeport.txt", True
Sub MSInfo( myComputer, myReportFile, blnFullReport )
' This subroutine generates an MSInfo report for the specified
' computer, saving it under the specified file name.
'
' Arguments:
' myComputer [string] the computer to be queried, or a dot
' or empty string for the local computer
' myReportFile [string] the file name of the report to be generated
' blnFullReport [boolean] if True, a full report will be generated,
' otherwise only an OS summary is generated
'
' Returns:
' A full MSInfo report file for the specified computer
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objMSInfo, strCategory, varPctDone, wshShell
If myComputer = "" Or myComputer = "." Then
' Get the computer name of the local computer
Set wshShell = CreateObject( "WScript.Shell" )
myComputer = wshShell.ExpandEnvironmentStrings( "%ComputerName%" )
Set wshShell = Nothing
End If
If blnFullReport = True Then
strCategory = ""
Else
strCategory = 0
End If
' Query the computer and generate the report
Set objMSInfo = CreateObject( "Msinfo32.MSInfo.1" )
objMSInfo.UpdateDCOProgress( varPctDone )
objMSInfo.SaveFile myReportFile, myComputer, strCategory
Set objMSInfo = Nothing
End Sub
Requirements:
Windows version:not sure, tested in Windows XP SP2
Network:any
Client software:N/A
Script Engine:any
Summarized:Should work in Windows 2000 or later.
Uncertain if it will work in Windows 95, 98, ME or NT 4.
Basic Hardware Inventory
Version 9.02
Program descriptionKnown issuesChange logDownloadDonate
Use this HTA to get a basic hardware inventory of any WMI enabled computer on the network.
This HTA does not demand elevated privileges, though they are still recommended.
Unless you started the HTA with the optional /NOADMIN command line switch, the HTA will prompt you when running without elevated privileges.
Clicking ""Yes"" will restart the HTA with elevated privileges.
Interactive use:
Open the Basic Hardware Inventory tool by double clicking the file hardware.hta.
Fill in the name or IP address of a remote computer in the "Computer" field at the top of the screen.
Or you can use the "Paste" button at the left of this field to paste the computer name from the clipboard.
Or just leave the "Computer" field empty to use the default: the local computer.
If you only want a limited inventory, deselect the components you want to skip by deselecting the appropriate checkboxes at the left.
Or use the "Basic" button at the top (or its Alt+B/Alt+F keyboard shortcuts), to toggle between a basic (CPUs, memory and harddisks) and full inventory.
Click the "Go" button next to the "Computer" field (or use its Alt+G keyboard shortcut) to start the inventory.
This may take a couple of seconds or sometimes even minutes.
When the results are displayed, you can use the "Copy" button at the bottom to copy them to the clipboard, or the "Save" button to save them to a (tab delimited) text file, or the "Print" button (or using its Alt+P keyboard shortcut) to open a print preview of the results.
As of version 6.00, "fast printing" is available: just press Ctrl+P on the keyboard and select a printer.
"Save" by default writes the results to a file named "Hardware.computername.20240616024405.txt" in the HTA's parent folder.
To use a different path, use command line switch /SAVE (view the Help screen for details).
Exported results are in tab delimited format.
By clicking the "Settings" button (or using its Alt+S keyboard shortcut), the HTA's Settings screen will be opened.
Here you can set your preferred window size, whether you want to use DxDiag and/or DMIDecode, if available, to get more details, and you can play with the HTA's themes and custom color settings.
When saved, the settings are stored in a plain ASCII text file named "Hardware.cfg", located in the HTA's parent folder.
This configuration file may be edited with a text editor (e.g. Notepad), and should contain a single line with command line switches.
View the Help screen to list all available options.
Return to the main screen by clicking the "Cancel" button or pressing the "Esc" key.
Back in the main screen, use any of the "Details" buttons to display more details for the selected hardware category.
If the /DXDIAG command line switch was used (for the local computer only), besides WMI data, DxDiag data will be displayed too for CPU, memory, harddisks, CDROMs, video, sound, ports and BIOS.
Hover your mouse pointer over any field or button to display a short help text in a tooltip; after the inventory, the tooltip will show the new value of the field.
Click the "Reset" button at the top (or use its Alt+R keyboard shortcut) to clear the results before starting a new inventory.
For help on command line options, press F1 or click the "Help" button at the bottom.
To view the credits, click the "Credits" button at the bottom (or use its Alt+C keyboard shortcut) of the Main screen.
Command line:
Open the HTA's Help screen for details on the HTA's command line options and keyboard shortcuts.
Known Issues
Harddisk/CDROM interface:
SATA type disks may be listed as either SATA or ATA; as of version 7.00 this HTA uses the BusType property of the MSFT_PhysicalDisk class in WMI's root/Microsoft/Windows/Storage namespace to check the interface type; though much more reliable than Win32_DiskDrive's InterfaceType in WMI's root/CIMV2 namespace, it may still make mistakes.
SATA type disks may be listed incorrectly as SCSI when the disk is connected to a RAID enabled controller.
Floppy drive interface:
I have not yet found a way to link a specific floppy disk drive to a specific interface.
The HTA will count the number of floppy drives found, and the number of USB floppy drives. If these numbers are equal, it's easy: all floppy disk drives use a USB interface.
Likewise, if there are no USB floppy drives at all, it's easy again: all floppy drives must be using the internal floppy drive controller.
In case it's not easy, i.e. if none of the previously mentioned situations occur, the interface type will be marked "Unknown" for all floppy disk drives.
Floppy drive capacity:
To determine the floppy disk drives' capacities, the HTA uses their MediaType property in the Win32_LogicalDisk class.
This property value is known to be unreliable for "special" floppy disk formats, or if no disk is inserted.
Video resolution:
In case of multiple monitors with different screen resolutions, connected to a single video adapter, and configured as extended desktop, only one of the screen resolutions will be listed.
Rumour has it there are other (combinations of) conditions causing incorrect results too.
The solution (inspired by Gary Johnson) is to use DirectX instead of WMI.
Unfortunately, this is not only slow, but it is limited to the local computer only.
If the specified computer name does not match the local computer name, the /DXDIAG command line switch and all its dependent switches will be ignored.
Video RAM:
The amount of video RAM returned by WMI is limited to 4GB -1.
Besides, the amount returned by WMI as well as by DxDiag is usually incorrect for integrated controllers.
As a work-around, the HTA will try and read the amount of video RAM from the registry, which is the most reliable. This may require elevated privileges though.
Chrome for default browser:
If Google Chrome is the default browser, and its first window is opened with elevated privileges, no new Chrome tabs or windows can be opened without elevated privileges.
If, on the other hand, Chrome's first window was opened without elevated privileges, new tabs and windows can be opened with or without elevation.
To prevent problems in case this HTA is the first to open a Chrome window (through the Details buttons), as of Hardware.hta version 9.00, just before restarting the HTA with elevated privileges, a non-elevated minimized Chrome window is started if Chrome is the default browser and no Chrome window is opened yet.
WMI:
This HTA uses WMI to get information on all hardware installed.
WMI gets its hardware information from the hardware drivers.
Sometimes these drivers may provide incorrect information (e.g. SCSI instead of SATA for drives connected to a RAID enabled controller).
This is not a bug in Basic Hardware Inventory; any WMI based inventory will display the same incorrect results.
If WinSAT scores remain empty or zero in Windows 8.1 and later: open an elevated CMD prompt and run the command winsat.exe formal once (and again after major hardware changes) to build the WinSAT scores database for your computer.
Elevated privileges are required to access WMI's root/WMI namespace.
If you run this HTA without elevated privileges, you may miss some details, i.e. keyboard, mouse and monitors.
In WinPE or safe mode, not as much information is available as in a "full" Windows environment.
If the HTA cannot get specific hardware information (e.g. CDROM drives, monitors, sound and video cards) using WMI in WinPE or safe mode, it will try to get that information from the registry instead.
However, I did not (yet?) find a way to get as many details from the registry as WMI provides.
VersionRelease Date(yyyy-mm-dd)Changes
3.022013-12-17Improved update check.
Uses MSIEXEC.EXE's icon instead of the bland MSHTA.EXE icon.
3.012013-03-22Fixed a bug in the install date filter.
3.002013-03-21Software is now listed in sorted order.
Several subroutines were split up and reordered to make the GUI more responsive.
HTML and CSS were modified to make the HTA work with Internet Explorer 10.
2.102007-01-17Added automatic update check.
Added filtering for Vendor Name and Installed Date.
2.002006-01-09No change log was kept before this version.
Checksums:File name:MD5:SHA1:
software.zip253f5c9bee38cdb467c0e0a2e4a689bdc4bb2ae292e4d3b415b17e629ac7197c8e8aa0dd
Scripting titlescovering HTAs:
Scripting titlescovering WMI:
FREEDBControl.uFREEDB
VBScript Code:
Option Explicit
If WScript.Arguments.Count > 0 Then Syntax
Dim arrCDROMs, i, j, k, objFreeDB, strMsg
i = 0
Const CDDB_MODE_TEST = 0
Const CDDB_MODE_SUBMIT = 1
' Create a uFREEDB object
Set objFreeDB = CreateObject( "FREEDBControl.uFREEDB" )
With objFreeDB
' Mandatory properties, freedb.freedb.org does not seem to accept the defaults
.AppName = "QueryCD"
.AppVersion = "1.01"
.EmailAddress = "test@scripting.eu"
.CDDBServer = "freedb.freedb.org"
.CDDBMode = CDDB_MODE_TEST ' Use CDDB_MODE_SUBMIT only if you need to
' submit new or modified CD data to freedb.org
' Get an array with all CDROM drive letters
arrCDROMs = Split( .GetCdRoms, "|" )
' Loop through the array of CDROM drives
For j = 0 To UBound( arrCDROMs )
' Media Info "" means there is no CD in drive
If .GetMediaInfo( arrCDROMs(j) ) <> "" Then
' Count the number of CDs found
i = i + 1
' Query the freedb.org database for the CD, based on its TOC
.LookupMediaByToc .GetMediaTOC( arrCDROMs(j) )
' Return Album properties
strMsg = "The CD in drive " & UCase( arrCDROMs(j) ) _
& ": is """ & .GetAlbumName & """ by " _
& .GetArtistName & " (" & .GetAlbumYear & ", " _
& .GetAlbumGenre & ", " _
& .SecondsToTimeString( .GetAlbumLength ) & ")" & vbCrLf & vbCrLf
' Loop through the list of tracks
For k = 1 To .GetAlbumTracks
' Append track properties
strMsg = strMsg & "Track " & Right( " " & k, 2 ) & ": " _
& .GetTrackName( CInt(k) ) _
& " (" & .SecondsToTimeString( .GetTrackTime( CInt(k) ) ) & ")" _
& vbCrLf
Next
End If
Next
If i = 0 Then
strMsg = "No CD found."
End If
End With
' Display the result
WScript.Echo strMsg
' Release the object
Set objFreeDB = Nothing
Sub Syntax
strMsg = "QueryCD.vbs, Version 1.01" & vbCrLf _
& "Display album and track properties for all CDs in all CDROM drives" _
& vbCrLf & vbCrLf _
& "Usage: QUERYCD.VBS" & vbCrLf & vbCrLf _
& "Note: This script requires ufreedb.ocx" & vbCrLf _
& " by Jon F. Zahornacky and Peter Schmiedseder" & vbCrLf _
& " http://www.robvanderwoude.com/vbstech_multimedia_freedb.html" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com" & vbCrLf
WScript.Echo strMsg
WScript.Quit 1
End Sub
Sample output:
The CD in drive F: is "Colors of a New Dawn" by Gandalf (2004, New Age, 55:29)
Track 1: Rhythm of the Tides (6:18)
Track 2: Bridge of Confidence (5:30)
Track 3: In the Presence of Angels (4:55)
Track 4: Iris (8:59)
Track 5: From Distant Shores (6:19)
Track 6: In the Presence of Angels (reprise) (1:34)
Track 7: Hearts in Celestial Unison (5:03)
Track 8: Flowers Along the Way (3:01)
Track 9: Colors of a New Dawn (6:32)
Track 10: Brighter than a Star (7:12)
Requirements:
Windows version:any
Network:any
Client software:uFREEDB.ocx
Script Engine:all
Summarized:Works in all Windows versions, requires
uFREEDB.ocx.
Resolve Host Names
JavaWebstart
VBScript Code:
Set objJava = CreateObject( "JavaWebStart.isInstalled" )
strIP = objJava.dnsResolve( "www.google.com" )
WScript.Echo "IP address of www.google.com: " & strIP
Set objJava = Nothing
Requirements:
Windows version:any
Network:TCP/IP
Client software:Java runtime
Script Engine:any
Summarized:Works in any Windows version with Java runtime installed.
System Scripting Runtime
VBScript Code:
Set objIP = CreateObject( "SScripting.IPNetwork" )
strIP = objIP.DNSLookup( "www.google.com" )
WScript.Echo "IP address of www.google.com: " & strIP
Set objIP = Nothing
Requirements:
Windows version:any
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine.
Retrieve Your Computer's IP Address(es)
Win32_NetworkAdapterConfiguration
VBScript Code:
strQuery = "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE MACAddress > ''"
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
Set colItems = objWMIService.ExecQuery( strQuery, "WQL", 48 )
For Each objItem In colItems
If IsArray( objItem.IPAddress ) Then
If UBound( objItem.IPAddress ) = 0 Then
strIP = "IP Address: " & objItem.IPAddress(0)
Else
strIP = "IP Addresses: " & Join( objItem.IPAddress, "," )
End If
End If
Next
WScript.Echo strIP
Requirements:
Windows version:Windows 2000, XP, Server 2003, or Vista
Network:TCP/IP
Client software:N/A
Script Engine:any
Summarized:Works in Windows 2000, XP, Server 2003 and Vista.
Doesn't work in Windows 95, 98, ME or NT 4.
Ping Computers
Win32_PingStatus
VBScript Code:
WScript.Echo "www.robvanderwoude.com on-line: " & Ping( "www.robvanderwoude.com" )
Function Ping( myHostName )
' This function returns True if the specified host could be pinged.
' myHostName can be a computer name or IP address.
' The Win32_PingStatus class used in this function requires Windows XP or later.
' This function is based on the TestPing function in a sample script by Don Jones
' http://www.scriptinganswers.com/vault/computer%20management/default.asp#activedirectoryquickworkstationinventorytxt
' Standard housekeeping
Dim colPingResults, objPingResult, strQuery
' Define the WMI query
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & myHostName & "'"
' Run the WMI query
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery( strQuery )
' Translate the query results to either True or False
For Each objPingResult In colPingResults
If Not IsObject( objPingResult ) Then
Ping = False
ElseIf objPingResult.StatusCode = 0 Then
Ping = True
Else
Ping = False
End If
Next
Set colPingResults = Nothing
End Function
Requirements:
Windows version:XP, Server 2003, or Vista
Network:TCP/IP
Client software:N/A
Script Engine:any
Summarized:Works in Windows XP or later.
Doesn't work in Windows 95, 98, ME, NT 4 or 2000.System Scripting Runtime
VBScript Code:
WScript.Echo "www.robvanderwoude.com on-line: " & PingSSR( "www.robvanderwoude.com" )
Function PingSSR( myHostName )
' This function returns True if the specified host could be pinged.
' myHostName can be a computer name or IP address.
' This function requires the System Scripting Runtime by Franz Krainer
' http://www.netal.com/ssr.htm
' Standard housekeeping
Dim objIP
Set objIP = CreateObject( "SScripting.IPNetwork" )
If objIP.Ping( myHostName ) = 0 Then
PingSSR = True
Else
PingSSR = False
End If
Set objIP = Nothing
End Function
Requirements:
Windows version:Windows 98, ME, NT 4, 2000, XP, Server 2003 or Vista
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in Windows 98 and later with System Scripting Runtime is installed, with any script engine.
In this section I'll show you how to retrieve the user name using various scripting techniques.
Environment Variable
VBScript Code:
Set wshShell = CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
WScript.Echo "User Name: " & strUserName
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:WSH
Summarized:Works in Windows NT 4 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, 98 or ME, nor in Internet Explorer (HTAs).
WshNetwork
VBScript Code:
Set wshNetwork = CreateObject( "WScript.Network" )
strUserName = wshNetwork.UserName
WScript.Echo "User Name: " & strUserName
Requirements:
Windows version:Windows 98, ME, NT 4, 2000, XP, Server 2003, Vista
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Windows Script 5.6 for Windows 98, ME, and NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in Windows 98 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, nor in Internet Explorer (HTAs).
ADSI (WinNTSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strUserName = objSysInfo.UserName
WScript.Echo "User Name: " & strUserName
Requirements:
Windows version:2000, XP, Server 2003, or Vista (95, 98, ME, NT 4 with Active Directory client extension)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
ADSI (ADSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "ADSystemInfo" )
strUserName = objSysInfo.UserName
WScript.Echo "User Name: " & strUserName
Requirements:
Windows version:2000, XP, Server 2003, or Vista (95, 98, ME, NT 4 with Active Directory client extension)
Network:Only AD domain members
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:For AD domain members only.
Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4 SP4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work on stand-alones, workgroup members or members of NT domains.
WMI (Win32_ComputerSystem)
VBScript Code:
Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem" )
For Each objItem in colItems
strUserName = objItem.UserName
WScript.Echo "User Name: " & strUserName
Next
Requirements:
Windows version:ME, 2000, XP, Server 2003, or Vista (95, 98, NT 4 with
WMI CORE 1.5)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:WMI
CORE 1.5 for Windows 95, 98 or NT 4
Script Engine:any
Summarized:Can work on any Windows computer, but WMI CORE 1.5 is required for Windows 95, 98 or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
System Scripting Runtime
VBScript Code:
Set objSys = CreateObject( "SScripting.System" )
strUserName = objSys.UserName
WScript.Echo "User Name: " & strUserName
Requirements:
Windows version:any
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine.
Retrieving the Computer Name
In this section I'll show you how to retrieve a computer name using various scripting techniques.
Environment Variable
VBScript Code:
Set wshShell = CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
WScript.Echo "Computer Name: " & strComputerName
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:WSH
Summarized:Works in Windows NT 4 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, 98 or ME, nor in Internet Explorer (HTAs).
WshNetwork
VBScript Code:
Set wshNetwork = CreateObject( "WScript.Network" )
strComputerName = wshNetwork.ComputerName
WScript.Echo "Computer Name: " & strComputerName
Requirements:
Windows version:Windows 98, ME, NT 4, 2000, XP, Server 2003, Vista
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Windows Script 5.6 for Windows 98, ME, and NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in Windows 98 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, nor in Internet Explorer (HTAs).
SHGINA.DLL (Shell.LocalMachine)
VBScript Code:
Set objPC = CreateObject( "Shell.LocalMachine" )
strComputerName = objPC.MachineName
WScript.Echo "Computer Name: " & strComputerName
Requirements:
Windows version:XP (not sure about other Windows versions)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:any
Summarized:Works in Windows XP, may or may not work in Windows NT 4, 2000, Server 2003 and Vista.
Doesn't work in Windows 95, 98 or ME.
ADSI (WinNTSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strComputerName = objSysInfo.ComputerName
WScript.Echo "Computer Name: " & strComputerName
Requirements:
Windows version:2000, XP, Server 2003, or Vista (95, 98, ME, NT 4 with
Active
Directory client extension)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Active
Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
ADSI (ADSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "ADSystemInfo" )
strComputerName = objSysInfo.ComputerName
WScript.Echo "Computer Name: " & strComputerName
Requirements:
Windows version:2000, XP, Server 2003, or Vista (95, 98, ME, NT 4 with Active Directory client extension)
Network:Only AD domain members
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:For AD domain members only.
Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4 SP4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work on stand-alones, workgroup members or members of NT domains.
WMI (Win32_ComputerSystem)
VBScript Code:
Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem" )
For Each objItem in colItems
strComputerName = objItem.Name
WScript.Echo "Computer Name: " & strComputerName
Next
Requirements:
Windows version:ME, 2000, XP, Server 2003, or Vista (95, 98, NT 4 with WMI CORE 1.5)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:WMI CORE 1.5 for Windows 95, 98 or NT 4
Script Engine:any
Summarized:Can work on any Windows computer, but WMI CORE 1.5 is required for Windows 95, 98 or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
System Scripting Runtime
VBScript Code:
Set objLM = CreateObject( "SScripting.LMNetwork" )
strComputerName = objLM.ComputerName
WScript.Echo "Computer Name: " & ComputerName
Requirements:
Windows version:any
Network:NETBIOS
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine, except maybe Novell networks.
Retrieving the Host Name
Registry (WSH Shell)
VBScript Code:
Set wshShell = CreateObject( "WScript.Shell" )
strRegValue = "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Hostname"
strHostName = wshShell.RegRead( strRegValue )
WScript.Echo "Host Name: " & strHostName
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:TCP/IP
Client software:Windows Script 5.6 for Windows NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in Windows NT 4 or later, requires a TCP/IP network, works with CSCRIPT.EXE or WSCRIPT.EXE only.
Will require Windows Script 5.6 for Windows NT 4 to make it work in NT 4 (no longer available for download?).
Registry (WMI StdRegProv)
VBScript Code:
Const HKEY_LOCAL_MACHINE = &H80000002
strRegKey = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv" )
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey, "Hostname", strHostname
WScript.Echo "Host Name: " & strHostName
Requirements:
Windows version:ME, 2000, XP, Server 2003, or Vista (95, 98, NT 4 with WMI CORE 1.5)
Network:TCP/IP
Client software:WMI CORE 1.5 for Windows 95, 98 or NT 4
Script Engine:any
Summarized:Can work on any Windows computer, but
WMI CORE 1.5 is required for Windows 95, 98 or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
System Scripting Runtime
VBScript Code:
Set objIP = CreateObject( "SScripting.IPNetwork" )
strHostName = objIP.Hostname
WScript.Echo "Host Name: " & strHostName
Requirements:
Windows version:any
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine.
Retrieving the User Domain,Computer Domain or Work group Name
In this section I'll show you how to retrieve the (user or computer) domain or workgroup name using various scripting techniques.
Environment Variable
VBScript Code:
Set wshShell = CreateObject( "WScript.Shell" )
strUserDomain = wshShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, Vista or Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:WSH
Summarized:Works in Windows NT 4 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, 98 or ME, nor in Internet Explorer (HTAs).
WshNetwork
VBScript Code:
Set wshNetwork = CreateObject( "WScript.Network" )
strUserDomain = wshNetwork.UserDomain
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:Windows 98, ME, NT 4, 2000, XP, Server 2003, Vista, Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Windows Script 5.6 for Windows 98, ME, and NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in Windows 98 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, nor in Internet Explorer (HTAs).
ADSI (WinNTSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strUserDomain = objSysInfo.DomainName
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:2000, XP, Server 2003, Vista or Server 2008 (95, 98, ME, NT 4 with Active Directory client extension)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
ADSI (ADSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "ADSystemInfo" )
strUserDomain = objSysInfo.DomainName
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:2000, XP, Server 2003, Vista or Server 2008 (95, 98, ME, NT 4 with Active Directory client extension)
Network:Only AD domain members
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:For AD domain members only.
Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4 SP4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work on standalones, workgroup members or members of NT domains.
WMI (Win32_ComputerSystem)
VBScript Code:
Set objWMISvc = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem" )
For Each objItem in colItems
strComputerDomain = objItem.Domain
If objItem.PartOfDomain Then
WScript.Echo "Computer Domain: " & strComputerDomain
Else
WScript.Echo "Workgroup: " & strComputerDomain
End If
Next
Requirements:
Windows version:XP, Server 2003, Vista or Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:any
Summarized:Works in Windows XP and later.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
WMI (Win32_NTDomain)
VBScript Code:
Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_NTDomain" )
For Each objItem in colItems
strComputerDomain = objItem.DomainName
WScript.Echo "Computer Domain: " & strComputerDomain
Next
Requirements:
Windows version:XP, Server 2003, Vista or Server 2008
Network:NT domain, or AD
Client software:N/A
Script Engine:any
Summarized:Will work only on AD or NT domain members running Windows XP or later.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work in Windows 95, 98, ME, NT 4, or 2000.
Doesn't work on standalones or workgroup members.System Scripting Runtime
VBScript Code:
Set objIP = CreateObject( "SScripting.IPNetwork" )
strComputerDomain = objIP.Domain
WScript.Echo "Computer Domain: " & strComputerDomain
Requirements:
Windows version:any
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine.
Retrieving the User Domain,Computer Domain or Work group Name
In this section I'll show you how to retrieve the (user or computer) domain or workgroup name using various scripting techniques.
Environment Variable
VBScript Code:
Set wshShell = CreateObject( "WScript.Shell" )
strUserDomain = wshShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, Vista or Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:WSH
Summarized:Works in Windows NT 4 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, 98 or ME, nor in Internet Explorer (HTAs).
WshNetwork
VBScript Code:
Set wshNetwork = CreateObject( "WScript.Network" )
strUserDomain = wshNetwork.UserDomain
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:Windows 98, ME, NT 4, 2000, XP, Server 2003, Vista, Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Windows Script 5.6 for Windows 98, ME, and NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in Windows 98 or later, *.vbs with CSCRIPT.EXE or WSCRIPT.EXE only.
Doesn't work in Windows 95, nor in Internet Explorer (HTAs).
ADSI (WinNTSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strUserDomain = objSysInfo.DomainName
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:2000, XP, Server 2003, Vista or Server 2008 (95, 98, ME, NT 4 with Active Directory client extension)
Network:Stand-alone, workgroup, NT domain, or AD
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
ADSI (ADSystemInfo)
VBScript Code:
Set objSysInfo = CreateObject( "ADSystemInfo" )
strUserDomain = objSysInfo.DomainName
WScript.Echo "User Domain: " & strUserDomain
Requirements:
Windows version:2000, XP, Server 2003, Vista or Server 2008 (95, 98, ME, NT 4 with Active Directory client extension)
Network:Only AD domain members
Client software:Active Directory client extension for Windows 95, 98, ME or NT 4
Script Engine:any
Summarized:For AD domain members only.
Can work in any Windows version, but Active Directory client extension is required for Windows 95, 98, ME or NT 4 SP4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work on standalones, workgroup members or members of NT domains.
WMI (Win32_ComputerSystem)
VBScript Code:
Set objWMISvc = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem" )
For Each objItem in colItems
strComputerDomain = objItem.Domain
If objItem.PartOfDomain Then
WScript.Echo "Computer Domain: " & strComputerDomain
Else
WScript.Echo "Workgroup: " & strComputerDomain
End If
Next
Requirements:
Windows version:XP, Server 2003, Vista or Server 2008
Network:Stand-alone, workgroup, NT domain, or AD
Client software:N/A
Script Engine:any
Summarized:Works in Windows XP and later.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
WMI (Win32_NTDomain)
VBScript Code:
Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMIService.ExecQuery( "Select * from Win32_NTDomain" )
For Each objItem in colItems
strComputerDomain = objItem.DomainName
WScript.Echo "Computer Domain: " & strComputerDomain
Next
Requirements:
Windows version:XP, Server 2003, Vista or Server 2008
Network:NT domain, or AD
Client software:N/A
Script Engine:any
Summarized:Will work only on AD or NT domain members running Windows XP or later.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Doesn't work in Windows 95, 98, ME, NT 4, or 2000.
Doesn't work on standalones or workgroup members.System Scripting Runtime
VBScript Code:
Set objIP = CreateObject( "SScripting.IPNetwork" )
strComputerDomain = objIP.Domain
WScript.Echo "Computer Domain: " & strComputerDomain
Requirements:
Windows version:any
Network:TCP/IP
Client software:System Scripting Runtime
Script Engine:any
Summarized:Works in any Windows version with System Scripting Runtime is installed, with any script engine.
Login Scripts
Login scripts can be used for many purposes:
Connect & disconnectnetwork drivesConnect & disconnectnetwork printers, and set the default printerLog access to computersLog the status of computersUpdate user or computer settings
And I'm sure there's more...
Make sure you read these tips and best practices to prevent common mistakes
You are completely free to choose any scripting language for your login script... you may even use an executable as your login "script".
Keep in mind, however, that login scripts tend to be long-lived: they may survive multiple OS and hardware updates in your domain.
Batch commands are often broken in OS updates.
This makes batch files less suitable candidates for login script.
Besides, because of being long-lived, several "generations" of administrators may have to edit and maintain the login script's code, so both the scripting language and the script itself need to be well documented -- another reason not to choose for batch files as login scripts.
Many companies do use a batch file as their login script, but in most cases this batch file serves only as a "wrapper" to start he "real" login script, e.g. @KIX32.EXE login.kix or @CSCRIPT.EXE //NoLogo login.vbs or @REGINA.EXE login.rex or @PERL.EXE login.pl.
PowerShell may be a viable option to use for login scripts, but remember it isn't installed by default on Windows XP and older versions, and even if installed, its settings for running scripts needs to be properly configured (not the default settings).
Besides, some major "breaking" changes were introduced in PowerShell 6 (e.g. Get-WmiObject was replaced by Get-CimInstance), so you may need to check the PowerShell version on the computer running the script, and supply code for PowerShell 2..5 as well as for 6..7.
On this page, the main focus will be on login script snippets in KiXtart (version 4.60) and VBScript (WSH version 5.6 or 5.7), with only a limited number of (NT) batch and PowerShell snippets.
I will also assume that all workstations run Windows 2000 or a more recent Windows version.
For your convenience, you can hide or reveal the code snippets for any of these languages by using the buttons below.
Note:Many of the snippets can be used on older Windows versions too, but keep in mind that:
a.many variables won't have a value till after the logon process is finished; some will never have a value at all
b.WMI may not be installed by default in these Windows versions
c.an older version of Windows Script Host may be installed by default
d.NT batch files will not run correctly on Windows 9*/ME; if you do use an NT batch file as login script, use a .CMD extension instead of .BAT
e.A PowerShell script requires PowerShell to be installed, execution of PowerShell scripts to be allowed by the execution policy, and the script's code to be compatible with the PowerShell version installed.
1. Network Drives
Connect network drives
Batch: connect network drives
NET USE G: \\CompanyServer\Dept /PERSISTENT:No
IFERRORLEVEL 1 (ECHO Error mapping drive G:
)
NET USE H: \\CompanyServer\%UserName% /PERSISTENT:No
IFERRORLEVEL 1 (ECHO Error mapping drive H:
)
Set wshNetwork = CreateObject("WScript.Network")OnErrorResumeNextWith wshNetwork
.MapNetworkDrive"G:", "\\CompanyServer\Dept"If Err Then
WScript.Echo"Error " & Err & " mapping drive G:"
WScript.Echo"(" & Err.Description & ")"EndIf.MapNetworkDrive"H:", "\\CompanyServer\" & .UserNameIf Err Then
WScript.Echo"Error " & Err & " mapping drive H:"
WScript.Echo"(" & Err.Description & ")"EndIfEndWithOnErrorGoto0Set wshNetwork = Nothing
Instead of "annoying" the user with the details of mapping drives, consider logging error messages and the results to a log file on the local computer.
In case of errors, set a variable named Error and, at the end of the login script, display a message telling the user to contact the helpdesk.
KiXtart: connect drives with logging
; It doesn't hurt to make sure the C:\temp folder existsMD"C:\temp"; Redirect messages to a log file, display; a message dialog if redirection failsIfRedirectOutput("C:\temp\login.log", 1)<>0
$Msg = "Error logging the results.@CRLF"
$Msg = $Msg +"Please notify the helpdesk.@CRLF"
$Msg = $Msg +"For now, results will be displayed on screen."
$RC = MessageBox( $Msg, "Log File Error", 64, 300)EndIf
$Error = 0; Map drive G: to the department shareUSE G:"\\CompanyServer\Dept"If@ERROR<>0"Error @ERROR while trying to map drive G:@CRLF"
$Error = $Error +1EndIf; Map drive H: to the user's home shareUSE H:"\\CompanyServer\@HOMESHR"If@ERROR<>0"Error @ERROR while trying to map drive H: to the homedir@CRLF"
$Error = $Error +1EndIf; List all mappingsUSE List
; End redirection
$RC = RedirectOutput("); Warn the user if (an) error(s) occurredIf $Error >0
$Msg = "$Error error(s) occurred during login.@CRLF"
$Msg = $Msg +"The errors are logged to be "
$Msg = $Msg +"reviewed by the helpdesk staff.@CRLF"
$Msg = $Msg +"Please notify the helpdesk.@CRLF"
$RC = MessageBox( $Msg, "Login Error", 64)EndIf
PowerShell: connect drives with logging
# It doesn't hurt to make sure the C:\temp folder existsif(!(Test-Path-Path'C:\Temp'-PathType'Container')){New-Item-Path'C:\'-Name'Temp'-ItemType'directory'}# Delete an existing log file if necessaryif(Test-Path-Path'C:\Temp\login.log'-PathType'Any'){Remove-Item-LiteralPath'C:\Temp\login.log'-Force}# Start with a clean slate$Error.Clear()# Map drive G: to the department share
try {
New-SmbMapping -LocalPath 'G:'-RemotePath '\\CompanyServer\Dept'}
catch {"Error mapping drive G:`n$_"|Out-File-FilePath'C:\Temp\login.log'-Append}# Map drive H: to the user's home share
try {
New-SmbMapping -LocalPath 'H:'-RemotePath "\\CompanyServer\$Env:UserName"}
catch {"Error mapping drive H:`n$_"|Out-File-FilePath'C:\Temp\login.log'-Append}# List all mappings
Get-SmbMapping |Out-File-FilePath'C:\Temp\login.log'-Append# Warn the user if (an) error(s) occurredif($Error){$Msg = "Errors occurred during login.`n"$Msg+="The errors are logged to be reviewed by the helpdesk staff.`n"$Msg+="Please notify the helpdesk."[void][System.Windows.MessageBox]::Show($Msg,"Login Error","OK","Warning")$Host.SetShouldExit(-1)}
VBScript: connect drives with logging
Set wshNetwork = CreateObject("WScript.Network")Set objFSO = CreateObject("Scripting.FileSystemObject")' It doesn't hurt to make sure the C:\temp folder existsIfNot objFSO.FolderExists("C:\temp")ThenSet objTempFolder = objFSO.CreateFolder("C:\temp")Set objTempFolder = NothingEndIfOnErrorResumeNext' Open a log file, display a message dialog in case of errorSet objLogFile = objFSO.CreateTextFile("C:\temp\login.log", True, False)If Err Then
strMsg = "Error logging the results." & vbCrLf _
& "Please notify the helpdesk." & vbCrLf _
& "For now, results will be displayed on screen."
MsgBox strMsg, "Log File Error", 64EndIf
intError = 0With wshNetwork
' Map drive G: to the department share.MapNetworkDrive"G:", "\\CompanyServer\Dept"If Err Then
objLogFile.WriteLine"Error " & Err & " mapping drive G:"
objLogFile.WriteLine"(" & Err.Description & ")"
intError = intError +1EndIf' Map drive H: to the user's home share.MapNetworkDrive"H:", "\\CompanyServer\" & .UserNameIf Err Then
objLogFile.WriteLine"Error " & Err & " mapping drive H:"
objLogFile.WriteLine"(" & Err.Description & ")"
intError = intError +1EndIfEndWithOnErrorGoto0' List all drive mappingsWith wshNetwork.EnumNetworkDrivesFor i = 0To.Count-2Step2
objLogFile.WriteLine.Item(i) & " " & .Item(i+1)NextEndWith' Close the log file
objLogFile.CloseSet objLogFile = Nothing' Warn the user if (an) error(s) occurredIf intError >0Then
strMsg = intError & " error(s) occurred during login." & vbCrLf _
& "The errors are logged to be reviewed " _
& "by the helpdesk staff." & vbCrLf _
& "Please notify the helpdesk."
MsgBox strMsg, "Login Error", 64EndIfSet objFSO = NothingSet wshNetwork = Nothing
Often network drives are mapped based on group membership (or, for AD domains, on OU):
Batch: connect drives based on group membership
NET GROUP Marketing /DOMAIN | FINDSTR /R /I /B /C:"%UserName%$" >NULIFNOTERRORLEVEL 1 (
NET USE G: \\Server\Marketing /PERSISTENT:No
)
Note:Though this will usually work, it may fail if ampersands, carets, percent or dollar signs are used in group or user names.
Not recommended!
PowerShell: connect drives based on group membership
# Local group# Source: https://morgantechspace.com/2017/10/check-if-user-is-member-of-local-group-powershell.html$groupObj = [ADSI]"WinNT://./Administrators,group"$membersObj = @($groupObj.psbase.Invoke("Members"))$members = ($membersObj|ForEach-Object{$_.GetType().InvokeMember('Name','GetProperty',$null,$_,$null)})If($members-contains$Env:UserName ){
New-SmbMapping -LocalPath 'T:'-RemotePath "\\CompanyServer\AdminTools"}# AD group, use "Import-Module ActiveDirectory" once# Source: https://morgantechspace.com/2015/07/powershell-check-if-ad-user-is-member-of-group.html$members = Get-ADGroupMember -Identity 'Marketing'-Recursive |Select-ExpandProperty Name
If($members-contains$Env:UserName ){
New-SmbMapping -LocalPath 'M:'-RemotePath "\\CompanyServer\Marketing"}
VBScript: connect drives based on group membership
In VBScript this is a little more complicated, though hard-coding the domain name would simplify things:
strGroup = "Marketing"
blnMember = FalseSet objSysInfo = CreateObject("WinNTSystemInfo")
strUserName = objSysInfo.UserName
strDomain = objSysInfo.DomainNameSet objSysInfo = NothingSet objUser = GetObject("WinNT://" & strDomain & "/" & strUserName )Set colGroups = objUser.GroupsForEach objGroup in colGroups
IfLCase( objGroup.Name) = LCase( strGroup )Then
blnMember = TrueEndIfNextSet colGroups = Nothingset objUser = NothingIf blnMember ThenSet wshNetwork = CreateObject("WScript.Network")OnErrorResumeNextWith wshNetwork
.MapNetworkDrive"G:", "\\CompanyServer\Dept"If Err Then
WScript.Echo"Error " & Err & " mapping drive G:"
WScript.Echo"(" & Err.Description & ")"EndIf.MapNetworkDrive"H:", "\\CompanyServer\" & .UserNameIf Err Then
WScript.Echo"Error " & Err & " mapping drive H:"
WScript.Echo"(" & Err.Description & ")"EndIfEndWithOnErrorGoto0Set wshNetwork = NothingEndIf
The code shown is for NT as well as AD groups, and even for local groups on computers in a workgroup.
For AD domains, use ADSI.
Disconnect network drives
If users are allowed to map their own drives, you may want to consider disconnecting drives before mapping them:
Batch: reconnect drives
NET USE G: /DELETE /Y
NET USE G: \\CompanyServer\Dept /PERSISTENT:No
Set wshNetwork = CreateObject("WScript.Network")OnErrorResumeNext
wshnetwork.AddWindowsPrinterConnection"\\CompanyServer\LaserJet Marketing"If Err Then
WScript.Echo"Error " & Err.Number & " while trying to connect to LaserJet Marketing"
WScript.Echo"(" & Err.Description & ")"EndIfOnErrorGoto0Set wshNetwork = Nothing
VBScript: connect DOS style network printers
Set wshNetwork = CreateObject("WScript.Network")OnErrorResumeNext
wshNetwork.AddPrinterConnection"LPT1", "\\Server\HPLJ4", FalseIf Err Then
WScript.Echo"Error " & Err.Number & " while trying to connect to HPLJ4"
WScript.Echo"(" & Err.Description & ")"EndIfOnErrorGoto0Set wshNetwork = Nothing
Like network drives, printer connections will usually depend on OU or group membership.
The same techniques discussed for network drives apply for network printers too.
Disconnect network printers
Disconnecting network printers is much like disconnecting network drives:
If Not DelPrinterConnection("\\CompanyServer\LaserJet Marketing") = 0"Error @ERROR while trying to drop LaserJet Marketing@CRLF"EndIf
KiXtart: disconnect DOS style printers
USE LPT1:/DELETE
If@ERROR<>0"Error @ERROR while trying to drop LPT1@CRLF"EndIf
In PowerShell, removing printers should be straightforward, but tests on my own computer revealed that the commands for removal are not always reliable.
You may want to check afterwards if the printer is really removed.
$oldErrorActionPreference = $ErrorActionPreference$ErrorActionPreference = 'SilentlyContinue'# Remove the printer first, then remove the printerport
Get-Printer -Name'LaserJet Marketing'| Remove-Printer
Get-PrinterPort -Name'LPT1:'| Remove-PrinterPort
$ErrorActionPreference = $oldErrorActionPreference
VBScript: disconnect all printer types
Set wshNetwork = CreateObject("WScript.Network")OnErrorResumeNext
wshnetwork.RemovePrinterConnection"\\CompanyServer\LaserJet Marketing", True, FalseIf Err Then
WScript.Echo"Error " & Err.Number & " while trying to drop LaserJet Marketing"
WScript.Echo"(" & Err.Description & ")"EndIfOnErrorGoto0Set wshNetwork = Nothing
Set the default printer
Another useful function is SetDefaultPrinter( ) which, you may have guessed, sets the current user's default printer.
It is available in KiXtart, VBScript and in the Win32_Printer class in WMI.
In NT batch you can use WMIC to set the default printer.
This requires Windows XP Professional or later.
On older systems it could also be done by manipulating the registry, but that is not recommended.
You may also consider using prnmngr.vbs -t to set the default printer in a batch file.
prnmngr.vbs is located in Windows' System32 directory.
Batch: set default printer
WMIC Path Win32_Printer Where Name='HP LaserJet 4' Call SetDefaultPrinter
IFERRORLEVEL 1 (ECHO Failed to make 'HP LaserJet 4' the default printer
)
KiXtart: set default printer
IfSetDefaultPrinter("\\Server\HP LaserJet 4")<>0
Error @ERRORwhile trying to set the default printer to HP LaserJet 4@CRLF"
EndIf
PowerShell: set default printer
$Error.Clear()$OldProgressPreference = $ProgressPreference$ProgressPreference = "SilentlyContinue"# Cmdlet for WMI queries changed in PowerShell version 6# Use 'ShareName' instead of 'Name' for network printersif($PSVersionTable.PSVersion.Major -lt6){Get-WmiObject-Class Win32_Printer -Filter"Name='HP LaserJet 4'"|Invoke-WmiMethod-Name SetDefaultPrinter
}else{Get-CimInstance-ClassName Win32_Printer -Filter"Name='HP LaserJet 4'"|Invoke-CimMethod-Name'SetDefaultPrinter'}$ProgressPreference = $OldProgressPreferenceif($Error){Write-Host"Failed to make 'HP LaserJet 4' the default printer"Write-Host"Error: $_"}
VBScript: set default printer
Set wshNetwork = CreateObject("WScript.Network")OnErrorResumeNext
wshNetwork.SetDefaultPrinter"\\Server\HP LaserJet 4"If Err Then
WScript.Echo"Error " & Err.Number & " while trying to make HP LaserJet 4 the default printer"
WScript.Echo"(" & Err.Description & ")"EndIfOnErrorGoto0Set wshNetwork = Nothing
3. Log Computer Access
Though auditing is the preferred way to log access to computers, it does have one disadvantage: you can check on the computer who accessed it and when, but not the other way around.
So what do we do if we want to know which computers were accessed by a particular user?
To efficiently search this information, we need to store it in a central location, we don't want to access each computer's security event log separately.
And how are we going to collect this information?
Since the login script is forced to run each time a user logs in, it is perfectly suited to log each (interactive) access to any computer in the domain.
There are several options:
a single log file containing all login information of all users on all computers for every date
a log file per user
a log file per computer (less practical)
a log file per date
any combination of the options 2..4
Depending on the number of users (and logins) I would recommend using a log file per date, or per user per date.
The log files need to be stored in directories per date, on a server where all Authenticated Users have Write permissions.
The directory per date can be created by a scheduled task on the server, but it may be easier and safer to let login script check if it exists and create it if not.
So let's have a look at some code to create a log file per user per day.
In the following code, a log file with the user name is created/used, and the computer name, current date and current time are logged.
If you want to use a single "common" log file for all users per day, make sure you also log the current user name.
Batch: log computer access
:: Get current date in YYYYMMDD format if possible (XP Professional or later)FOR /F "skip=1 tokens=1-3" %%AIN('WMIC Path Win32_LocalTime Get Day^,Month^,Year /Format:Table')DO(SET /A Today = 10000 * %%C + 100 * %%B + %%A)IFERRORLEVEL 1 SET Today=
:: In case WMIC did not get the "sorted" date we'll have to get an "unsorted" date in regional date formatIF "%Today%"==" (REM Strip the leading day of the week from the dateFOR%%AIN(%Date%)DOSET Today=%%AREM Remove the date delimitersSET Today=%Today:/=%SET Today=%Today:-=%)
:: Create a directory for today if it does not existIFNOTEXIST \\Server\Logs\%Today%MD \\Server\Logs\%Today%:: Log the computer name and the date and time in a file with the user's name>> \\Server\Logs\%Today%\%UserName%.log ECHO%ComputerName%,%Date%,%Time%
Note:In a mixed environment (i.e. several Windows versions, including older ones), to make absolutely sure the directories created will be "sortable", either force the date format using a group policy, or use one of the SortDate scripts to get today's date in YYYYMMDD format.
KiXtart: log computer access
; Get the current date in YYYYMMDD format
$Today = "@YEAR"+Right("0@MONTHNO", 2)+Right("0@MDAYNO", 2); Create the directory if it doesn't existIfExist("\\Server\Logs\$Today\*.*") = 0MD"\\Server\Logs\$Today"EndIf; Log current computer accessIfRedirectOutput("\\Server\Logs\$Today\@USERID.log") = 0"@WKSTA,@DATE,@TIME@CRLF"
$RC = RedirectOutput(")EndIf
PowerShell: log computer access
# Get today's date in YYYYMMDD format and time in HHmmss format$Today = Get-Date-Format'yyyyMMdd'$Now = Get-Date-Format'HHmmss'# Create the directory if it doesn't existif(!(Test-Path"\\Server\Logs\$Today"-PathType Container )){New-Item-Path"\\Server\Logs"-Name$Today-ItemType"directory"}# Log current computer access"$Env:ComputerName,$Today,$Now\n"|Out-File-FilePath"\\Server\Logs\$Today\$Env:UserName.log"-Encoding ASCII
VBScript: log computer access
Const ForAppending = 8Const TristateFalse = 0' Get today's date in YYYYMMDD format and time in HHmmss format
strToday = CStr(10000*Year( Now )+100*Month( Now )+Day( Now ))
lngNow = 1000000+10000*Hour( Now )+100*Minute( Now )+Second( Now )
strNow = Right(CStr( lngNow ), 6)' Get the current user and computer namesSet wshNetwork = CreateObject("WScript.Network")
strUser = wshNetwork.UserName
strComputer = wshNetwork.ComputerNameSet wshNetwork = Nothing' Create the directory if it doesn't existSet objFSO = CreateObject("Scripting.FileSystemObject")With objFSO
strFolder = .BuildPath("\\Server\Logs", strToday )IfNot.FolderExists( strFolder )Then.CreateFolder strFolder
EndIf
strLog = .BuildPath( strFolder, strUser & ".log")Set objLog = .OpenTextFile( strLog, ForAppending, True, TristateFalse )
objLog.WriteLine strComputer & "," & strToday & "," & strNow
objLog.CloseSet objLog = NothingEndWithSet objFSO = Nothing
4. Log Computer Status
Besides the computer name, user name and time of login, you can choose from a long list of properties to add to the login log.
How about logging the IP and MAC addresses?
Log IP and MAC addresses
Batch: log IP and MAC address (single adapter)
FOR /F "tokens=1,2 delims=:" %%AIN('IPCONFIG /ALL ^| FIND "Address"')DO(FOR /F "tokens=1,2" %%CIN("%%~A")DO(FOR%%EIN(%%~B)DOSET%%C%%D=%%E))>> \\Server\Logs\%Today%\%UserName%.log ECHO.%IPAddress%,%PhysicalAddress:-=%
Notes:(1)Though this code snippet will usually work, it depends too much on the Windows language and version to be reliable.
Use only in an environment with identical Windows installations.
(2)The variable Today should be set before running the code displayed above.
(3)Instead of writing these properties to a separate line, it is recommended to combine all properties that need to be logged into a single line.
Batch: log IP and MAC addresses (single adapter, XP Pro SP2 or later)
SETLOCAL ENABLEDELAYEDEXPANSION
SET WMIPath=Path Win32_NetworkAdapter
SET WMIQuery=WHERE "AdapterType LIKE 'Ethernet%%' AND MACAddress > '' AND NOT PNPDeviceID LIKE 'ROOT\\%%'"
FOR /F "tokens=*" %%AIN('WMIC %WMIPath%%WMIQuery% Get MACAddress /Format:List ^| FIND "="')DOSET%%ASET WMIPath=Path Win32_NetworkAdapterConfiguration
SET WMIQuery=WHERE "MACAddress='%%MACAddress%%'"
FOR /F "tokens=*" %%AIN('WMIC %WMIPath%%WMIQuery% Get IPAddress /Format:List ^| FIND "="')DO(FOR /F "tokens=2 delims==" %%BIN("%%~A")DO(IFNOT "%%~B"==" (FOR /F "tokens=1 delims={}" %%CIN("%%~B")DO(SET IPAddress=!IPAddress!,%%~C
))))>> \\Server\Logs\%Today%\%UserName%.log ECHO.%IPAddress:~1%,%MACAddress::=%ENDLOCAL
Notes:(1)This code snippet requires Windows XP Professional SP2 or later.
(2)The variable Today should be set before running the code displayed above.
(3)Instead of writing these properties to a separate line, it is recommended to combine all properties that need to be logged into a single line.
KiXtart: log IP and MAC addresses
; Get the current date in YYYYMMDD format
$Today = "@YEAR"+Right("0@MONTHNO", 2)+Right("0@MDAYNO", 2); Create the directory if it doesn't existIfExist("\\Server\Logs\$Today\*.*") = 0MD"\\Server\Logs\$Today"EndIf; Read the first IP address
$IP = Join(Split( @IPAddress0, " "), "); Check if there are more, and join them all using semicolonsFor $i = 1 To 3
$RC = Execute("If @@IPAddress$i > '' $$IP = $$IP + Chr(59) + Join( Split( @@IPAddress$i, ' ' ), '' )")Next; Log the resultsIfRedirectOutput("\\Server\Logs\$Today\@USERID.log") = 0"$IP,@ADDRESS@CRLF"
$RC = RedirectOutput(")EndIf
Notes:(1)Instead of writing these properties to a separate line, it is recommended to combine all properties that need to be logged into a single line.
PowerShell: log IP and MAC addresses
$MACAddress = ( Get-NetAdapter |Where-Object-Property Status -eq Up |Select-Object-First1).MacAddress
$IPAddress = ( Get-NetIPAddress -AddressFamily IPv4 -InterfaceAlias Ethernet |Select-Object-First1).IPAddress
$Today = Get-Date-Format'yyyyMMdd'# Append IP and MAC adresses to log file"$IPAddress,$MACAddress\n"|Out-File-FilePath"\\Server\Logs\$Today\$Env:UserName.log"-Encoding ASCII -Append
VBScript: log IP and MAC addresses
' Query all network adapters that have a MAC address
strQuery = "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE MACAddress > ''"Set objWMIService = GetObject("winmgmts://./root/CIMV2")Set colItems = objWMIService.ExecQuery( strQuery, "WQL", 48)ForEach objItem In colItems
IfIsArray( objItem.IPAddress)Then
strIP = strIP & ";" & Join( objItem.IPAddress, ";")
strMAC = strMAC & ";" & Replace( objItem.MACAddress, ":", ")EndIfNextSet colItems = NothingSet objWMIService = Nothing' Log the resultSet objFSO = CreateObject("Scripting.FileSystemObject")Set objLog = objFSO.OpenTextFile( strLog, ForAppending, True, TristateFalse )
objLog.WriteLine Mid( strIP, 2) & "," & Mid( strMAC, 2)
objLog.CloseSet objLog = NothingSet objFSO = Nothing
Notes:(1)The variable strLog and the constant ForAppending need to be set before running the code snippet displayed above.
(2)Instead of writing these properties to a separate line, it is recommended to combine all properties that need to be logged into a single line.
Log AntiVirus status
Now let's get some more advanced status readings.
How about, for example, the status of the AntiVirus software installed?
Batch: log AntiVirus status (Windows XP SP2/SP3 only)
SET NameSpace=/Namespace:\\root\SecurityCenter
SET AVPath=Path AntiVirusProduct
SET AVProperties=displayName^^,onAccessScanningEnabled^^,productUptoDate^^,versionNumber
FOR /F "tokens=*" %%AIN('WMIC %NameSpace%%AVPath% Get %AVProperties% /Format:List ^| FIND "="')DO(>NULSET%%A)>> \\Server\Logs\%Today%\%UserName%.log ECHO.%displayName%,%versionNumber%,%onAccessScanningEnabled%,%productUptoDate%
Notes:(1)The first 3 lines, setting environment variables, are used to limit the length of the WMIC command line.
You are free to integrate them directly into the WMIC command.
If you do, replace each set of double carets by a single caret.
(2)The variable Today should be set before running the code displayed above.
(3)Instead of writing the AntiVirus status to a separate line, it is recommended to combine all properties that need to be logged into a single line.
(4)This WMIC command requires Windows XP Professional SP2 or SP3.
It will not work in Windows Vista and later.
Batch: log AntiVirus status (Windows 7 and later)
WMIC.EXE /Namespace:\\root\SecurityCenter2 Path AntiVirusProduct Get displayName,timestamp /Format:Table >> \\Server\Logs\%Today%\%UserName%.log
KiXtart: log AntiVirus status (Windows XP SP2/SP3 only)
; Get the current date in YYYYMMDD format
$Today = "@YEAR"+Right("0@MONTHNO", 2)+Right("0@MDAYNO", 2); Create the directory if it doesn't existIfExist("\\Server\Logs\$Today\*.*") = 0MD"\\Server\Logs\$Today"EndIf; Read the AV software status
$objWMISvc = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/SecurityCenter")
$colItems = $objWMISvc.ExecQuery("SELECT * FROM AntiVirusProduct", "WQL", 48)ForEach $objItem In $colItems
$Msg = $objItem.displayName+","+ $objItem.versionNumberIf $objItem.onAccessScanningEnabled = 0
$Msg = $Msg +",FALSE,"Else
$Msg = $Msg +",TRUE,"EndIfIf $objItem.productUptoDate = 0
$Msg = $Msg +"FALSE@CRLF"Else
$Msg = $Msg +"TRUE@CRLF"EndIfNext; Log the resultIfRedirectOutput("\\Server\Logs\$Today\@USERID.log") = 0
$Msg
$RC = RedirectOutput(")EndIf
Notes:(1)Instead of writing the AntiVirus status to a separate line, it is recommended to combine all properties that need to be logged into a single line.
(2)This WMIC command requires Windows XP Professional SP2 or SP3.
It will not work in Windows Vista and later.
KiXtart: log AntiVirus status (Windows 7 and later)
; Get the current date in YYYYMMDD format
$Today = "@YEAR"+Right("0@MONTHNO", 2)+Right("0@MDAYNO", 2); Create the directory if it doesn't existIfExist("\\Server\Logs\$Today\*.*") = 0MD"\\Server\Logs\$Today"EndIf; Read the AV software status
$objWMISvc = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/SecurityCenter2")
$colItems = $objWMISvc.ExecQuery("SELECT * FROM AntiVirusProduct", "WQL", 48)ForEach $objItem In $colItems
$Msg = $objItem.displayName+","+ $objItem.timestampNext; Log the resultIfRedirectOutput("\\Server\Logs\$Today\@USERID.log") = 0
$Msg
$RC = RedirectOutput(")EndIf
PowerShell: log AntiVirus status (Windows 7 and later)
$Today = Get-Date-Format'yyyyMMdd'# Append AV program name(s) and timestamp(s) to log file$AV1 = (Get-WmiObject-Class AntiVirusProduct -Namespace'root\SecurityCenter2')$AV2 = ($AV1|Format-Table-Property displayName,timestamp )$AV2|Out-File-FilePath"\\Server\Logs\$Today\$Env:UserName.log"-Encoding ASCII -Append# The 3 lines above may be joined into a single line
VBScript: log AntiVirus status (Windows XP SP2/SP3 only)
' Query the AV statusSet objWMISvc = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/SecurityCenter")Set colItems = objWMISvc.ExecQuery("SELECT * FROM AntiVirusProduct")ForEach objItem in colItems
With objItem
strMsg = .displayName & "," & .versionNumberIf.onAccessScanningEnabledThen
strMsg = strMsg & ",TRUE,"Else
strMsg = strMsg & ",FALSE,"EndIfIf.productUptoDateThen
strMsg = strMsg & "TRUE"Else
strMsg = strMsg & "FALSE"EndIfEndWithNextSet colItems = NothingSet objWMISvc = Nothing' Log the result; variable 'strLog' and constant 'ForAppending' need to be set beforeSet objFSO = CreateObject("Scripting.FileSystemObject")Set objLog = objFSO.OpenTextFile( strLog, ForAppending, True, TristateFalse )
objLog.WriteLine strMsg
objLog.CloseSet objLog = NothingSet objFSO = Nothing
Notes:(1)The variables objFSO and strLog and the constant ForAppending need to be set before running the code snippet displayed above.
(2)Instead of writing the AntiVirus status to a separate line, it is recommended to combine all properties that need to be logged into a single line.
(3)This WMIC command requires Windows XP Professional SP2 or SP3.
It will not work in Windows Vista and later.
VBScript: log AntiVirus status (Windows 7 and later)
' Query the AV statusSet objWMISvc = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/SecurityCenter2")Set colItems = objWMISvc.ExecQuery("SELECT * FROM AntiVirusProduct")ForEach objItem in colItems
strMsg = strMsg & objItem.displayName & "," & objItem.versionNumber & vbCrLf
NextSet colItems = NothingSet objWMISvc = Nothing' Log the result; variable 'strLog' and constant 'ForAppending' need to be set beforeSet objFSO = CreateObject("Scripting.FileSystemObject")Set objLog = objFSO.OpenTextFile( strLog, ForAppending, True, TristateFalse )
objLog.WriteLine strMsg
objLog.CloseSet objLog = NothingSet objFSO = Nothing
More Properties to Log
Besides the status of the AntiVirus software, there are more properties that can be useful to log, like the computer's last reboot, hardware properties like CPU type or amount of physical memory, local printers...
Well, you get the idea.
Browse the script samples on this site, or other sites, for more details.
Warning:Useful as this may be, you need to limit the number of logged properties, or the login process may take way too much time.
Hardware properties could be logged in separate files per computer and limited to one log per week, for example.
5. Update user or computer settings
Of course, when you can use login scripts to check settings, why not use it to correct or modify settings?
Many settings can be managed using group policies, but sometimes it may be easier to use an addition to the login script.
Make sure these modifications:
are required on this particular computer (avoid running them more than once, don't run on a server)
don't take too much time
can be accomplished with the user's credentials
don't require a reboot
6. Tips and best practices to prevent common mistakes
The most common mistake I've seen in login scripts is bloating: too many small additions that add up to a script that takes a quarter of an hour or even more to run.
How many hours of lost productivity every day are acceptable?
Some basic guidelines:
always remember: login scripts run with the user's credentials, and the user's profile!
don't use login scripts for jobs that can be done by Scheduled Tasks (you may want to check if the task is scheduled on this particular computer, though)
skip parts of the login script if possible: test if a condition is met, if so skip to the next section, if not connect, check, modify or log...
group as many actions as possible, so you don't need to check for group or OU membership or other conditions over and over again
if a lot of checking and logging is done, consider grouping these actions in a "once per day" section at the end of the script
avoid using login scripts as a poor man's software distribution mechanism (though it is perfectly acceptable to configure user settings, or to perform emergency security updates)
consider using a group policy to logoff all users during non-office hours, to make sure the login script runs at least once every working day
check if the login script is running on a desktop computer or a Citrix or Terminal Server (use dedicated login scripts for Terminal Server/Citrix)
on a server the login script should not be allowed to do anything, especially not map network drives or printers!
if the user is a (domain) administrator, the login script should not do anything, except maybe log the status (administrators shouldn't have a login script in the first place)
KiXtart: abort if user is Administrator
; Get the current date in YYYYMMDD format
$Today = "@YEAR"+Right("0@MONTHNO", 2)+Right("0@MDAYNO", 2); Create the directory if it doesn't existIfExist("\\Server\Logs\$Today\*.*") = 0MD"\\Server\Logs\$Today"EndIf; Log current computer accessIfRedirectOutput("\\Server\Logs\$Today\@USERID.log") = 0"@WKSTA,@USERID,@DATE,@TIME,@PRIV@CRLF"
$RC = RedirectOutput(")EndIf; Administrators should quit nowIf@PRIV = "ADMIN"Quit1EndIf
PowerShell: abort if user is Administrator
# 'S-1-5-32-544' is the SID of the local 'Administrators' group.# The groups 'Domain Admins' and 'Enterprise Admins' are members of the local# 'Administrators' group if the computer is connected to an AD domain.if([Security.Principal.WindowsIdentity]::GetCurrent().Groups -contains'S-1-5-32-544'){Write-Error"This login script must NOT be executed by members of the Administrators group."-ErrorAction Stop
}
PowerShell: abort on Terminal Server
# S-1-5-13 = Terminal Server Users# S-1-5-14 = Remote Interactive Logon# S-1-5-32-555 = Remote Desktop Users# See https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-dtyp/81d92bba-d22b-4a8c-908a-554ab29148ab for a list of well-known SIDsif([bool][Security.Principal.WindowsIdentity]::GetCurrent().Groups -match'S-1-5-13'-or'S-1-5-14'-or'1-5-32-555'){Write-Error"This login script must NOT be executed by Terminal Server or Remote Desktop users."-ErrorAction Stop
}
WinHTTPXMLHTTPInternet ExplorerSample usageWinHttp.WinHttpRequest.5.1
VBScript Code:
Function MyIP_WinHTTP( )
' Name: MyIP_WinHTTP
' Function: Display your WAN IP address using WinHTTP
' Usage: ret = MyIP_WinHTTP( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim lngStatus, objHTTP, objMatch, objRE, strText, strURL
' Return value in case the IP address could not be retrieved
MyIP_WinHTTP = "0.0.0.0"
' Retrieve the URL's text
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
objHTTP.Open "GET", strURL
objHTTP.Send
' Check if the result was valid, and if so return the result
If objHTTP.Status = 200 Then MyIP_WinHTTP = objHTTP.ResponseText
Set objHTTP = Nothing
End Function
Requirements:
Windows version:Windows 2000 SP3 or later
Network:any
Client software:Internet Explorer 5.01
Script Engine:any
Summarized:Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
Microsoft.XMLHTTP
VBScript Code:
Function MyIP_XMLHTTP( )
' Name: MyIP_XMLHTTP
' Function: Display your WAN IP address using XMLHTTP
' Usage: ret = MyIP_XMLHTTP( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Original script written in JScript by Isaac Zelf
' "Translated" to VBScript by Rob van der Woude
' http://www.robvanderwoude.com
Dim objRequest, strURL
' Return value in case the IP address could not be retrieved
MyIP_XMLHTTP = "0.0.0.0"
' Retrieve the URL's text
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objRequest = CreateObject( "Microsoft.XMLHTTP" )
objRequest.open "GET", strURL, False
objRequest.send vbNull
If objRequest.status = 200 Then MyIP_XMLHTTP = objRequest.responseText
Set objRequest = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 5 or later
Script Engine:any
Summarized:Works in any Windows version with Internet Explorer 5 or later.
InternetExplorer.Application
VBScript Code:
Function MyIP_IE( )
' Name: MyIP_IE
' Function: Display your WAN IP address using Internet Explorer
' Usage: ret = MyIP_IE( )
' Returns: WAN (or global) IP address
'
' This script uses WhatIsMyIP.com's automation page
' http://automation.whatismyip.com/n09230945.asp
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim blnTimedOut, i, objIE, objMatch, objRE, strText, strURL
' Return value if IP address couldn't be retrieved
MyIP_IE = "0.0.0.0"
' Open the appropriate URL in Internet Explorer
strURL = "http://automation.whatismyip.com/n09230945.asp"
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Visible = False
objIE.Navigate2 strURL
' Wait till IE is ready
i = 0
blnTimedOut = False
Do While objIE.Busy
WScript.Sleep 100
i = i + 1
' Time out after 10 seconds
If i > 100 Then
blnTimedOut = True
Exit Do
End If
Loop
' Retrieve the URL's text
If Not blnTimedOut Then MyIP_IE = objIE.Document.Body.InnerText
' Close the Internet Explorer session
objIE.Quit
Set objIE = Nothing
End Function
Requirements:
Windows version:Windows 98 or later
Network:any
Client software:Internet Explorer
Script Engine:any
Summarized:Works in Windows 98 and later with Internet Explorer.
Sample usage
VBScript Code:
Option Explicit
Dim dtmStart, lngSeconds
WScript.Echo "Comparing 3 ways to retrieve your WAN IP address:" & vbCrLf
dtmStart = Now
WScript.Echo "InternetExplorer.Application " _
& MyIP_IE( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
dtmStart = Now
WScript.Echo "Microsoft.XMLHTTP " _
& MyIP_XMLHTTP( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
dtmStart = Now
WScript.Echo "WinHttp.WinHttpRequest.5.1 " _
& MyIP_WinHTTP( ) & " (" _
& DateDiff( "s", dtmStart, Now ) & " seconds)"
Sample output:
Comparing 3 ways to retrieve your WAN IP address:
InternetExplorer.Application 124.244.199.182 (2 seconds)
Microsoft.XMLHTTP 124.244.199.182 (1 seconds)
WinHttp.WinHttpRequest.5.1 124.244.199.182 (0 seconds)
Retrieve Your Computer's MAC Address(es)
Win32_NetworkAdapter
VBScript Code:
intCount = 0
strMAC = "
' We're interested in MAC addresses of physical adapters only
strQuery = "SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID > ''"
Set objWMIService = GetObject( "winmgmts://./root/CIMV2" )
Set colItems = objWMIService.ExecQuery( strQuery, "WQL", 48 )
For Each objItem In colItems
If InStr( strMAC, objItem.MACAddress ) = 0 Then
strMAC = strMAC & "," & objItem.MACAddress
intCount = intCount + 1
End If
Next
' Remove leading comma
If intCount > 0 Then strMAC = Mid( strMAC, 2 )
Select Case intCount
Case 0
WScript.Echo "No MAC Addresses were found"
Case 1
WScript.Echo "MAC Address: " & strMAC
Case Else
WScript.Echo "MAC Addresses: " & strMAC
End Select
Requirements:
Windows version:Windows NT 4 SP4, 2000, XP, Server 2003, or Vista
Network:TCP/IP
Client software:WMI CORE 1.5 for Windows NT 4
Script Engine:any
Summarized:Works in Windows NT 4 SP4 (with WMI CORE 1.5), Windows 2000 or later.
Doesn't work in Windows 95, 98 or ME.
Wake-up On Lan (WOL)
UltraWOL by UltraJones Software
VBScript Code:
Dim objWOL
Set objWOL = CreateObject( "UltraWOL.ctlUltraWOL" )
objWOL.BroadcastAddr = "192.168.0.255"
' The MAC address of the computer to be woken
objWOL.MACAddr = "AA-BB-CC-DD-EE-FF"
' The local computer's IP address
objWOL.LocalIP = "192.168.0.4"
objWOL.WakeUp
Requirements:
Windows version:any
Network:TCP/IP
Client software:UltraWOL by UltraJones Software
Script Engine:any
Summarized:Should work in any Windows version, as long as UltraWOL is installed on the "calling" machine.
Requires WOL to be enabled on the "called" machine.
Related Stuff:
WolCmd
Wake On Lan command line tool
Wol
Wake On Lan command line tool
Wol
Wake On Lan GUI and command line tool
Wake-on-LAN Packet sniffer
Test and troubleshoot Wake On Lan
Prof Shutdown
Enterprise shutdown and wake-up management software
Editors, IDEs & Object Browsers
Though simple text editors have served me well both in building my web pages and writing my batch files, I have completely switched to dedicated editors/IDEs for writing VBScript and PowerShell scripts.
Syntax highlighting does help eliminate a lot of debugging time, but what I like even better is "IntelliSense" ™ and built-in debuggers and object browsers!
The picture at the right shows VBSEdit's Object Browser window after "instantiating" an Internet Explorer object with this one-liner:
Set objIE = CreateObject( "InternetExplorer.Application" )
It looks a lot like the Object Browser from Visual Studio (Express).
Object browsers don't replace the objects' documentation, but they make finding the right keywords a lot easier, and they can serve as a reminder for the exact syntax.
VBSEdit also comes with its own built-in debugger.
You'll find functionality like that in other editors/IDEs too.
PowerShell scripters should certainly try PowerShell Plus or PowerShell Analyzer.
But of course, instead of using a single integrated environment, you can choose to use separate a editor, debugger and object browser.
Just for fun, copy and paste the following code into your editor with integrated object browser (or IDE), and look what happens to the object browser window:
Automate Outlook
Clean up the Sent folder: delete messages older than a set number of days in the Sent folder
Clean up Outlook's Sent folder
VBScript Code:
' Delete messages over 14 days old from Outlook's "Sent Items" folder
' Note: You may want to insert a 60 seconds delay and then add shortcuts
' to this script and to Outlook in your Startup folder
' Script by Rob van der Woude
' http://www.robvanderwoude.com
Option Explicit
Dim intMax, intOld
Dim objFolder, objItem, objNamespace, objOutlook
Const SENT = 5 ' Sent Items folder
intMax = 14 ' Messages older than this will be deleted (#days)
intOld = 0 ' Counter for the number of deleted messages
Set objOutlook = CreateObject( "Outlook.Application" )
Set objNamespace = objOutlook.GetNamespace( "MAPI" )
' Open default account (will fail if Outlook is closed)
' and delete Sent messages over 2 weeks old
objNamespace.Logon "Default Outlook Profile", , False, False
Set objFolder = objNamespace.GetDefaultFolder( SENT )
For Each objItem In objFolder.Items
' Check the age of the message against the maximum allowed age
If DateDiff( "d", objItem.CreationTime, Now ) > intMax Then
intOld = intOld + 1
objItem.Delete
End If
Next
WScript.Echo "Deleted " & intOld & " messages over " & intMax & " days old"
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
Requirements:
Windows version:any
Network:any
Client software:Outlook
Script Engine:any
Summarized:Works in any Windows version, as long as Outlook (not Outlook Express) is installed.
Automate MS Word
SaveAs: convert MS Word documents to HTML
SaveAs: convert MS Word documents to PDF
SaveAs: convert MS Word documents to RTF
SaveAs: convert MS Word documents to XPS
CapsLock: use MS Word or WordPerfect to check the CapsLock status
SaveAs
Use MS Word to convert Word documents to HTML
VBScript Code:
Option Explicit
Doc2HTML "C:\Documents and Settings\MyUserID\My Documents\resume.doc"
Sub Doc2HTML( myFile )
' This subroutine opens a Word document,
' then saves it as HTML, and closes Word.
' If the HTML file exists, it is overwritten.
' If Word was already active, the subroutine
' will leave the other document(s) alone and
' close only its "own" document.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDoc, objFile, objFSO, objWord, strFile, strHTML
Const wdFormatDocument = 0
Const wdFormatDocument97 = 0
Const wdFormatDocumentDefault = 16
Const wdFormatDOSText = 4
Const wdFormatDOSTextLineBreaks = 5
Const wdFormatEncodedText = 7
Const wdFormatFilteredHTML = 10
Const wdFormatFlatXML = 19
Const wdFormatFlatXMLMacroEnabled = 20
Const wdFormatFlatXMLTemplate = 21
Const wdFormatFlatXMLTemplateMacroEnabled = 22
Const wdFormatHTML = 8
Const wdFormatPDF = 17
Const wdFormatRTF = 6
Const wdFormatTemplate = 1
Const wdFormatTemplate97 = 1
Const wdFormatText = 2
Const wdFormatTextLineBreaks = 3
Const wdFormatUnicodeText = 7
Const wdFormatWebArchive = 9
Const wdFormatXML = 11
Const wdFormatXMLDocument = 12
Const wdFormatXMLDocumentMacroEnabled = 13
Const wdFormatXMLTemplate = 14
Const wdFormatXMLTemplateMacroEnabled = 15
Const wdFormatXPS = 18
Const wdFormatOfficeDocumentTemplate = 23 (1)
Const wdFormatMediaWiki = 24(1) (2)
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a Word object
Set objWord = CreateObject( "Word.Application" )
With objWord
' True: make Word visible; False: invisible
.Visible = True
' Check if the Word document exists
If objFSO.FileExists( myFile ) Then
Set objFile = objFSO.GetFile( myFile )
strFile = objFile.Path
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close Word
.Quit
Exit Sub
End If
' Build the fully qualified HTML file name
strHTML = objFSO.BuildPath( objFile.ParentFolder, _
objFSO.GetBaseName( objFile ) & ".html" )
' Open the Word document
.Documents.Open strFile
' Make the opened file the active document
Set objDoc = .ActiveDocument
' Save as HTML
objDoc.SaveAs strHTML, wdFormatFilteredHTML
' Close the active document
objDoc.Close
' Close Word
.Quit
End With
End Sub
Requirements:
Windows version:any
Network:any
Client software:MS Word
Script Engine:any
Summarized:Works in any Windows version, as long as MS Word is installed.
SaveAs
Use MS Word to convert Word documents to PDF
VBScript Code:
Option Explicit
Doc2PDF "C:\Documents and Settings\MyUserID\My Documents\resume.doc"
Sub Doc2PDF( myFile )
' This subroutine opens a Word document, then saves it as PDF, and closes Word.
' If the PDF file exists, it is overwritten.
' If Word was already active, the subroutine will leave the other document(s)
' alone and close only its "own" document.
'
' Requirements:
' This script requires the "Microsoft Save as PDF or XPS Add-in for 2007
' Microsoft Office programs", available at:
' http://www.microsoft.com/downloads/details.aspx?
' familyid=4D951911-3E7E-4AE6-B059-A2E79ED87041&displaylang=en
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDoc, objFile, objFSO, objWord, strFile, strPDF
Const wdFormatDocument = 0
Const wdFormatDocument97 = 0
Const wdFormatDocumentDefault = 16
Const wdFormatDOSText = 4
Const wdFormatDOSTextLineBreaks = 5
Const wdFormatEncodedText = 7
Const wdFormatFilteredHTML = 10
Const wdFormatFlatXML = 19
Const wdFormatFlatXMLMacroEnabled = 20
Const wdFormatFlatXMLTemplate = 21
Const wdFormatFlatXMLTemplateMacroEnabled = 22
Const wdFormatHTML = 8
Const wdFormatPDF = 17
Const wdFormatRTF = 6
Const wdFormatTemplate = 1
Const wdFormatTemplate97 = 1
Const wdFormatText = 2
Const wdFormatTextLineBreaks = 3
Const wdFormatUnicodeText = 7
Const wdFormatWebArchive = 9
Const wdFormatXML = 11
Const wdFormatXMLDocument = 12
Const wdFormatXMLDocumentMacroEnabled = 13
Const wdFormatXMLTemplate = 14
Const wdFormatXMLTemplateMacroEnabled = 15
Const wdFormatXPS = 18
Const wdFormatOfficeDocumentTemplate = 23 (1)
Const wdFormatMediaWiki = 24 (1) (2)
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a Word object
Set objWord = CreateObject( "Word.Application" )
With objWord
' True: make Word visible; False: invisible
.Visible = True
' Check if the Word document exists
If objFSO.FileExists( myFile ) Then
Set objFile = objFSO.GetFile( myFile )
strFile = objFile.Path
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close Word
.Quit
Exit Sub
End If
' Build the fully qualified HTML file name
strPDF = objFSO.BuildPath( objFile.ParentFolder, _
objFSO.GetBaseName( objFile ) & ".pdf" )
' Open the Word document
.Documents.Open strFile
' Make the opened file the active document
Set objDoc = .ActiveDocument
' Save as HTML
objDoc.SaveAs strPDF, wdFormatPDF
' Close the active document
objDoc.Close
' Close Word
.Quit
End With
End Sub
Requirements:
Windows version:any
Network:any
Client software:MS Word 2007 and the Microsoft Save as PDF or XPS Add-in for 2007 Microsoft Office programs
Script Engine:any
Summarized:Works in any Windows version, as long as MS Word 2007 and the Microsoft Save as PDF or XPS Add-in for 2007 Microsoft Office programs are installed.
SaveAs
Use MS Word to convert Word documents to RTF
VBScript Code:
Option Explicit
Doc2RTF "C:\Documents and Settings\MyUserID\My Documents\resume.doc"
Sub Doc2RTF( myFile )
' This subroutine opens a Word document, then saves it as RTF, and closes Word.
' If the RTF file exists, it is overwritten.
' If Word was already active, the subroutine will leave the other document(s)
' alone and close only its "own" document.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDoc, objFile, objFSO, objWord, strFile, strRTF
Const wdFormatDocument = 0
Const wdFormatDocument97 = 0
Const wdFormatDocumentDefault = 16
Const wdFormatDOSText = 4
Const wdFormatDOSTextLineBreaks = 5
Const wdFormatEncodedText = 7
Const wdFormatFilteredHTML = 10
Const wdFormatFlatXML = 19
Const wdFormatFlatXMLMacroEnabled = 20
Const wdFormatFlatXMLTemplate = 21
Const wdFormatFlatXMLTemplateMacroEnabled = 22
Const wdFormatHTML = 8
Const wdFormatPDF = 17
Const wdFormatRTF = 6
Const wdFormatTemplate = 1
Const wdFormatTemplate97 = 1
Const wdFormatText = 2
Const wdFormatTextLineBreaks = 3
Const wdFormatUnicodeText = 7
Const wdFormatWebArchive = 9
Const wdFormatXML = 11
Const wdFormatXMLDocument = 12
Const wdFormatXMLDocumentMacroEnabled = 13
Const wdFormatXMLTemplate = 14
Const wdFormatXMLTemplateMacroEnabled = 15
Const wdFormatXPS = 18
Const wdFormatOfficeDocumentTemplate = 23 (1)
Const wdFormatMediaWiki = 24 (1) (2)
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a Word object
Set objWord = CreateObject( "Word.Application" )
With objWord
' True: make Word visible; False: invisible
.Visible = True
' Check if the Word document exists
If objFSO.FileExists( myFile ) Then
Set objFile = objFSO.GetFile( myFile )
strFile = objFile.Path
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close Word
.Quit
Exit Sub
End If
' Build the fully qualified HTML file name
strRTF = objFSO.BuildPath( objFile.ParentFolder, _
objFSO.GetBaseName( objFile ) & ".rtf" )
' Open the Word document
.Documents.Open strFile
' Make the opened file the active document
Set objDoc = .ActiveDocument
' Save as HTML
objDoc.SaveAs strRTF, wdFormatRTF
' Close the active document
objDoc.Close
' Close Word
.Quit
End With
End Sub
Requirements:
Windows version:any
Network:any
Client software:MS Word
Script Engine:any
Summarized:Works in any Windows version, as long as MS Word is installed.
SaveAs
Use MS Word to convert Word documents to XPS (XML PaperSpecification)
VBScript Code:
Option Explicit
Doc2XPS "C:\Documents and Settings\MyUserID\My Documents\resume.doc"
Sub Doc2XPS( myFile )
' This subroutine opens a Word document, then saves it as XPS, and closes Word.
' If the XPS file exists, it is overwritten.
' If Word was already active, the subroutine will leave the other document(s)
' alone and close only its "own" document.
'
' Requirements:
' This script requires the "Microsoft Save as PDF or XPS Add-in for 2007
' Microsoft Office programs", available at:
' http://www.microsoft.com/downloads/details.aspx?
' familyid=4D951911-3E7E-4AE6-B059-A2E79ED87041&displaylang=en
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDoc, objFile, objFSO, objWord, strFile, strXPS
Const wdFormatDocument = 0
Const wdFormatDocument97 = 0
Const wdFormatDocumentDefault = 16
Const wdFormatDOSText = 4
Const wdFormatDOSTextLineBreaks = 5
Const wdFormatEncodedText = 7
Const wdFormatFilteredHTML = 10
Const wdFormatFlatXML = 19
Const wdFormatFlatXMLMacroEnabled = 20
Const wdFormatFlatXMLTemplate = 21
Const wdFormatFlatXMLTemplateMacroEnabled = 22
Const wdFormatHTML = 8
Const wdFormatPDF = 17
Const wdFormatRTF = 6
Const wdFormatTemplate = 1
Const wdFormatTemplate97 = 1
Const wdFormatText = 2
Const wdFormatTextLineBreaks = 3
Const wdFormatUnicodeText = 7
Const wdFormatWebArchive = 9
Const wdFormatXML = 11
Const wdFormatXMLDocument = 12
Const wdFormatXMLDocumentMacroEnabled = 13
Const wdFormatXMLTemplate = 14
Const wdFormatXMLTemplateMacroEnabled = 15
Const wdFormatXPS = 18
Const wdFormatOfficeDocumentTemplate = 23 (1)
Const wdFormatMediaWiki = 24 (1) (2)
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a Word object
Set objWord = CreateObject( "Word.Application" )
With objWord
' True: make Word visible; False: invisible
.Visible = True
' Check if the Word document exists
If objFSO.FileExists( myFile ) Then
Set objFile = objFSO.GetFile( myFile )
strFile = objFile.Path
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close Word
.Quit
Exit Sub
End If
' Build the fully qualified XPS file name
strXPS = objFSO.BuildPath( objFile.ParentFolder, _
objFSO.GetBaseName( objFile ) & ".xps" )
' Open the Word document
.Documents.Open strFile
' Make the opened file the active document
Set objDoc = .ActiveDocument
' Save in XML Paper Specification (XPS) format
objDoc.SaveAs strXPS, wdFormatXPS
' Close the active document
objDoc.Close
' Close Word
.Quit
End With
End Sub
Requirements:
Windows version:any
Network:any
Client software:MS Word 2007 and the Microsoft Save as PDF or XPS Add-in for 2007 Microsoft Office programs
Script Engine:any
Summarized:Works in any Windows version, as long as MS Word 2007 and the Microsoft Save as PDF or XPS Add-in for 2007 Microsoft Office programs are installed.
This demo script can be downloaded here.
The downloadable version also contains other file filter constants.
Notes1:Constants found with "brute force" approach by Scott Ness
2:Requires Microsoft Office Word Add-in For MediaWiki
Use Microsoft Word or Corel WordPerfect to check the Caps Lock status
CapsLock
Use MS Word or Corel WordPerfect to check the CapsLock status
VBScript Code:
Option Explicit
Dim arrCaps, strMsg, strProc
Dim blnExitWord, blnExitWP
Dim colItems, objItem, objWMIService
strMsg = "
' Check for command line arguments (none required)
If WScript.Arguments.Count > 0 Then
Syntax
End If
' Check if MSWord and/or WordPerfect are already active by
' searching for processes named WINWORD.EXE or WPWIN**.EXE
blnExitWP = True
blnExitWord = True
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Process" )
For Each objItem In colItems
strProc = UCase( objItem.Name )
If Len( strProc ) > 11 Then Exit For
If Left( strProc, 5 ) = "WPWIN" And Right( strProc, 4 ) = ".EXE" Then
blnExitWP = False
End If
If strProc = "WINWORD.EXE" Then
blnExitWord = False
End If
Next
Set objWMIService = Nothing
' Start with WordPerfect only if it is
' active already, otherwise try MSWord first
If blnExitWord = False And blnExitWP = True Then
arrCaps = CapsLockWP( )
If arrCaps(1) Then
arrCaps = CapsLockWord( )
If arrCaps(1) Then
WScript.Echo strMsg & "Unable to read CapsLock status"
WScript.Quit
End If
End If
Else
arrCaps = CapsLockWord( )
If arrCaps(1) Then
arrCaps = CapsLockWP( )
If arrCaps(1) Then
WScript.Echo strMsg & "Unable to read CapsLock status"
WScript.Quit
End If
End If
End If
If arrCaps(0) Then
WScript.Echo strMsg & "CapsLock is ON"
Else
WScript.Echo strMsg & "CapsLock is OFF"
End If
Function CapsLockWord( )
Dim objWord, blnCapsLock, blnError
On Error Resume Next
Set objWord = CreateObject( "Word.Application" )
If Err Then
blnCapsLock = False
blnError = True
Else
blnCapsLock = CBool( objWord.CapsLock )
blnError = False
If blnExitWord Then
objWord.Quit
End If
End If
On Error Goto 0
CapsLockWord = Array( blnCapsLock, blnError )
End Function
Function CapsLockWP( )
Dim objWP, blnCapsLock, blnError
On Error Resume Next
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
If Err Then
blnCapsLock = False
blnError = True
Else
blnCapsLock = CBool( objWP.envKeyCapsLock )
blnError = False
If blnExitWP Then
objWP.ExitWordPerfect
End If
End If
On Error Goto 0
CapsLockWP = Array( blnCapsLock, blnError )
End Function
Sub Syntax( )
strMsg = "CapsLock.vbs, Version 1.01" _
& vbCrLf _
& "Display CapsLock status using MS Word or WordPerfect" _
& vbCrLf & vbCrLf _
& "Usage: CAPSLOCK.VBS" _
& vbCrLf & vbCrLf _
& "Note: This script will first check if WordPerfect is active." _
& vbCrLf _
& " If so, it will use WordPerfect to read the CapsLock status." _
& vbCrLf _
& " Otherwise it will try using MS Word, and if it fails try" _
& vbCrLf _
& " again using WordPerfect." _
& vbCrLf _
& " It won't close MS Word nor WordPerfect if they were active" _
& vbCrLf _
& " at the time the script was started." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com" _
& vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
End Sub
Requirements:
Windows version:any
Network:any
Client software:Microsoft Word (tested in Microsoft Office 2007 only) or Corel WordPerfect (tested in Corel WordPerfect Office 12 only)
Script Engine:any
Summarized:Works in any Windows version, as long as either Microsoft Word (2007) or Corel WordPerfect (12) is installed.
This demo script can be downloaded here.
Automate WordPerfect
PublishPDF: convert WP documents to PDF
SaveAs: convert WP documents to HTML
Type: type and format text
CapsLock: use MS Word or WordPerfect to check the CapsLock status
Corel WordPerfect Office Suites come with their own macro scripting language.
However, it is possible to use VBScript to automate WordPerfect through OLE.
The following code demonstrates some of WordPerfect's OLE automation capabilities.
PublishPDF
Use Corel WordPerfect to convert WP documents to PDF
VBScript Code:
Option Explicit
Dim blnExitWP, colItems, strMsg, strPDFDoc, strWPDoc
Dim objFSO, objItem, objWMIService, objWP
strMsg = ""
' Open a FileSystem Object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Parse the command line arguments
With WScript.Arguments
If .Named.Count > 0 Then Syntax
Select Case .Unnamed.Count
Case 1
strWPDoc = .Unnamed(0)
' No PDF file name specified, so we'll take the location and
' file name of the WordPerfect document and append a PDF extension
strPDFDoc = objFSO.BuildPath( objFSO.GetParentFolderName( strWPDoc ), _
objFSO.GetBaseName( strWPDoc ) & ".pdf" )
Case 2
strWPDoc = .Unnamed(0)
strPDFDoc = .Unnamed(1)
Case Else
Syntax
End Select
End With
' Check if the WordPerfect file exists
If Not objFSO.FileExists( strWPDoc ) Then
strMsg = "ERROR: File """ & strWPDoc & """ not found" & vbCrLf & vbCrLf
Syntax
End If
' Check if WordPerfect is already active by
' searching for a process named WPWIN**.EXE
blnExitWP = True
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Process" )
For Each objItem In colItems
If Left( UCase( objItem.Name ), 5 ) = "WPWIN" And _
Right( UCase( objItem.Name ), 4 ) = ".EXE" And _
Len( objItem.Name ) < 12 Then blnExitWP = False
Next
Set objWMIService = Nothing
' Create a new WP OLE Automation object
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
With objWP
' Open the specified document
.FileOpen( strWPDoc )
' Publish to PDF
.PdfDlg( strPDFDoc )
' Close the document
.Close
' Close WordPerfect unless it was already active
If blnExitWP Then .ExitWordPerfect
End With
' Release the objects
Set objFSO = Nothing
Set objWP = Nothing
Sub Syntax( )
strMsg = strMsg & vbCrLf _
& WScript.ScriptName & ", Version 1.00" & vbCrLf _
& "Convert a WordPerfect document to Adobe PDF" & vbCrLf & vbCrLf _
& "Usage: " & UCase( WScript.ScriptName ) _
& " wpdoc_filename [ pdf_filename ]" & vbCrLf & vbCrLf _
& "Where: ""wpdoc_filename"" is the WP file to be converted" _
& vbCrLf _
& " ""pdf_filename"" is the name for the PDF file" _
& vbCrLf _
& " " _
& "(default is name of WP file with .PDF extension)" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit(1)
End Sub
Requirements:
Windows version:any
Network:any
Client software:Corel WordPerfect
Script Engine:any
Summarized:Works in any Windows version, as long as Corel WordPerfect is installed.
Requires a WordPerfect version that has "Publish To", "PDF" menu entries (tested in Corel WordPerfect 12).
SaveAs
Use Corel WordPerfect to convert WP documents to HTML
VBScript Code:
WP2HTML "C:\Documents and Settings\MyUserID\My Documents\resume.wpd"
Sub WP2HTML( myFile )
' This subroutine opens a WordPerfect document,
' then saves it as HTML, and closes WordPerfect.
' If the HTML file exists, the subroutine will
' prompt for overwrite.
' If WordPerfect was already active, the subroutine
' will prompt the user to save the changes in other
' documents.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objFSO, objWP, objWPFile, strHTMLFile, strWPFile
Const WordPerfect_6_7_8_FileOpen_Format = 4
Const HTML_FileSave_ExportType = 226
Const No_FileSave_Overwrite = 0
Const Prompt_FileSave_Overwrite = 2
Const Yes_FileSave_Overwrite = 1
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a WordPerfect OLE Automation object
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
With objWP
' Check if the WordPerfect file exists
If objFSO.FileExists( myFile ) Then
Set objWPFile = objFSO.GetFile( myFile )
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close WordPerfect
.ExitWordPerfect
Exit Sub
End If
strWPFile = objWPFile.Path
strHTMLFile = objFSO.BuildPath( objWPFile.ParentFolder, _
objFSO.GetBaseName( objWPFile ) & ".html" )
' Maximize the window
.AppMaximize
' Open the document
On Error Resume Next
.FileOpen strWPFile, WordPerfect_6_7_8_FileOpen_Format
If Err Then
WScript.Echo "FILE OPEN ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
' Close WordPerfect
.ExitWordPerfect
Exit Sub
End If
' Save the document as HTML file
.FileSave strHTMLFile, HTML_FileSave_ExportType, Prompt_FileSave_Overwrite
If Err Then
WScript.Echo "FILE SAVE AS ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
End If
' Close WordPerfect
.ExitWordPerfect
If Err Then
WScript.Echo "PROGRAM CLOSE ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
End If
On Error Goto 0
End With
' Release the object
Set objWP = Nothing
End Sub
Requirements:
Windows version:any
Network:any
Client software:Corel WordPerfect
Script Engine:any
Summarized:Works in any Windows version, as long as Corel WordPerfect is installed.
Type
Write and format text
VBScript Code:
' This script opens WordPerfect, creates a new document,
' types some text and changes text attributes on selections.
'
' Tested with Corel WordPerfect 12 only.
'
' Based on the article "The Cutting Edge: Using OLE
' Automation to Control WordPerfect" by Gordon McComb
' gmccomb.com/vault/edge/ole.html
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Option Explicit
Dim objWP
' Create a new WP OLE Automation object
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
With objWP
' Maximize the window
.AppMaximize
' Open a new document; otherwise the
' currently active document is used!
.FileNew
' Set the new default font and size
.Font = "Times New Roman"
.FontSize = 200 ' 200 = 12pt
' Type some text, and center the line
.Center
.Type "This is normal text, 12pt Times New Roman, centered" & vbLf & vbLf
' Repeat, but select and format the text
.Center
.Type "This is Bold, Extra Large text, centered" & vbLf
.MoveUp
.SelectLineEnd
.MoveLeft
.FontExtraLargeToggle
.BoldKey
.SelectOff
.MoveRight
.Type vbLf
' Repeat, this time without centering
.Type "This is normal text, left aligned, 18pt Arial" & vbLf
.MoveUp
.SelectLineEnd
.MoveLeft
.FontSize = 300 ' 300 = 18pt
.Font = "Arial"
.SelectOff
.MoveRight
.Type vbLf
' Once more
.Type "This is 8pt Comic Sans MS, italics" & vbLf
.MoveUp
.SelectLineEnd
.MoveLeft
.Font = "Comic Sans MS"
.FontSize = 133 ' 133 = 8pt
.FontItalicToggle
.SelectOff
.MoveRight
' And again
.Type vbLf & "Normal text, underlined" & vbLf
.MoveUp
.SelectLineEnd
.MoveLeft
.FontUnderlineToggle
.SelectOff
.MoveRight
.Type vbLf
' Open the File Save As dialog and quit
.FileSaveAsDlg
.Quit
End With
' Release the object
Set objWP = Nothing
WScript.Echo "Done."
Requirements:
Windows version:any
Network:any
Client software:Corel WordPerfect
Script Engine:any (except of course the WScript.Echo command at the end)
Summarized:Works in any Windows version, as long as Corel WordPerfect is installed.
Note the use of vbLf instead of vbCrLf when typing text in WordPerfect.
vbCrLf would result in a space before each linefeed.
These typing demo scripts can be downloaded here.
The downloadable versions also contain other file filter constants.
Use Microsoft Word or Corel WordPerfect to check the Caps Lock status
CapsLock
Use MS Word or Corel WordPerfect to check the CapsLock status
VBScript Code:
Option Explicit
Dim arrCaps, strMsg, strProc
Dim blnExitWord, blnExitWP
Dim colItems, objItem, objWMIService
strMsg = "
' Check for command line arguments (none required)
If WScript.Arguments.Count > 0 Then
Syntax
End If
' Check if MSWord and/or WordPerfect are already active by
' searching for processes named WINWORD.EXE or WPWIN**.EXE
blnExitWP = True
blnExitWord = True
Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
Set colItems = objWMIService.ExecQuery( "SELECT * FROM Win32_Process" )
For Each objItem In colItems
strProc = UCase( objItem.Name )
If Len( strProc ) > 11 Then Exit For
If Left( strProc, 5 ) = "WPWIN" And Right( strProc, 4 ) = ".EXE" Then
blnExitWP = False
End If
If strProc = "WINWORD.EXE" Then
blnExitWord = False
End If
Next
Set objWMIService = Nothing
' Start with WordPerfect only if it is
' active already, otherwise try MSWord first
If blnExitWord = False And blnExitWP = True Then
arrCaps = CapsLockWP( )
If arrCaps(1) Then
arrCaps = CapsLockWord( )
If arrCaps(1) Then
WScript.Echo strMsg & "Unable to read CapsLock status"
WScript.Quit
End If
End If
Else
arrCaps = CapsLockWord( )
If arrCaps(1) Then
arrCaps = CapsLockWP( )
If arrCaps(1) Then
WScript.Echo strMsg & "Unable to read CapsLock status"
WScript.Quit
End If
End If
End If
If arrCaps(0) Then
WScript.Echo strMsg & "CapsLock is ON"
Else
WScript.Echo strMsg & "CapsLock is OFF"
End If
Function CapsLockWord( )
Dim objWord, blnCapsLock, blnError
On Error Resume Next
Set objWord = CreateObject( "Word.Application" )
If Err Then
blnCapsLock = False
blnError = True
Else
blnCapsLock = CBool( objWord.CapsLock )
blnError = False
If blnExitWord Then
objWord.Quit
End If
End If
On Error Goto 0
CapsLockWord = Array( blnCapsLock, blnError )
End Function
Function CapsLockWP( )
Dim objWP, blnCapsLock, blnError
On Error Resume Next
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
If Err Then
blnCapsLock = False
blnError = True
Else
blnCapsLock = CBool( objWP.envKeyCapsLock )
blnError = False
If blnExitWP Then
objWP.ExitWordPerfect
End If
End If
On Error Goto 0
CapsLockWP = Array( blnCapsLock, blnError )
End Function
Sub Syntax( )
strMsg = "CapsLock.vbs, Version 1.01" _
& vbCrLf _
& "Display CapsLock status using MS Word or WordPerfect" _
& vbCrLf & vbCrLf _
& "Usage: CAPSLOCK.VBS" _
& vbCrLf & vbCrLf _
& "Note: This script will first check if WordPerfect is active." _
& vbCrLf _
& " If so, it will use WordPerfect to read the CapsLock status." _
& vbCrLf _
& " Otherwise it will try using MS Word, and if it fails try" _
& vbCrLf _
& " again using WordPerfect." _
& vbCrLf _
& " It won't close MS Word nor WordPerfect if they were active" _
& vbCrLf _
& " at the time the script was started." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com" _
& vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
End Sub
Requirements:
Windows version:any
Network:any
Client software:Microsoft Word (tested in Microsoft Office 2007 only) or Corel WordPerfect (tested in Corel WordPerfect Office 12 only)
Script Engine:any
Summarized:Works in any Windows version, as long as either Microsoft Word (2007) or Corel WordPerfect (12) is installed.
This demo script can be downloaded here.
Automate Quattro Pro
QPro2Xls: convert Corel Quattro Pro spreadsheets to Excel
QPro2Xls
Use Quattro Pro to convert Quattro Pro spreadsheets to Excel
VBScript Code:
Option Explicit
Dim objFSO, objQPro
Dim strExcel, strQPro
With WScript.Arguments
If .Named.Exists("?") Then Syntax ""
If .Named.Count > 0 Then Syntax "Syntax error: invalid switches"
If .Unnamed.Count <> 1 Then Syntax "Syntax error: invalid number of arguments"
strQPro = .Unnamed(0)
End With
strExcel = Replace( strQPro, ".qpw", ".xls" )
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
With objFSO
If Not .FileExists( strQPro ) Then Syntax "Error: file not found"
If .FileExists( strExcel ) Then .DeleteFile strExcel, True
End With
Set objFSO = Nothing
Set objQPro = CreateObject( "QuattroPro.PerfectScript" )
If Err Then Syntax "Error: cannot open Quattro Pro"
With objQPro
On Error Resume Next
.FileOpen strQpro
If Err Then
Syntax "Error: cannot open file"
Else
.FileSaveAsExcel strExcel
.FileClose
If Err Then Syntax "Error: cannot save file"
End If
.Quit
On Error Goto 0
End With
Set objQPro = Nothing
Sub Syntax( myMsg )
Dim strMsg
If IsObject( objQPro ) Then objQPro.Quit
Set objFSO = Nothing
Set objQPro = Nothing
If myMsg <> "" Then strMsg = vbCrLf & myMsg & vbCrLf
strMsg = strMsg & vbCrLf _
& "QPro2Xls.vbs, Version 1.00" _
& vbCrLf _
& "Convert a Quattro Pro spreadsheet to Excel" _
& vbCrLf & vbCrLf _
& "Usage: [ CSCRIPT ] QPRO2XLS.VBS qpro_file" _
& vbCrLf & vbCrLf _
& "Where: ""qpro_file"" is the file name of the Quattro" _
& vbCrLf _
& " Pro spreadsheet to be converted" _
& vbCrLf & vbCrLf _
& "Notes: Quattro Pro must be installed to use this script." _
& vbCrLf _
& " The Excel ""target"" file will have the same name" _
& vbCrLf _
& " and will be located in the same directory as the" _
& vbCrLf _
& " Quattro Pro ""source"" file." _
& vbCrLf _
& " If the Excel ""target"" file exists, it will be" _
& vbCrLf _
& " overwritten without confirmation." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
Requirements:
Windows version:any
Network:any
Client software:Corel Quattro Pro
Script Engine:any (except of course the WScript.Echo command at the end)
Summarized:Works in any Windows version, as long as Corel Quattro Pro is installed.
Automate SnagIt screen captures
Automate SnagIt screen captures
VBScript Code:
Option Explicit
Dim objSnagit, strMsg, wshShell
' Check command line arguments (none required)
If WScript.Arguments.Count > 0 Then Syntax
' Capture input type
Const siiDesktop = 0
Const siiWindow = 1
Const siiRegion = 4
Const siiGraphicFile = 6
Const siiClipboard = 7
Const siiDOSScreen = 8
Const siiMenu = 9
Const siiObject = 10
Const siiProgramFile = 11
Const siiFreehand = 12
Const siiEllipse = 13
Const siiRoundedRect = 14
Const siiTriangle = 15
Const siiPolygon = 16
Const siiWallpaper = 17
Const siiCustomScroll = 18
Const siiTWAIN = 19
Const siiDirectX = 20
Const siiExtendedWindow = 23
' Window selection method
Const swsmInteractive = 0
Const swsmActive = 1
Const swsmHandle = 2
Const swsmPoint = 3
' Capture output type
Const sioPrinter = 1
Const sioFile = 2
Const sioClipboard = 4
Const sioMail = 8
Const sioFTP = 32
' Output image type
Const siftBMP = 0
Const siftPCX = 1
Const siftTIFF = 2
Const siftJPEG = 3
Const siftGIF = 4
Const siftPNG = 5
Const siftTGA = 6
' Output color depth
Const sicdAuto = 0
Const sicd1Bit = 1
Const sicd2Bit = 2
Const sicd3Bit = 3
Const sicd4Bit = 4
Const sicd5Bit = 5
Const sicd6Bit = 6
Const sicd7Bit = 7
Const sicd8Bit = 8
Const sicd16Bit = 16
Const sicd24Bit = 24
Const sicd32Bit = 32
' Output file naming method
Const sofnmPrompt = 0
Const sofnmFixed = 1
Const sofnmAuto = 2
' Create the required objects
Set objSnagit = CreateObject( "SNAGIT.ImageCapture.1" )
Set wshShell = CreateObject( "WScript.Shell" )
' Set input options
objSnagit.Input = siiDesktop
objSnagit.IncludeCursor = True
' Set output options
objSnagit.Output = sioFile
objSnagit.OutputImageFile.FileType = siftPNG
objSnagit.OutputImageFile.ColorDepth = sicd32Bit
objSnagit.OutputImageFile.FileNamingMethod = sofnmFixed
objSnagit.OutputImageFile.Filename = "snagtest"
objSnagit.OutputImageFile.Directory = "C:\"
' Capture
objSnagit.Capture
' Launch the captured image in the default viewer
wshShell.Run "C:\snagtest.png", 0, False
' Release the objects
Set objSnagit = Nothing
Set wshShell = Nothing
Sub Syntax
strMsg = vbCrLf _
& WScript.ScriptName & ", Version 1.01" _
& vbCrLf _
& "Automate a SnagIt full screen capture" _
& vbCrLf & vbCrLf _
& "Usage: " & UCase( WScript.ScriptName ) _
& vbCrLf & vbCrLf _
& "Notes: [1] The resulting screenshot is saved as C:\snagtest.png." _
& vbCrLf _
& " An existing file will be overwritten." _
& vbCrLf _
& " [2] This script requires SnagIt to be installed on the local computer." _
& vbCrLf _
& " SnagIt is commercial screen capture software by TechSmith." _
& vbCrLf _
& " A 30-day trial version is available for download:" _
& vbCrLf _
& " http://www.techsmith.com/screen-capture.asp" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
Requirements:
Windows version:any
Network:any
Client software:SnagIt (tested with versions 7.2.5 and 8.2.3)
Script Engine:any
Summarized:Works in any Windows version, as long as SnagIt is installed.
This demo script can be downloaded here.
Print Files
Shell.Application
VBScript Code:
' Check the command line arguments
If WScript.Arguments.Unnamed.Count <> 1 Then Syntax
If WScript.Arguments.Named.Count > 0 Then Syntax
' Check if a valid file was specified
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
strFile = WScript.Arguments(0)
If Not objFSO.FileExists( strFile ) Then Syntax
strFolder = objFSO.GetParentFolderName( strFile )
Set objFSO = Nothing
' Open the Shell Folders object
Set objShell = CreateObject( "Shell.Application" )
' Create an object for the specified file's parent folder
Set objFolder = objShell.Namespace( strFolder )
' Create a collection for the folder's contents
Set colFiles = objFolder.Items
' Loop through the collection to find the file specified
If colFiles.Count > 0 Then
For Each objFile In colFiles
If LCase( objFile.Path ) = LCase( strFile ) Then
' Print the file with its associated print command
objFile.InvokeVerbEx( "Print" )
End If
Next
End If
Sub Syntax
Dim strMsg
strMsg = "Print.vbs, Version 1.00" _
& vbCrLf _
& "Print a file - ANY file - on the default printer" _
& vbCrLf & vbCrLf _
& "Usage: " & UCase( WScript.ScriptName ) & " filename" _
& vbCrLf & vbCrLf _
& "Where: "filename" specifies the file to be printed (no wildcards)" _
& vbCrLf & vbCrLf _
& "Notes: This script will only work if a print command for the" _
& vbCrLf _
& " file's associated file type is defined in the registry." _
& vbCrLf _
& " When the associated program is used to open and print" _
& vbCrLf _
& " the file, the program will not be closed automatically." _
& vbCrLf _
& " This script may conflict with my DefOpen.bat script." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
Requirements:
Windows version:any
Network:N/A
Client software:Internet Explorer 4 for Windows 95/98/NT 4
Script Engine:any
Summarized:Should work in Windows 98 SE or later, or with Internet Explore 4 or later.
Kill a Process
Kill a Process By Name
Win32_Process
VBScript Code:
KillProc "outlook.exe"
Sub KillProc( myProcess )
'Authors: Denis St-Pierre and Rob van der Woude
'Purpose: Kills a process and waits until it is truly dead
Dim blnRunning, colProcesses, objProcess
blnRunning = False
Set colProcesses = GetObject( _
"winmgmts:{impersonationLevel=impersonate}" _
).ExecQuery( "Select * From Win32_Process" )
For Each objProcess in colProcesses
If LCase( myProcess ) = LCase( objProcess.Name ) Then
' Confirm that the process was actually running
blnRunning = True
' Get exact case for the actual process name
myProcess = objProcess.Name
' Kill all instances of the process
objProcess.Terminate()
End If
Next
If blnRunning Then
' Wait and make sure the process is terminated.
' Routine written by Denis St-Pierre.
Do Until Not blnRunning
Set colProcesses = GetObject( _
"winmgmts:{impersonationLevel=impersonate}" _
).ExecQuery( "Select * From Win32_Process Where Name = '" _
& myProcess & "'" )
WScript.Sleep 100 'Wait for 100 MilliSeconds
If colProcesses.Count = 0 Then 'If no more processes are running, exit loop
blnRunning = False
End If
Loop
' Display a message
WScript.Echo myProcess & " was terminated"
Else
WScript.Echo "Process """ & myProcess & """ not found"
End If
End Sub
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:any
Client software:WMI
CORE 1.5 for Windows NT 4
Script Engine:WSH (replace the WScript.Echo and WScript.Sleep lines to make this work in HTAs)
Summarized:Works in Windows NT 4 or later, requires WMI CORE 1.5 for Windows NT 4.
Won't work in Windows 95, 98 or ME.
Kill a Process By Window Title
JSSys3
VBScript Code:
' Close a window based on its window title
' Demo of CloseProgram() method in JSWare's JSSys3.dll
' http://www.jsware.net/jsware/scripts.php5#jssys
Option Explicit
Dim arrProcesses, arrWindowTitles
Dim i, intProcesses
Dim objJSSys
Dim strProcList
Set objJSSys = CreateObject( "JSSys3.ops" )
' Close Notepad, ask for confirmation if there are unsaved changes
objJSSys.CloseProgram "Untitled - Notepad", 1
Set objJSSys = Nothing
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:any
Client software:JSSys3, VB6 Runtimes
Script Engine:any
Summarized:Works in Windows NT 4 or later, requires
JSSys3 and VB6 Runtimes.
Get the Current Script's Process ID
WMI: Win32_Process
VBScript Code:Download💾Option ExplicitDim intPIDDim colItems, objItem, objWMIService, wshShellDim strCommand, strTitle If WScript.Arguments.Count>0Then Syntax OnErrorResumeNext strTitle = Rnd(Second( Now )) & " " & FormatDateTime( Now, vbShortTime )strCommand = "cmd.exe /k title " & strTitle ' Spawn a child processSet wshShell = CreateObject("WScript.Shell")wshShell.Run strCommand, 7, FalseIf Err Then WScript.Quit-1Set wshShell = NothingSet objWMIService = GetObject("winmgmts://./root/cimv2")' Get the newly spawned process' parent process IDSet colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE '%cmd.exe% /k title " & strTitle & "'")If Err Then WScript.Quit-1ForEach objItem In colItemsintPID = objItem.ParentProcessIdIf Err Then WScript.Quit-1' Terminate the spawned processobjItem.TerminateIf Err Then WScript.Quit-1Next' The parent of that parent process is the current script engineSet colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & intPID )If Err Then WScript.Quit-1ForEach objItem In colItemsintPID = objItem.ParentProcessIdIf Err Then WScript.Quit-1NextSet colItems = NothingSet objWMIService = NothingOnErrorGoto0 WScript.Echo intPIDWScript.Quit intPID Sub SyntaxDim strMsgstrMsg = "GetMyPID.vbs, Version 1.00" _ & vbCrLf _ & "Return this script's process ID, both on screen and as "errorlevel" _ & vbCrLf & vbCrLf _ & "Usage: CSCRIPT.EXE //NoLogo GetMyPID.vbs" _ & vbCrLf & vbCrLf _ & "Note: The script's return code ("errolevel") equals the PID, or" _ & vbCrLf _ & " will be -1 in case of errors." _ & vbCrLf & vbCrLf _ & "Written by Rob van der Woude" _ & vbCrLf _ & "http://www.robvanderwoude.com"WScript.Echo strMsgWScript.Quit-1EndSub
Requirements:
Windows version:XP Pro or later
Network:any
Script Engine:any
Summarized:Works in Windows XP pro or later versions with all scripting engines.
Restart a Service
Win32_Service
VBScript Code:
RestartService "Messenger", 0
Sub RestartService( myService, blnQuiet )
' This subroutine restarts a service
' Arguments:
' myService use the service's DisplayName
' blnQuiet if False, the state of the service is displayed
' every second during the restart procedure
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim colServices, colServicesTest, objService
Dim objServiceTest, objWMIService, strQuery, strTest
' Create a WMI object
Set objWMIService = GetObject( "winmgmts:\\.\root\CIMV2" )
' Query the services for "our" service
strQuery = "SELECT * FROM Win32_Service WHERE DisplayName='" & myService & "'"
Set colServices = objWMIService.ExecQuery( strQuery, "WQL", 48 )
' Loop through the "collection" of returned services
For Each objService In colServices
' See if we need to tell the user we're going to stop the service
If Not blnQuiet Then
WScript.Echo "Stopping " & myService
End If
' Stop the service
objService.StopService
' Wait until the service is stopped
Do Until strTest = "Stopped"
' Create a new object for our service; this work-around is required
' since otherwise the service's state information isn't properly updated
Set colServicesTest = objWMIService.ExecQuery( strQuery, "WQL", 48 )
' Loop through the "collection" of returned services
For Each objServiceTest In colServicesTest
' Check the service's state
strTest = objServiceTest.State
' See if we need to show the progress
If Not blnQuiet Then
WScript.Echo "State: " & strTest
End If
' Wait 1 second
WScript.Sleep 1000
Next
' Clear the temporary object
Set colServicesTest = Nothing
Loop
' See if we need to tell the user we're going to (re)start the service
If Not blnQuiet Then
WScript.Echo "Starting " & myService
End If
' Start the service
objService.StartService
' Wait until the service is running again
Do Until strTest = "Running"
' Create a new object for our service; this work-around is required
' since otherwise the service's state information isn't properly updated
Set colServicesTest = objWMIService.ExecQuery( strQuery, "WQL", 48 )
' Loop through the "collection" of returned services
For Each objServiceTest In colServicesTest
' Check the service's state
strTest = objServiceTest.State
' See if we need to show the progress
If Not blnQuiet Then
WScript.Echo "State: " & strTest
End If
' Wait 1 second
WScript.Sleep 1000
Next
' Clear the temporary object
Set colServicesTest = Nothing
Loop
Next
End Sub
Requirements:
Windows version:NT 4, 2000, XP, Server 2003, or Vista
Network:any
Client software:WMI CORE 1.5 for Windows NT 4
Script Engine:WSH (replace the WScript.Echo and WScript.Sleep lines to make this work in HTAs)
Summarized:Works in Windows NT 4 or later, requires WMI CORE 1.5 for Windows NT 4.
Won't work in Windows 95, 98 or ME.
Registry
WSH Shell
VBScript Code:
' Create a WSH Shell object:
Set wshShell = CreateObject( "WScript.Shell" )
'
' Create a new key:
wshShell.RegWrite "HKCU\TestKey\", ""
' Create a new DWORD value:
wshShell.RegWrite "HKCU\TestKey\DWordTestValue", 1, "REG_DWORD"
' Create a new subkey and a string value in that new subkey:
wshShell.RegWrite "HKCU\TestKey\SubKey\StringTestValue", "Test", "REG_SZ"
' Read the values we just created:
WScript.Echo "HKCU\TestKey\DWordTestValue = " _
& wshShell.RegRead( "HKCU\TestKey\DWordTestValue" )
WScript.Echo "HKCU\TestKey\SubKey\StringTestValue = """ _
& wshShell.RegRead( "HKCU\TestKey\SubKey\StringTestValue" ) & """"
' Delete the subkey and key and the values they contain:
wshShell.RegDelete "HKCU\TestKey\SubKey\"
wshShell.RegDelete "HKCU\TestKey\"
' Note: Since the WSH Shell has no Enumeration functionality, you cannot
' use the WSH Shell object to delete an entire "tree" unless you
' know the exact name of every subkey.
' If you don't, use the WMI StdRegProv instead.
' Release the object
Set wshShell = Nothing
Requirements:
Windows version:any
Network:any
Client software:N/A
Script Engine:WSH
Summarized:Works in any Windows version.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, not in HTAs.
Registry
WMI StdRegProv
VBScript Code:
Because of its length, only the code for the function itself is shown on this page.
The demo script that shows how to use this function is available as a separate download.
Function ReadRegValue( myComputer, myRegPath, myRegValue )
' This function reads a value from the registry of any WMI
' enabled computer.
'
' Arguments:
' myComputer a computer name or IP address,
' or a dot for the local computer
' myRegPath a full registry key path, e.g.
' HKEY_CLASSES_ROOT\.jpg or
' HKLM\SOFTWARE\Microsoft\DirectX
' myRegValue the value name to be queried, e.g.
' InstalledVersion or "" for default
' values
'
' The function returns an array with the following elements:
' ReadRegValue(0) the computer name (the first argument)
' ReadRegValue(1) the hive number (see const declarations)
' ReadRegValue(2) the key path without the hive
' ReadRegValue(3) the value name (the third argument)
' ReadRegValue(4) the error number: 0 means no error
' ReadRegValue(5) the data type of the result
' ReadRegValue(6) the actual data, or the first element of an
' array of data for REG_BINARY or REG_MULTI_SZ
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006 ' Windows 95/98 only
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Const REG_QWORD = 11
Dim arrRegPath, arrResult(), arrValueNames, arrValueTypes
Dim i, objReg, strHive, valRegError, valRegType, valRegVal
' Assume no error, for now
valRegError = 0
' Split the registry path in a hive part
' and the rest, and check if that succeeded
arrRegPath = Split( myRegPath, "\", 2 )
If IsArray( arrRegPath ) Then
If UBound( arrRegPath ) <> 1 Then valRegError = 5
Else
valRegError = 5
End If
' Convert the hive string to a hive number
Select Case UCase( arrRegPath( 0 ) )
Case "HKCR", "HKEY_CLASSES_ROOT"
strHive = HKEY_CLASSES_ROOT
Case "HKCU", "HKEY_CURRENT_USER"
strHive = HKEY_CURRENT_USER
Case "HKLM", "HKEY_LOCAL_MACHINE"
strHive = HKEY_LOCAL_MACHINE
Case "HKU", "HKEY_USERS"
strHive = HKEY_USERS
Case "HKCC", "HKEY_CURRENT_CONFIG"
strHive = HKEY_CURRENT_CONFIG
Case "HKDD", "HKEY_DYN_DATA"
strHive = HKEY_DYN_DATA
Case Else
valRegError = 5
End Select
' Abort if any error occurred, and return an error code
If valRegError > 0 Then
ReadRegValue = Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
End If
' Initiate custom error handling
On Error Resume Next
' Create a WMI registry object
Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" _
& myComputer & "/root/default:StdRegProv" )
' Abort on failure to create the object
If Err Then
valRegError = Err.Number
Err.Clear
On Error Goto 0
ReadRegValue = Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
End If
' Get a list of all values in the registry path;
' we need to do this in order to find out the
' exact data type for the requested value
objReg.EnumValues strHive, arrRegPath( 1 ), arrValueNames, arrValueTypes
' If no values were found, we'll need to retrieve a default value
If Not IsArray( arrValueNames ) Then
arrValueNames = Array( "" )
arrValueTypes = Array( REG_SZ )
End If
If Err Then
' Abort on failure, returning an error code
valRegError = Err.Number
Err.Clear
On Error Goto 0
ReadRegValue = Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
Else
' Loop through all values in the list . . .
For i = 0 To UBound( arrValueNames )
' . . . and find the one requested
If UCase( arrValueNames( i ) ) = UCase( myRegValue ) Then
' Read the requested value's data type
valRegType = arrValueTypes( i )
' Based on the data type, use the appropriate query to retrieve the data
Select Case valRegType
Case REG_SZ
objReg.GetStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case REG_EXPAND_SZ
objReg.GetExpandedStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case REG_BINARY ' returns an array of bytes
objReg.GetBinaryValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case REG_DWORD
objReg.GetDWORDValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case REG_MULTI_SZ ' returns an array of strings
objReg.GetMultiStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case REG_QWORD
objReg.GetQWORDValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError = Err.Number
Case Else
valRegError = 5
End Select
End If
Next
End If
' Check if an error occurred
If valRegError > 0 Then
valRegType = ""
valRegVal = ""
Err.Clear
On Error Goto 0
End If
' Return the data in an array
If valRegType = REG_BINARY Or valRegType = REG_MULTI_SZ Then
' First, deal with registry data which is
' returned as array instead of single value
ReDim Preserve arrResult( 6 + UBound( valRegVal ) )
arrResult( 0 ) = myComputer
arrResult( 1 ) = strHive
arrResult( 2 ) = arrRegPath( 1 )
arrResult( 3 ) = myRegValue
arrResult( 4 ) = valRegError
arrResult( 5 ) = valRegType
For i = 0 To UBound( valRegVal )
arrResult( 6 + i ) = valRegVal( i )
Next
ReadRegValue = arrResult
Else
ReadRegValue = Array( myComputer, strHive, arrRegPath( 1 ), _
myRegValue, valRegError, valRegType, valRegVal )
End If
' Finished
Set objReg = Nothing
On Error Goto 0
End Function
Requirements:
Windows version:ME, 2000, XP, Server 2003, or Vista (95, 98, NT 4 with WMI CORE 1.5)
Network:any
Client software:WMI CORE 1.5 for Windows 95, 98 or NT 4
Script Engine:any
Summarized:Can work on any Windows computer, but WMI CORE 1.5 is required for Windows 95, 98 or NT 4.
Can be used in *.vbs with CSCRIPT.EXE or WSCRIPT.EXE, as well as in HTAs.
Regular Expressions in VBScript
Nowadays, regular expressions are a powerful part of most programming and scripting languages.
They allow us to search strings or blocks of text using patterns instead of just fixed "filter strings".
The RegExp object
In VBScript, Regular Expressions use the RegExp object, which was introduced in Windows Script Host version 5:
Set objRE = New RegExp
Three properties are available for the RegExp object:
Globalif TRUE, find all matches, if FALSE find only the first match
IgnoreCaseif TRUE perform a case-insensitive search, if FALSE perform a case-sensitive search
Patternthe RegExp pattern to search for
Three methods are available for the RegExp object:
Test( teststring )returns TRUE if a match is found in teststring
Execute( teststring )returns an object with the following properties:
Countthe number of matches found in teststring (maximum is 1 if .Global = False)
Itemthe matches themselves as objects, each with the following properties:
FirstIndexthe location of the matching substring in teststring
Lengththe length of the matching substring
SubMatchesif parentheses were used in the pattern: the matching pieces of the pattern between sets of parentheses as objects, each with the following properties:
Countthe number of submatches found in the match
Itemthe string value of the submatch
Valuethe string value of the match
Replace( teststring, replacement )returns the original teststring with the first (.Global = False) or all (.Global = True) match(es) replaced by a new replacement string
Patterns
In general, patterns for WSH's RegExp object are like regex patterns in any scripting language.
Special characters and backreferences may differ from other languages, though.
Use the MSDN list of special characters for WSH's RegExp object.
Some Examples
Test if a string is a valid e-mail address:
In this example, all we want to know is whether a string is a valid e-mail address or not.
So we can use the RegExp object's Test method.
strEmail = "rob.van.der.woude@nodomainofmine.co.uk"
Set objRE = New RegExp
With objRE
.Pattern = "ˆ([\w-]+\.)*[\w-]+@([\w-]+\.)+[a-z]{2,4}$"
.IgnoreCase = True
.Global = False
End With
' Test method returns TRUE if a match is found
If objRE.Test( strEmail ) Then
WScript.Echo strEmail & " is a valid e-mail address"
Else
WScript.Echo strEmail & " is NOT a valid e-mail address"
End If
Set objRE = Nothing
Extract the domain name from an e-mail address:
Now that we know that we have a valid e-mail address, let's extract the domain name.
We will now use the RegExp object's Execute method, because we want the matching string itself.
strEmail = "rob.van.der.woude@nodomainofmine.co.uk"
Set objRE = New RegExp
With objRE
.Pattern = "ˆ([\w-]+\.)*[\w-]+@(([\w-]+\.)+[a-z]{2,4})$"
.IgnoreCase = True
.Global = False
End With
Set objMatch = objRE.Execute( strEmail )
' We should get only 1 match since the Global property is FALSE
If objMatch.Count = 1 Then
' Item(0) is the (first and only) matching e-mail address,
' Submatches(1) is the substring between the second set of
' parentheses (all indexes are zero based)
WScript.Echo "The domain name for " & strEmail _
& " is " & objMatch.Item(0).Submatches(1) & "."
Else
WScript.Echo "No domain name was found for " & strEmail & "."
End If
Set objMatch = Nothing
Set objRE = Nothing
Change the domain name in an e-mail address
(but not the top level domain):
Let's combine what we got so far, and add some code to change the domain name from "nodomainofmine.co.uk" to "myowndomain.co.uk".
This time we'll use the Replace method.
strEmail = "rob.van.der.woude@nodomainofmine.co.uk"
Set objRE = New RegExp
With objRE
.Pattern = "ˆ([\w-]+\.)*[\w-]+@([\w-]+\.)+[a-z]{2,4}$"
.IgnoreCase = True
.Global = False
End With
' Test method returns TRUE if a match is found
If objRE.Test( strEmail ) Then
WScript.Echo " & strEmail & " is a valid e-mail address."
Else
WScript.Echo " & strEmail & " is NOT a valid e-mail address."
Set objRE = Nothing
WScript.Quit 1
End If
objRE.Pattern = "ˆ([\w-]+\.)*[\w-]+@([\w-]+)(\.[\w-]+)*\.[a-z]{2,4}$"
Set objMatch = objRE.Execute( strEmail )
' We should get only 1 match since the Global property is FALSE
If objMatch.Count = 1 Then
' Item(0) is the (first and only) matching e-mail address,
' Submatches(1) is the substring between the second set of
' parentheses (all indexes are zero based)
strDomain = objMatch.Item(0).Submatches(1)
WScript.Echo "The string to be replaced is " & strDomain & "."
Else
WScript.Echo "No domain name was found for " & strEmail & "."
Set objRE = Nothing
WScript.Quit 1
End If
Set objMatch = Nothing
objRE.Pattern = "@" & strDomain
strNewDomain = "myowndomain"
strNewMail = objRE.Replace( strEmail, "@" & strNewDomain )
WScript.Echo "The new e-mail address is " & strNewMail & "."
Set objRE = Nothing
Yes, I know, in real life we wouldn't replace the name like this, it would have been much easier and safer to use
strNewMail = Replace( strEmail, "@" & strDomain, "@" & strNewDomain )
instead.
GetShortcut
VBScript Code:
' Author: Denis St-Pierre
' *Retrieves* Shortcut info without using WMI
' The *Undocumented* Trick: use the ".CreateShortcut" method without the
' ".Save" method; works like a GetShortcut when the shortcut already exists!
strTargetPath="C:\Documents and Settings\All Users\Desktop\My Shortcut.lnk"
Set wshShell = CreateObject("WScript.Shell")
' CreateShortcut works like a GetShortcut when the shortcut already exists!
Set objShortcut = wshShell.CreateShortcut(strTargetPath)
' For URL shortcuts, only ".FullName" and ".TargetPath" are valid
WScript.Echo "Full Name : " & objShortcut.FullName
WScript.Echo "Arguments : " & objShortcut.Arguments
WScript.Echo "Working Directory : " & objShortcut.WorkingDirectory
WScript.Echo "Target Path : " & objShortcut.TargetPath
WScript.Echo "Icon Location : " & objShortcut.IconLocation
WScript.Echo "Hotkey : " & objShortcut.Hotkey
WScript.Echo "Window Style : " & objShortcut.WindowStyle
WScript.Echo "Description : " & objShortcut.Description
Set objShortcut = Nothing
Set wshShell = Nothing
Requirements:
Windows version:any
Network:any
Client software:N/A
Script Engine:any
Summarized:Should work in any Windows version, with any script engine.
Delays
I often need delays in my scripts, e.g. to wait for an object or a connection to get ready.
The easiest way to implement a 1 second delay, of course, is WSH's WScript.Sleep 1000 (delay in milliseconds).
Dim objIE
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Navigate "about:blank"
' Wait till IE is ready
Do While objIE.Busy
WScript.Sleep 1000
Loop
That's fine for scripts running in CSCRIPT.EXE or WSCRIPT.EXE, but in HTAs or WSCs there is no WScript object, and thus no WScript.Sleep, so we need an alternative.
A quick-and-really-dirty way is just remove the WScript.Sleep line:
Dim objIE
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Navigate "about:blank"
' Wait till IE is ready
Do While objIE.Busy
Loop
This will work, but the script will loop hundreds of times per second, and you'll see your CPU usage remain at 100% until the script exits the loop.
That may sometimes be acceptable, e.g. in a login script when no time critical processes are running, but you wouldn't want to run a script like that while burning a CD or watching a HD video on YouTube, would you?
You can use the setTimeout and clearTimeout methods in HTAs, well explained in this Scripting Guys article.
However, that will start a command in a separate process, while the script itself continues and won't wait for the command to finish (more or less like the START command in batch files, with an added time delay).
This may work in some cases, but it isn't always practical, as you will need to split the code at the delay (try to use it within a loop and it's really going to look messy).
While on the subject of batch commands: you can "embed" a batch command in your VBScript code to get a delay in Windows 7 and later versions:
' Get a 10 seconds delay
Delay 10
Sub Delay( seconds )
Dim wshShell, strCmd
Set wshShell = CreateObject( "WScript.Shell" )
strCmd = wshShell.ExpandEnvironmentStrings( "%COMSPEC% /C (TIMEOUT.EXE /T " & seconds & " /NOBREAK)" )
wshShell.Run strCmd, 0, 1
Set wshShell = Nothing
End Sub
Using TIMEOUT is a lot more reliable than the old PING trick — which does work in older Windows versions, though, as long as it supports TCP/IP:
' Get a 10 seconds delay
Delay 10
Sub Delay( seconds )
Dim wshShell, strCmd
Set wshShell = CreateObject( "WScript.Shell" )
strCmd = wshShell.ExpandEnvironmentStrings( "%COMSPEC% /C (PING.EXE -n " & ( seconds + 1 ) & " localhost >NUL 2>&1)" )
wshShell.Run strCmd, 0, 1
Set wshShell = Nothing
End Sub
This will work in HTAs and WSCs, as well as in WSCRIPT.EXE/CSCRIPT.EXE (though in the latter, WScript.Sleep is a much better choice, of course).
See my Wait page for a detailed explanation of time delays with the PING command.
Browse Folder Dialog
Shell.Application
VBScript Code:
Option Explicit
WScript.Echo BrowseFolder( "C:\Program Files", True )
WScript.Echo BrowseFolder( "My Computer", False )
WScript.Echo BrowseFolder( "", False )
Function BrowseFolder( myStartLocation, blnSimpleDialog )
' This function generates a Browse Folder dialog
' and returns the selected folder as a string.
'
' Arguments:
' myStartLocation [string] start folder for dialog, or "My Computer", or
' empty string to open in "Desktop\My Documents"
' blnSimpleDialog [boolean] if False, an additional text field will be
' displayed where the folder can be selected
' by typing the fully qualified path
'
' Returns: [string] the fully qualified path to the selected folder
'
' Based on the Hey Scripting Guys article
' "How Can I Show Users a Dialog Box That Only Lets Them Select Folders?"
' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
'
' Function written by Rob van der Woude
' http://www.robvanderwoude.com
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath, strPrompt
' Set the options for the dialog window
strPrompt = "Select a folder:"
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10& ' Additional text field to type folder path
End If
' Create a Windows Shell object
Set objShell = CreateObject( "Shell.Application" )
' If specified, convert "My Computer" to a valid
' path for the Windows Shell's BrowseFolder method
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
' Quit if no folder was selected
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
' Retrieve the path of the selected folder
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
' Return the path of the selected folder
BrowseFolder = objPath
End Function
Requirements:
Windows version:any (Windows 95 and NT 4 require Internet Explorer 4)
Network:N/A
Client software:Internet Explorer 4 or later for Windows 95 and NT 4
Script Engine:any
Summarized:Works in any Windows version, provided Internet Explorer 4 or later is installed.
Change Default Printer Dialog
This dialog can be used to change printer settings too.
All changes made in this dialog are permanent, i.e. they will be the new default settings.
MSComDlg.CommonDialog.1
VBScript Code:
Option Explicit
Dim strKey, wshShell
' Create WScript.Shell object to read the registry
Set wshShell = CreateObject( "WScript.Shell" )
' Read the current default printer from registry
strKey = "HKEY_CURRENT_USER\Software\Microsoft" _
& "\Windows NT\CurrentVersion\Windows\Device"
WScript.Echo "Current Default printer : " _
& Trim( Split( wshShell.RegRead( strKey ), "," )(0) )
' Call the Print Dialog to change the default printer
WScript.Echo "Choose a new default printer..."
ChangePrinterSettings
' Read the new default printer from registry
WScript.Echo "New Default printer : " _
& Trim( Split( wshShell.RegRead( strKey ), "," )(0) )
' Release the Shell object
Set wshShell = Nothing
Sub ChangePrinterSettings( )
' Interactively change your printer settings, including the default
' printer. Click the "Print" button to confirm the new printer settings.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim objPrnDlg, strPrompt, strTitle
Const vbOK = 1
Const vbCancel = 2
Const vbAbort = 3
Const vbRetry = 4
Const vbIgnore = 5
Const vbYes = 6
Const vbNo = 7
' Explain there will be no OK button, the Print button must be
' clicked instead.
strPrompt = "In the next dialog, choose which printer will " _
& "be the new Default Printer and press the " _
& """Print"" button to confirm." & vbCrLf & vbCrLf _
& "Note that any changes you make in the printer " _
& "settings will be permanent, i.e. they will be " _
& "the new default settings."
strTitle = "Choose New Default Printer and/or Printer Settings"
If MsgBox( strPrompt, vbOKCancel, strTitle ) = vbOK Then
' Create a dialog object
Set objPrnDlg = CreateObject( "MSComDlg.CommonDialog.1" )
' Make selections permanent
objPrnDlg.PrinterDefault = True
' Open the Print dialog
objPrnDlg.ShowPrinter
' Release the object
Set objPrnDlg = Nothing
End If
End Sub
Requirements:
Windows version:any (except for the registry keys holding the default printer) as long as ComDlg32.ocx is installed and registered
Network:N/A
Client software:Requires ComDlg32.ocx, which is included with Visual Basic 5 and later and MS-Office 2000 and XP.
You can download ComDlg32.ocx version 6 or version 5 from Microsoft.com.
Script Engine:any
Summarized:The subroutine should work in any Windows version as long as ComDlg32.ocx is installed and registered.
The registry keys for the default printer, used here for demonstration purposes only, are valid for Windows NT 4 and later only.
Change Password Dialog
InternetExplorer.Application
VBScript Code:
Function IEChangePwd( myUserName )
' This function uses Internet Explorer to create a login dialog.
' It won't close until all fields have valid values and the OK
' button is clicked.
'
' Version: 2.11
' Last modified: 2013-11-07
'
' Arguments: [string] user name
' Returns: [array] the old (0) and new (1) passwords
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Error handling code written by Denis St-Pierre
Dim arrPwd, blnValid, objIE
blnValid = False
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
' specify some of the IE window's settings
objIE.Navigate "about:blank"
objIE.Document.title = "Change password" & String( 80, "." )
objIE.ToolBar = False
objIE.Resizable = False
objIE.StatusBar = False
objIE.Width = 400
objIE.Height = 240
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width ) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
WScript.Sleep 200
Loop
' Insert the HTML code to prompt for user input
objIE.Document.body.innerHTML = "<div align=""center""><table cellspacing=""5"">" _
& "<tr nowrap><th colspan=""2"">Change password for " _
& myUserName & ":</th></tr><tr nowrap><td>Old password:" _
& "</td><td><input type=""password"" size=""20"" id=" _
& """OldPassword""></td></tr><tr nowrap><td>New password:" _
& "</td><td><input type=""password"" size=""20"" id=" _
& """NewPassword""></td></tr><tr nowrap><td>Confirm " _
& "password:</td><td><input type=""password"" size=""20"" " _
& "id=""ConfirmPassword""></td></tr></table>" _
& "<p><input type=""hidden"" id=""OK"" name=""OK"" " _
& "value=""0""><input type=""submit"" value="" OK "" " _
& "onclick=""VBScript:OK.value=1""></p></div>"
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on password input field
objIE.Document.all.OldPassword.focus
' Wait for valid input (2 non-empty equal passwords)
Do Until blnValid = True
' Wait till the OK button has been clicked
On Error Resume Next
Do While objIE.Document.all.OK.value = 0
WScript.Sleep 200
' Error handling code by Denis St-Pierre
If Err Then
IEChangePwd = Array( "", "" )
objIE.Quit
Set objIE = Nothing
Exit Function
End If
Loop
On Error Goto 0
' Read the user input from the dialog window
arrPwd = Array( objIE.Document.all.OldPassword.value, _
objIE.Document.all.NewPassword.value, _
objIE.Document.all.ConfirmPassword.value )
' Check if the new password and confirmed password match
If arrPwd(1) = arrPwd(2) Then
' Check if the new password isn't empty
If Trim( arrPwd(1) ) = "" Then
MsgBox "The new password cannot be empty", _
vbOKOnly + vbInformation + vbApplicationModal, _
"Type new password"
objIE.Document.all.NewPassword.value = ""
objIE.Document.all.ConfirmPassword.value = ""
objIE.Document.all.OK.value = 0
objIE.Document.all.NewPassword.focus
Else
blnValid = True
End If
Else
MsgBox "The new and confirmed passwords do not match.", _
vbOKOnly + vbInformation + vbApplicationModal, _
"Retype new password"
objIE.Document.all.NewPassword.value = ""
objIE.Document.all.ConfirmPassword.value = ""
objIE.Document.all.OK.value = 0
objIE.Document.all.NewPassword.focus
End If
Loop
' Close and release the object
objIE.Quit
Set objIE = Nothing
' Return the passwords in an array
IEChangePwd = Array( arrPwd(0), arrPwd(1) )
End Function
Sample VBScript Code:
strUserName = "JohnDoe"
arrPasswords = IEChangePwd( strUserName )
WScript.Echo "Change password for : " & strUserName & vbCrLf _
& "The old password was : " & arrPasswords(0) & vbCrLf _
& "The new password is : " & arrPasswords(1)
Sample output:
Change password for : JohnDoe
The old password was : oldpassword
The new password is : NewPassword2
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both WScript.Sleep lines)
Summarized:Works in all Windows versions with Internet Explorer 4 or later, remove both WScript.Sleep lines to use in HTAs.
Select Folder Dialog
Shell.Application
VBScript Code:
Option Explicit
Dim strPath
strPath = SelectFolder( "" )
If strPath = vbNull Then
WScript.Echo "Cancelled"
Else
WScript.Echo "Selected Folder: """ & strPath & """"
End If
Function SelectFolder( myStartFolder )
' This function opens a "Select Folder" dialog and will
' return the fully qualified path of the selected folder
'
' Argument:
' myStartFolder [string] the root folder where you can start browsing;
' if an empty string is used, browsing starts
' on the local computer
'
' Returns:
' A string containing the fully qualified path of the selected folder
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objFolder, objItem, objShell
' Custom error handling
On Error Resume Next
SelectFolder = vbNull
' Create a dialog object
Set objShell = CreateObject( "Shell.Application" )
Set objFolder = objShell.BrowseForFolder( 0, "Select Folder", 0, myStartFolder )
' Return the path of the selected folder
If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path
' Standard housekeeping
Set objFolder = Nothing
Set objshell = Nothing
On Error Goto 0
End Function
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:WSH
Summarized:Works in any Windows version.
File Open Dialog
UserAccounts.CommonDialog
VBScript Code:
WScript.Echo "Selected file: " & GetFileName( "C:\", "" )
WScript.Echo "Selected file: " & GetFileName( "", "Text files|*.txt" )
WScript.Echo "Selected file: " & GetFileName( "", "MS Office documents|*.doc;*.xls;*.pps" )
WScript.Echo "Selected file: " & GetFileName( "C:\WINDOWS", "Bitmaps|*.bmp" )
Function GetFileName( myDir, myFilter )
' This function opens a File Open Dialog and returns the
' fully qualified path of the selected file as a string.
'
' Arguments:
' myDir is the initial directory; if no directory is
' specified "My Documents" is used;
' NOTE: this default requires the WScript.Shell
' object, and works only in WSH, not in HTAs!
' myFilter is the file type filter; format "File type description|*.ext"
' ALL arguments MUST get A value (use "" for defaults), OR otherwise you must
' use "On Error Resume Next" to prevent error messages.
'
' Dependencies:
' Requires NUSRMGRLib (nusrmgr.cpl), available in Windows XP and later.
' To use the default "My Documents" WScript.Shell is used, which isn't
' available in HTAs.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objDialog
' Create a dialog object
Set objDialog = CreateObject( "UserAccounts.CommonDialog" )
' Check arguments and use defaults when necessary
If myDir = "" Then
' Default initial folder is "My Documents"
objDialog.InitialDir = CreateObject( "WScript.Shell" ).SpecialFolders( "MyDocuments" )
Else
' Use the specified initial folder
objDialog.InitialDir = myDir
End If
If myFilter = "" Then
' Default file filter is "All files"
objDialog.Filter = "All files|*.*"
Else
' Use the specified file filter
objDialog.Filter = myFilter
End If
' Open the dialog and return the selected file name
If objDialog.ShowOpen Then
GetFileName = objDialog.FileName
Else
GetFileName = ""
End If
End Function
Requirements:
Windows version:Windows XP
Network:N/A
Client software:N/A
Script Engine:any (WSH if using default for directory)
Additional options:
objDialog.Filter = "MS Office files|*.doc;*.xls;*.pps|Text files|*.txt|All files|*.*"
objDialog.FilterIndex = 1 'MS Office files
objDialog.FilterIndex = 2 'Text files
objDialog.FilterIndex = 3 'All files
objDialog.Flags = 1 'Check "Open file as read-only" checkbox in dialog
objDialog.Flags = 0 'Restore default read-write mode
Summarized:Works in Windows XP only.
If used in HTAs, the initial directory must be specified.
Doesn't work in any other Windows version.
SAFRCFileDlg.FileOpen
VBScript Code:
Set objDialog = CreateObject( "SAFRCFileDlg.FileOpen" )
' Note: The dialog will be opened without any file name or
' type filter, and in the "current" directory, e.g. as
' remembered from the last "SAFRCFileDlg.FileOpen" or
' "SAFRCFileDlg.FileSave" dialog!
If objDialog.OpenFileOpenDlg Then
WScript.Echo "objDialog.FileName = " & objDialog.FileName
End If
Requirements:
Windows version:Windows XP, Server 2003
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in all Windows XP versions and in Server 2003.
Doesn't work in Windows 95, 98, ME, NT 4, 2000 or 7, not sure about Vista.
InternetExplorer.Application
VBScript Code:
Option Explicit
WScript.Echo "Selected file: " & ChooseFile( )
Function ChooseFile( )
' Select File dialog based on a script by Mayayana
' Known issues:
' * Tree view always opens Desktop folder
' * In Win7/IE8 only the file NAME is returned correctly, the path returned will always be C:\fakepath\
' * If a shortcut to a file is selected, the name of that FILE will be returned, not the shortcut's
On Error Resume Next
Dim objIE, strSelected
ChooseFile = ""
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.visible = False
objIE.Navigate( "about:blank" )
Do Until objIE.ReadyState = 4
Loop
objIE.Document.Write "<HTML><BODY><INPUT ID=""FileSelect"" NAME=""FileSelect"" TYPE=""file""><BODY></HTML>"
With objIE.Document.all.FileSelect
.focus
.click
strSelected = .value
End With
objIE.Quit
Set objIE = Nothing
ChooseFile = strSelected
End Function
Requirements:
Windows version:any
Network:N/A
Client software:Internet Explorer
Script Engine:any
Summarized:Works in all Windows versions.
WScript.Shell.Exec MSHTA
VBScript Code:
Option Explicit
Dim strFile
strFile = SelectFile( )
If strFile = "" Then
WScript.Echo "No file selected."
Else
WScript.Echo """" & strFile & """"
End If
Function SelectFile( )
' File Browser via HTA
' Author: Rudi Degrande, modifications by Denis St-Pierre and Rob van der Woude
' Features: Works in Windows Vista and up (Should also work in XP).
' Fairly fast.
' All native code/controls (No 3rd party DLL/ XP DLL).
' Caveats: Cannot define default starting folder.
' Uses last folder used with MSHTA.EXE stored in Binary in [HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32].
' Dialog title says "Choose file to upload".
' Source: https://social.technet.microsoft.com/Forums/scriptcenter/en-US/a3b358e8-15ae-4ba3-bca5-ec349df65ef6/windows7-vbscript-open-file-dialog-box-fakepath?forum=ITCG
Dim objExec, strMSHTA, wshShell
SelectFile = ""
' For use in HTAs as well as "plain" VBScript:
strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
& "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
& ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
' For use in "plain" VBScript only:
' strMSHTA = "mshta.exe ""about:<input type=file id=FILE>" _
' & "<script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
' & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>"""
Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( strMSHTA )
SelectFile = objExec.StdOut.ReadLine( )
Set objExec = Nothing
Set wshShell = Nothing
End Function
Requirements:
Windows version:Windows XP and later versions
Network:N/A
Client software:MSHTA.EXE (native in Windows)
Script Engine:any
Summarized:Works in Windows XP, Vista, Windows 7, Windows 8, Windows 8.1.
File Save Dialog
SAFRCFileDlg.FileSave
VBScript Code:
Set objDialog = CreateObject( "SAFRCFileDlg.FileSave" )
' Note: If no path is specified, the "current" directory will
' be the one remembered from the last "SAFRCFileDlg.FileOpen"
' or "SAFRCFileDlg.FileSave" dialog!
objDialog.FileName = "test_save.vbs"
' Note: The FileType property is cosmetic only, it doesn't
' automatically append the right file extension!
' So make sure you type the extension yourself!
objDialog.FileType = "VBScript Script"
If objDialog.OpenFileSaveDlg Then
WScript.Echo "objDialog.FileName = " & objDialog.FileName
End If
Requirements:
Windows version:Windows XP
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in Windows XP only (all versions).
Doesn't work in Windows 95, 98, ME, NT 4, 2000, Server 2003 and 7, not sure about Vista and Server 2008.
Login Dialog
InternetExplorer.Application
VBScript Code:Download
Option Explicit Dim
arrLogin, strNamestrName = NullIf
WScript.Arguments.Unnamed.Count = 1
Then
strName = WScript.Arguments.Unnamed(0)
arrLogin = IELogin(
strName )
WScript.Echo
arrLogin(0)
& vbTab & arrLogin(1)
Function
IELogin(
myName )' This function uses Internet Explorer to create a login dialog.'' Script Name: IELogin.vbs' Version: 4.00' Last modified: 2016-12-22'' Arguments: [string] optional user name (use " or Null to leave user name field blank)' Returns: [array] the user name (0) and password (1) typed in the dialog screen'' The output of IELogin.vbs is meant to be used in a batch file, using the following' batch code or something similar (note: the white space following delims= is a tab):'' REM * * * start of batch code * * *'' FOR /F "tokens=1,2 delims=" %%A IN ('CSCRIPT //NoLogo IELogin.vbs') DO (' SET Name=%%~A' SET Password=%%~B' )' ECHO The password of %Name% is %Password%'' REM * * * end of batch code * * *'' Written by Rob van der Woude' http://www.robvanderwoude.com' Error handling code written by Denis St-Pierre
Dim
intScreenHeight, intScreenWidthDim
colItems, objIE, objItem, objWMIService, wshShellDim
strHTML, strDialogTitle, strName 'On Error Resume Next
strName = Trim
(
" "
& myName )
' Create an IE objectSet
objIE = CreateObject
(
"InternetExplorer.Application"
)' specify some of the IE window's settings
objIE.Navigate
"about:blank"
strDialogTitle = "Login"
& String(
80
, Chr
(
8
)
)
objIE.Document.Title
= strDialogTitleobjIE.ToolBar
= False
objIE.Resizable
= False
objIE.StatusBar
= False
objIE.Width
= 320
objIE.Height
= 180' Wait till IE is readyDo
While
objIE.Busy
WScript.Sleep
200Loop' Center the dialog window on the screenSet
objWMIService = GetObject(
"winmgmts://./root/CIMV2"
)Set
colItems = objWMIService.ExecQuery(
"SELECT * FROM Win32_DesktopMonitor"
)For
Each
objItem in
colItemsintScreenHeight = objItem.ScreenHeight
intScreenWidth = objItem.ScreenWidthNext
objIE.Left
= (
intScreenWidth -
objIE.Width
)
\ 2
objIE.Top
= (
intScreenHeight -
objIE.Height
)
\ 2' Insert the HTML code to prompt for user input
strHTML = "<div style="font-family: sans-serif; text-align: center; margin-left: auto; margin-right: auto;">\n"
_ & "<table>\n"
_ & "<tr>\n"
_ & "\t<td colspan="3"> </td>\n"
_ & "<tr>\n"
_ & "\t<td>Name:</td>\n"
_ & "\t<td> </td>\n"
_ & "\t<td><input type="text" size="20" autocomplete="off" id="LoginName" value="
& strName _ & " onkeyup="javascript:if(event.keyCode==13){document.getElementById('Password').focus();}" /></td>\n"
_ & "</tr>\n"
_ & "<tr>\n"
_ & "\t<td>Password:</td>\n"
_ & "\t<td> </td>\n"
_ & "\t<td><input type="password" size="21" id="Password" "
_ & "onkeyup="javascript:if(event.keyCode==13){document.getElementById('OK').value=1;}" /></td>\n"
_ & "</tr>\n"
_ & "</table>\n"
_ & "<p><input type="hidden" id="OK" name="OK" value="0" />"
_ & "<input type="button" value=" OK " onclick="VBScript:OK.Value=1"></p>\n"
_ & "</div>"
objIE.Document.Body.InnerHTML
= Replace
(
Replace
(
strHTML, "\t"
, vbTab )
, "\n"
, vbCrLf )' Hide the scrollbars
objIE.Document.Body.Style.overflow
= "auto"' Make the window visible
objIE.Visible
= True' Set focus on the appropriate input fieldIf
strName = "
Then
objIE.Document.All.LoginName.FocusElse
objIE.Document.All.Password.FocusEnd
If
' Wait till the OK button has been clickedDo
While
objIE.Document.All.OK.Value
= 0
WScript.Sleep
200' Error handling, by Denis St-PierreIf
Err Then' User clicked red X (or alt-F4) to close IE window
IELogin = Array
(
", " )
objIE.QuitSet
objIE = NothingExit
FunctionEnd
ifLoop
' Make the dialog activeSet
wshShell = CreateObject
(
"WScript.Shell"
)
wshShell.AppActivate
strDialogTitleSet
wshShell = Nothing
' Read the user input from the dialog window
IELogin = Array
(
objIE.Document.All.LoginName.Value
, objIE.Document.All.Password.Value
)' Close and release the object
objIE.QuitSet
objIE = Nothing
On Error Goto 0
End Function
Requirements:
Windows version:Windows XP Professional or later (will work in earlier Windows versions too, but the dialog will not be centered on screen)
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT, remove both WScript.Sleep lines to use in HTAs)
Summarized:Works in all Windows versions with Internet Explorer 4 or later, however, centering the dialog on screen requires Windows XP Professional or later; remove both WScript.Sleep lines to use in HTAs.
Prompt for Passwords
ScriptPW.Password
VBScript Code:
strPw = Password( "Please enter your password:" )
WScript.Echo "Your password is: " & strPw
Function Password( myPrompt )
' This function hides a password while it is being typed.
' myPrompt is the text prompting the user to type a password.
' The function clears the prompt and returns the typed password.
' This code is based on Microsoft TechNet ScriptCenter "Mask Command Line Passwords"
' http://www.microsoft.com/technet/scriptcenter/scripts/default.mspx?mfr=true
' Standard housekeeping
Dim objPassword
' Use ScriptPW.dll by creating an object
Set objPassword = CreateObject( "ScriptPW.Password" )
' Display the prompt text
WScript.StdOut.Write myPrompt
' Return the typed password
Password = objPassword.GetPassword()
' Clear prompt
WScript.StdOut.Write String( Len( myPrompt ), Chr( 8 ) ) _
& Space( Len( myPrompt ) ) _
& String( Len( myPrompt ), Chr( 8 ) )
End Function
Requirements:
Windows version:XP, Server 2003, or Vista
Network:N/A
Client software:.NET Framework for Windows 98, ME, NT 4 & 2000
Script Engine:WSH, CSCRIPT.EXE only
Summarized:Works in Windows XP or later, only in CSCRIPT.EXE (uses StdOut).
Should also work in older Windows versions with .NET Framework installed (look for scriptpw.dll), only in CSCRIPT.EXE.
Doesn't work in Windows 95, nor in Windows 7.
InternetExplorer.Application
VBScript Code:
Option Explicit
Dim strPw
strPw = GetPassword( "Please enter your password:" )
WScript.Echo "Your password is: " & strPw
Function GetPassword( myPrompt )
' This function uses Internet Explorer to
' create a dialog and prompt for a password.
'
' Version: 2.15
' Last modified: 2015-10-19
'
' Argument: [string] prompt text, e.g. "Please enter password:"
' Returns: [string] the password typed in the dialog screen
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Error handling code written by Denis St-Pierre
Dim blnFavoritesBar, blnLinksExplorer, objIE, strHTML, strRegValFB, strRegValLE, wshShell
blnFavoritesBar = False
strRegValFB = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MINIE\LinksBandEnabled"
blnLinksExplorer = False
strRegValLE = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\LinksExplorer\Docked"
Set wshShell = CreateObject( "WScript.Shell" )
On Error Resume Next
' Temporarily hide IE's Favorites Bar if it is visible
If wshShell.RegRead( strRegValFB ) = 1 Then
blnFavoritesBar = True
wshShell.RegWrite strRegValFB, 0, "REG_DWORD"
End If
' Temporarily hide IE's Links Explorer if it is visible
If wshShell.RegRead( strRegValLE ) = 1 Then
blnLinksExplorer = True
wshShell.RegWrite strRegValLE, 0, "REG_DWORD"
End If
On Error Goto 0
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
' specify some of the IE window's settings
objIE.Navigate "about:blank"
' Add string of "invisible" characters (500 tabs) to clear the title bar
objIE.Document.title = "Password " & String( 500, 7 )
objIE.AddressBar = False
objIE.Resizable = False
objIE.StatusBar = False
objIE.ToolBar = False
objIE.Width = 320
objIE.Height = 180
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width ) \ 2
objIE.Top = (.availheight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
WScript.Sleep 200
Loop
' Insert the HTML code to prompt for a password
strHTML = "<div style="text-align: center;">" _
& "<p>" & myPrompt & "</p>" _
& "<p><input type="password" size="20" id="Password" onkeyup=" _
& "if(event.keyCode==13){document.all.OKButton.click();}" /></p>" _
& "<p><input type="hidden" id="OK" name="OK" value="0" />" _
& "<input type="submit" value=" OK " id="OKButton" " _
& "onclick="document.all.OK.value=1" /></p>" _
& "</div>"
objIE.Document.body.innerHTML = strHTML
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on password input field
objIE.Document.all.Password.focus
' Wait till the OK button has been clicked
On Error Resume Next
Do While objIE.Document.all.OK.value = 0
WScript.Sleep 200
' Error handling code by Denis St-Pierre
If Err Then' User clicked red X (or Alt+F4) to close IE window
GetPassword = "
objIE.Quit
Set objIE = Nothing
' Restore IE's Favorites Bar if applicable
If blnFavoritesBar Then wshShell.RegWrite strRegValFB, 1, "REG_DWORD"
' Restore IE's Links Explorer if applicable
If blnLinksExplorer Then wshShell.RegWrite strRegValLE, 1, "REG_DWORD"
' Use "WScript.Quit 1" instead of "Exit Function" if you want
' to abort with return code 1 in case red X or Alt+F4 were used
Exit Function
End if
Loop
On Error Goto 0
' Read the password from the dialog window
GetPassword = objIE.Document.all.Password.value
' Terminate the IE object
objIE.Quit
Set objIE = Nothing
On Error Resume Next
' Restore IE's Favorites Bar if applicable
If blnFavoritesBar Then wshShell.RegWrite strRegValFB, 1, "REG_DWORD"
' Restore IE's Links Explorer if applicable
If blnLinksExplorer Then wshShell.RegWrite strRegValLE, 1, "REG_DWORD"
On Error Goto 0
Set wshShell = Nothing
End Function
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both WScript.Sleep lines)
Summarized:Works in all Windows versions with Internet Explorer 4 or later, remove both WScript.Sleep lines to use in HTAs.
Progress Messages
by Denis St-Pierre
WSH (MsgBox)
VBScript Code:
Function ProgressMsg( strMessage, strWindowTitle )
' Written by Denis St-Pierre
' Displays a progress message box that the originating script can kill in both 2k and XP
' If StrMessage is blank, take down previous progress message box
' Using 4096 in Msgbox below makes the progress message float on top of things
' CAVEAT: You must have Dim ObjProgressMsg at the top of your script for this to work as described
Set wshShell = CreateObject( "WScript.Shell" )
strTEMP = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
If strMessage = " Then
' Disable Error Checking in case objProgressMsg doesn't exists yet
On Error Resume Next
' Kill ProgressMsg
objProgressMsg.Terminate( )
' Re-enable Error Checking
On Error Goto 0
Exit Function
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTempVBS = strTEMP + "\" & "Message.vbs" 'Control File for reboot
' Create Message.vbs, True=overwrite
Set objTempMessage = objFSO.CreateTextFile( strTempVBS, True )
objTempMessage.WriteLine( "MsgBox" & strMessage & ", 4096, " & strWindowTitle & " )
objTempMessage.Close
' Disable Error Checking in case objProgressMsg doesn't exists yet
On Error Resume Next
' Kills the Previous ProgressMsg
objProgressMsg.Terminate( )
' Re-enable Error Checking
On Error Goto 0
' Trigger objProgressMsg and keep an object on it
Set objProgressMsg = WshShell.Exec( "%windir%\system32\wscript.exe " & strTempVBS )
Set wshShell = Nothing
Set objFSO = Nothing
End Function
Requirements:
Windows version:any
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in any Windows version.
Usage Sample:
' Makes the object a Public object (Critical!)
Dim objProgressMsg
' *** Usage example
strWindowTitle = "AppName_1_0"
ProgressMsg "Installing, Please wait.", strWindowTitle
' Do work here that will take a long time
WScript.Sleep 3000
ProgressMsg "I'm installing app #2, Please wait.", strWindowTitle
WScript.Sleep 3000
' Removes previous ProgressMsg
ProgressMsg ", strWindowTitle
WScript.Sleep 3000
' Doing it this way leaves the msgbox
ProgressMsg "Done", strWindowTitle
WScript.Quit
' *** End Usage example
Prompt for User Input
WSH (StdIn or InputBox)
VBScript Code:
strInput = UserInput( "Enter some input:" )
WScript.Echo "You entered: " & strInput
Function UserInput( myPrompt )
' This function prompts the user for some input.
' When the script runs in CSCRIPT.EXE, StdIn is used,
' otherwise the VBScript InputBox( ) function is used.
' myPrompt is the the text used to prompt the user for input.
' The function returns the input typed either on StdIn or in InputBox( ).
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Check if the script runs in CSCRIPT.EXE
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
' If so, use StdIn and StdOut
WScript.StdOut.Write myPrompt & " "
UserInput = WScript.StdIn.ReadLine
Else
' If not, use InputBox( )
UserInput = InputBox( myPrompt )
End If
End Function
Requirements:
Windows version:All
Network:N/A
Client software:Windows Script 5.6 for Windows 98, ME, and NT 4 (no longer available for download?)
Script Engine:WSH
Summarized:Works in any Windows version, provided
Windows Script 5.6 for Windows 98, ME, and NT 4 is installed for Windows 98, ME, and NT 4 (no longer available for download?).
InternetExplorer.Application
VBScript Code:
Function GetUserInput( myPrompt )
' This function uses Internet Explorer to
' create a dialog and prompt for user input.
'
' Version: 2.11
' Last modified: 2013-11-07
'
' Argument: [string] prompt text, e.g. "Please enter your name:"
' Returns: [string] the user input typed in the dialog screen
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Error handling code written by Denis St-Pierre
Dim objIE
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
' Specify some of the IE window's settings
objIE.Navigate "about:blank"
objIE.Document.title = "Input required " & String( 100, "." )
objIE.ToolBar = False
objIE.Resizable = False
objIE.StatusBar = False
objIE.Width = 320
objIE.Height = 180
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width ) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
WScript.Sleep 200
Loop
' Insert the HTML code to prompt for user input
objIE.Document.body.innerHTML = "<div align=""center""><p>" & myPrompt _
& "</p>" & vbCrLf _
& "<p><input type=""text"" size=""20"" " _
& "id=""UserInput""></p>" & vbCrLf _
& "<p><input type=""hidden"" id=""OK"" " _
& "name=""OK"" value=""0"">" _
& "<input type=""submit"" value="" OK "" " _
& "OnClick=""VBScript:OK.value=1""></p></div>"
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on input field
objIE.Document.all.UserInput.focus
' Wait till the OK button has been clicked
On Error Resume Next
Do While objIE.Document.all.OK.value = 0
WScript.Sleep 200
' Error handling code by Denis St-Pierre
If Err Then ' user clicked red X (or alt-F4) to close IE window
IELogin = Array( "", "" )
objIE.Quit
Set objIE = Nothing
Exit Function
End if
Loop
On Error Goto 0
' Read the user input from the dialog window
GetUserInput = objIE.Document.all.UserInput.value
' Close and release the object
objIE.Quit
Set objIE = Nothing
End Function
Sample VBScript Code:
strUserInput = GetUserInput( "Please enter your name:" )
WScript.Echo "Your name is: " & strUserInput
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both WScript.Sleep lines)
Summarized:Works in all Windows versions with Internet Explorer 4 or later, remove both WScript.Sleep lines to use in HTAs.
Buttons Dialog
InternetExplorer.Application
VBScript Code:
Function IEButtons( )
' This function uses Internet Explorer to create a dialog.
Dim objIE, sTitle, iErrorNum
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
' specify some of the IE window's settings
objIE.Navigate "about:blank"
sTitle="Make your choice " & String( 80, "." ) 'Note: the String( 80,".") is to push "Internet Explorer" string off the window
objIE.Document.title = sTitle
objIE.MenuBar = False
objIE.ToolBar = False
objIE.AddressBar = false
objIE.Resizable = False
objIE.StatusBar = False
objIE.Width = 250
objIE.Height = 280
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width ) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
WScript.Sleep 200
Loop
' Insert the HTML code to prompt for user input
objIE.Document.body.innerHTML = "<div align=""center"">" & vbcrlf _
& "<p><input type=""hidden"" id=""OK"" name=""OK"" value=""0"">" _
& "<input type=""submit"" value="" Limited User "" onClick=""VBScript:OK.value=1""></p>" _
& "<input type=""submit"" value="" Standard User "" onClick=""VBScript:OK.value=2""></p>" _
& "<input type=""submit"" value="" Power User "" onClick=""VBScript:OK.value=4""></p>" _
& "<input type=""submit"" value="" Admin User "" onClick=""VBScript:OK.value=8""></p>" _
& "<p><input type=""hidden"" id=""Cancel"" name=""Cancel"" value=""0"">" _
& "<input type=""submit"" id=""CancelButton"" value="" Cancel "" onClick=""VBScript:Cancel.value=-1""></p></div>"
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on Cancel button
objIE.Document.all.CancelButton.focus
'CAVEAT: If user click red X to close IE window instead of click cancel, an error will occur.
' Error trapping Is Not doable For some reason
On Error Resume Next
Do While objIE.Document.all.OK.value = 0 and objIE.Document.all.Cancel.value = 0
WScript.Sleep 200
iErrorNum=Err.Number
If iErrorNum <> 0 Then 'user clicked red X (or alt-F4) to close IE window
IEButtons = 0
objIE.Quit
Set objIE = Nothing
Exit Function
End if
Loop
On Error Goto 0
objIE.Visible = False
' Read the user input from the dialog window
IEButtons = objIE.Document.all.OK.value
' Close and release the object
objIE.Quit
Set objIE = Nothing
End Function
Sample VBScript Code:
' Save this code as IEButtonsDemo.vbs
WScript.Echo IEButtons( )
Sample Batch Code:
FOR /F %%A IN ('CSCRIPT //NoLogo IEButtonsDemo.vbs') DO SET ButtonChoice=%%~A
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both WScript.Sleep lines)
Summarized:Works in all Windows versions with Internet Explorer 4 or later, remove both WScript.Sleep lines to use in HTAs.
Ok, so you wrote your script, tested it on your own computer, maybe even on multiple computers, and everything seems to work fine.
Does that mean your script is ready to be distributed?
Would I ask if it were? 😉
No, we are not done yet.
A final screening is necessary to find out the minimum WSH version required to run the script.
Browse through your script and for each command you used, look up the WSH version required in MSDN's VBScript Version Information tables (JScript Version Information is available too).
The WSH version required for a particular command can be found in the page's second table.
Note:
Note:Besides using the MSDN links above, you can also use the WSH documentation in .chm format
Write down any required WSH version greater than 1.0.
The highest/latest version you wrote down is the minimum WSH version required to run your script.
Now check the VBScript Version Information page's first table to see if the minimum WSH version requirement is met by all client computers you had in mind...
In case you aren't sure about the client computers, you can make your script itself perform a check, using:
intMajorVerion = 0 + CInt( Mid( WScript.Version, 1, InStr( WScript.Version, "." ) - 1 ) )
intMinorVerion = 0 + CInt( Mid( WScript.Version, InStr( WScript.Version, "." ) + 1 ) )
intCheckVersion = 1000 * intMajorVerion + intMinorVerion
If intCheckVersion < 5005 Then
WScript.Echo "Sorry, this script requires WSH 5.5 or later"
WScript.Quit intCheckVersion
End If
Note:
Note:Yes, this check is safe, all commands and functions used were available in the very first WSH version
Some environment variables are actually the result of two variables being merged.
The environment variable 
Take a look at the image on the right, a fragment of a screenshot of XML Notepad's "XSL Output" window with our XML file loaded (or open the XML file in a plain text editor).
What we see is an opening tag 
Microsoft's Visual Studio 2010 Express Edition installer is an example of a great looking HTA.
HTAEdit (now seamlessly integrated in VBSEdit)
On this page, I intend to show some of the pitfalls I encountered in building HTAs, and some solutions or work-arounds.
My preferred tool for developing HTAs is VBSEdit.
It used to come with a separate program HTAEdit in a single package, but recently these programs have been merged, and the new VBSEdit now handles HTAs too.
VBSEdit comes with a built-in debugger, but debugging an HTA is much harder then debugging VBScript code, so I usually write and test VBScript code in VBSEdit, and when ready, use it in an HTA's subroutines.
HTAs aren't restricted to HTML and VBScript, you can use JScript and JavaScript without the need to install anything, and PerlScript if you install Perl.
Note:When using multiple scripting languages in a single HTA, all event handlers (e.g. 
For this demo, we will create an HTA that accepts a number as input, and then checks if it is a prime number.
Yes, if you are new to HTAs, the following code might look rather overwhelming.
Don't worry, I will explain most of it.
And you don't have to retype the code, it can be downloaded here.
And if you aren't convinced yet, check the properties of the demo project screenshot 
The error message points out the exact line where the error occurred.
Compatibility Mode (enabled meta tag in line 4)
Now the error message points to the line calling the subroutine that contains the error!
This gets even worse when nesting subroutines...
The work-around for this limitation is to temporarily disable compatibility mode until all VBScript code has been debugged.
Unfortunately, after enabling compatibility mode, you still have to debug all code once more, to test for compatibility issues...
This HTA does not demand elevated privileges, though they are still recommended.
Unless you started the HTA with the optional 
Return to the main screen by clicking the "Cancel" button or pressing the "Esc" key.
Back in the main screen, use any of the "Details" buttons to display more details for the selected hardware category.
If the 
Usage:
Open the Basic Software Inventory tool by doubleclicking the file software.hta.
Fill in the name or IP address of a remote computer in the "Computer" field at the top of the screen.
Or you can use the "Paste" button at the right of this field to paste the computer name from the clipboard.
Or just leave the "Computer" field empty and use the default: the local computer.
If you only want a limited inventory, use the filter fields.
Filling in "Microsoft" in the "Vendor" field will limit the installed software list to Microsoft software only, filling in "Office" in the "Name" field will limit the list to software packages that have the word "Office" in their name.
The "Name" and "Vendor" filters are case insensitive.
The "Installed Date" field requires a date in YYYYMMDD format, between 19800101 and today, and will limit the output to software installed on that date or later.
The filtering uses an "AND" function, i.e. all filters settings must apply for a software package to match.
Leave a filter field empty if you don't want to filter for its property.
Click the "Go" button to start the inventory.
This may take a couple of seconds or sometimes even minutes.
The "Reset" button clears all fields, so the software will be ready for the next try.
If you want to save the results displayed, you can use the "Copy" button to copy the results to the clipboard in tab delimited format.
Open Notepad or any plain text editor, paste the contents from the clipboard and save the file as a *.csv file.
Open this CSV file in your spreadsheet program or append it (without header) to an existing CSV file for future reference.
Hover your mouse pointer over any field or button to display a short help text in a tooltip.
Though simple text editors have served me well both in building my web pages and writing my batch files, I have completely switched to dedicated editors/IDEs for writing VBScript and PowerShell scripts.
Syntax highlighting does help eliminate a lot of debugging time, but what I like even better is "
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both 
SAFRCFileDlg.FileOpen
VBScript Code:
Set objDialog = CreateObject( "SAFRCFileDlg.FileOpen" )
' Note: The dialog will be opened without any file name or
' type filter, and in the "current" directory, e.g. as
' remembered from the last "SAFRCFileDlg.FileOpen" or
' "SAFRCFileDlg.FileSave" dialog!
If objDialog.OpenFileOpenDlg Then
WScript.Echo "objDialog.FileName = " & objDialog.FileName
End If
Requirements:
Windows version:Windows XP, Server 2003
Network:N/A
Client software:N/A
Script Engine:any
Summarized:Works in all Windows XP versions and in Server 2003.
Doesn't work in Windows 95, 98, ME, NT 4, 2000 or 7, not sure about Vista.
InternetExplorer.Application
VBScript Code:
Option Explicit
WScript.Echo "Selected file: " & ChooseFile( )
Function ChooseFile( )
' Select File dialog based on a script by Mayayana
' Known issues:
' * Tree view always opens Desktop folder
' * In Win7/IE8 only the file NAME is returned correctly, the path returned will always be C:\fakepath\
' * If a shortcut to a file is selected, the name of that FILE will be returned, not the shortcut's
On Error Resume Next
Dim objIE, strSelected
ChooseFile = ""
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.visible = False
objIE.Navigate( "about:blank" )
Do Until objIE.ReadyState = 4
Loop
objIE.Document.Write "<HTML><BODY><INPUT ID=""FileSelect"" NAME=""FileSelect"" TYPE=""file""><BODY></HTML>"
With objIE.Document.all.FileSelect
.focus
.click
strSelected = .value
End With
objIE.Quit
Set objIE = Nothing
ChooseFile = strSelected
End Function
Requirements:
Windows version:any
Network:N/A
Client software:Internet Explorer
Script Engine:any
Summarized:Works in all Windows versions.
WScript.Shell.Exec MSHTA
VBScript Code:
Option Explicit
Dim strFile
strFile = SelectFile( )
If strFile = "" Then
WScript.Echo "No file selected."
Else
WScript.Echo """" & strFile & """"
End If
Function SelectFile( )
' File Browser via HTA
' Author: Rudi Degrande, modifications by Denis St-Pierre and Rob van der Woude
' Features: Works in Windows Vista and up (Should also work in XP).
' Fairly fast.
' All native code/controls (No 3rd party DLL/ XP DLL).
' Caveats: Cannot define default starting folder.
' Uses last folder used with MSHTA.EXE stored in Binary in [HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32].
' Dialog title says "Choose file to upload".
' Source: https://social.technet.microsoft.com/Forums/scriptcenter/en-US/a3b358e8-15ae-4ba3-bca5-ec349df65ef6/windows7-vbscript-open-file-dialog-box-fakepath?forum=ITCG
Dim objExec, strMSHTA, wshShell
SelectFile = ""
' For use in HTAs as well as "plain" VBScript:
strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
& "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
& ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
' For use in "plain" VBScript only:
' strMSHTA = "mshta.exe ""about:<input type=file id=FILE>" _
' & "<script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
' & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>"""
Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( strMSHTA )
SelectFile = objExec.StdOut.ReadLine( )
Set objExec = Nothing
Set wshShell = Nothing
End Function
Requirements:
Windows version:Windows XP and later versions
Network:N/A
Client software:MSHTA.EXE (native in Windows)
Script Engine:any
Summarized:Works in Windows XP, Vista, Windows 7, Windows 8, Windows 8.1.
Requirements:
Windows version:Windows XP Professional or later (will work in earlier Windows versions too, but the dialog will not be centered on screen)
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT, remove both 
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both 
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both 
Requirements:
Windows version:any
Network:any
Client software:Internet Explorer 4 or later
Script Engine:WSH (CSCRIPT and WSCRIPT)
(to use in HTAs, remove both