.: Miscellaneous Scripts
|
|
| |
Please select from the following vbscript examples:
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Using VBScript for CD Autorun
i found that starting a VBScript from an autorun.inf file caused an error so i used a batch file to start the vbscript.
Contents of Autorun.inf
[autorun]
OPEN=Autorun.bat
Contents of Autorun.bat
@ECHO off
start .\Autorun.vbs
exit
edit the file autorun.vbs as you see fit.
EventLogging
Set WshShl = WScript.CreateObject("WScript.Shell")
WshShl.LogEvent 0, "EventLogging.vbs - Beginning Script Execution."
Remove the OS Version Check from an MSI file
Description: create vbs file and drag the msi file onto the script file
Option Explicit
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Dim argNum, argCount:argCount = Wscript.Arguments.Count
If (argCount < 1) Then
Wscript.Echo "Please supply the name of the msi file to be modified."
Wscript.Quit 1
End If
' Scan arguments for valid SQL keyword and to determine if any update operations
Dim openMode : openMode = msiOpenDatabaseModeReadOnly
openMode = msiOpenDatabaseModeTransact
' Connect to Windows installer object
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
' Open database
Dim databasePath:databasePath = Wscript.Arguments(0)
Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
' Process SQL statements and delete the crap out of this installer!
Dim query, view, record, message, rowData, columnCount, delim, column
Set view = database.OpenView("Delete from LaunchCondition") : CheckError
view.Execute
wscript.echo "Launch Conditions Removed"
Set view = database.OpenView("Delete from InstallExecuteSequence where Action='OnCheckSilentInstall'")
view.Execute
wscript.echo "OnCheckSilentInstall step removed"
Set view = database.OpenView("Delete from Property where Property = 'ISSETUPDRIVEN'")
view.Execute
wscript.echo "Property ISSETUPDRIVEN removed"
Set view = database.OpenView("INSERT INTO Property (Property,Value) VALUES ('ISSETUPDRIVEN',1)")
view.Execute
wscript.echo "Property ISSETUPDRIVEN added"
database.Commit
Wscript.Quit 0
Sub CheckError
Dim message, errRec
If Err = 0 Then Exit Sub
message = Err.Source & " " & Hex(Err) & ": " & Err.Description
If Not installer Is Nothing Then
Set errRec = installer.LastErrorRecord
If Not errRec Is Nothing Then message = message & vbLf & errRec.FormatText
End If
Fail message
End Sub
Sub Fail(message)
Wscript.Echo message
Wscript.Quit 2
End Sub
Have the VBScript check to see if it is being run with CScript or WScript
Option Explicit
Dim Script, ScriptRun
Script = WScript.FullName
ScriptRun = lcase(mid(Script, InstrRev(Script, "\")+1))
' Main Procedure
If not Scriptrun = "cscript.exe" then
WScript.Echo "WScript"
Else
Wscript.Echo "CScript"
End IF
Convert a Hexidecimal Value to a Decimal Value
'HexToDec.vbs - Convert Hexadecimal value to Decimal value.
'© Bill James - bill@billsway.com - Rev 25 Oct, 2000
Option Explicit
Dim title, lf, HexVal, ErrMsg
title = "Hex to Dec Converter © Bill James"
lf = vbcrlf
GetInput()
Sub GetInput()
HexVal = UCase(InputBox(ErrMsg & "Enter a Hex value " & _
"to be converted to Decimal:", title))
ConvertHex()
End Sub
Sub ConvertHex()
Dim x, y, z, v
If HexVal = "" Then
WScript.Quit
Else
For x = 1 To Len(HexVal)
y = Mid(HexVal, ((Len(HexVal) - x) + 1), 1)
On Error Resume Next
v = CLng("&H" & y)
If Err.Number <> 0 Then
GetErrMsg()
Exit Sub
End If
On Error GoTo 0
z = z + (v * 16 ^ (x - 1))
Next
If Len(z) > 15 Then
MsgBox "Sorry, you exceeded my conversion capability with that one!" & _
lf & lf & vbtab & "(" & z & ")", 48, title
Else
HexVal = UCase(InputBox("Dec value for " & HexVal & " is:", title, z))
End If
End If
End Sub
Sub GetErrMsg()
ErrMsg = HexVal & " is an invalid Hex value." & lf & lf & _
"The only legal characters for a Hex number are " & lf & _
"0 1 2 3 4 5 6 7 8 9 A B C D E F" & lf & lf
GetInput()
End Sub
Web site contents © Copyright Alan Phipps 2006, All rights reserved.
Website templates |