VBS Scripts

**SibTiger** · November 23, 2004

Thanks, Bulldog!!! Exactly what I was looking for.

Total time for answer to be posted: 6 hrs. I love this forum.

**BritishBulldog** · November 23, 2004

would have been quicker but i am in a different time zone, so when you posted i was in bed.

**durex** · November 23, 2004

Question about VBScripts and the RunOnceEx...

Ive noticed that if I create an unattended vbs script that runs an installer than simulates keystrokes with SendKey, the runonce seems to think the vbs script is complete as soon as the executable is launched and starts the next item even though the previous vbs script is still simulating the keystroke install...

anyone have this issue?

better yet.. anyone know how you can make runonceex know when a vbs is actually complete?

Thanks

**SibTiger** · December 6, 2004

Here's a little trick that is useful for unattended installs. (I know, you VBS pros will laugh at me for posting this. This is for other newbies like me.)

Situation: Program takes 20 seconds to install on a new computer, and a minute and a half on an old one. Not desirable to use "Sleep." While installing, the window "MyProg Installation" only has "Cancel" button. When it's finished, the button "Finish" appears. The following code sends ALT-F every second as long as "MyProg Installation" window exists. Alt-F has no effect while the program is installing, but when it's finished, ALT-F closes the final window.

Do while WshShell.AppActivate ("MyProg Installation")
    WshShell.SendKeys "%{F}"
    WScript.Sleep 1000
Loop

**BritishBulldog** · December 6, 2004

Well i think that is a good idea, never thought of that

I use that without the SendKeys, but that perfects it in certain circumstances.

**Nologic** · December 6, 2004

hmmm well in AutoIt window scans are normally done with a time of 250...much shorter than what your currently using...the amount of over head brought about by using a shorter sleep time between scans shouldn't be noticed on hardware that is remotely current.

**Cteckie** · January 2, 2006

This is a nice VBS for shutting down system restore on partitions, opposed to going through all the steps Microsoft requires. Only need to change the drive = line. Insure that you use the :\ after it... Hope everyone likes this one...

Set Args = wscript.Arguments

If Args.Count() > 0 Then

Drive = Args.item(0)

Else

Drive = "H:\"

End If

Set obj = GetObject("winmgmts:{impersonationLevel=impersonate}!root/default:SystemRestore")

If (obj.Disable(Drive)) = 0 Then

wscript.Echo "Success"

Else

wscript.Echo "Failed"

End If

**MHz** · January 3, 2006

I made a VBScript for CCleaner v1.26, just to pass some time.

Set WshShell = WScript.CreateObject ("WScript.Shell")

Run "CCleaner v1.26.exe"

WinWaitActive "Installer Language" ' Language Prompt
Send "{ENTER}"
WinWaitActive "CCleaner v1.26 Setup" ' Welcome
Send "{ENTER}" 
WinWaitActive "CCleaner v1.26 Setup" ' Licence Agreement
Send "{ENTER}" 
WinWaitActive "CCleaner v1.26 Setup" ' Choose Install Location
Send "{ENTER}" 
WinWaitActive "CCleaner v1.26 Setup" ' Install Options
Send " {DOWN 2} {DOWN} {DOWN} {ENTER}"
WinWaitActive "CCleaner v1.26 Setup" ' Installing
Sleep 3000
WinWaitActive "CCleaner v1.26 Setup" ' Completing
Send "{ENTER}"

Set WshShell = Nothing
WScript.Quit ' Exit

Sub Run(file)
	file = chr(34) & file & chr(34)
	WshShell.Run file
End Sub

Sub WinWaitActive(text)
	Do : WScript.Sleep 250 : Loop Until WshShell.AppActivate(text)
End Sub

Sub Send(text)
	WshShell.Sendkeys text
End Sub

Sub Sleep(amount)
	WScript.Sleep amount
End Sub

The length of the Sleep 3000 is crucial for success as the window titles are all the same (except for the 1st). This makes it differcult to monitor the installing window itself as for the same title also.

Edited January 3, 2006 by MHz

**gunsmokingman** · January 14, 2006

Here are 2 VBS script One for adding A User this also requires a password and user group.

The other is to delete a User account.

Notes This deletes the file comment out if you are not using SFX file

Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FileExists("MkLocalUserAccount.vbs") Then : Fso.DeleteFile("MkLocalUserAccount.vbs") : End If

Save As MkLocalUserAccount.vbs

Dim Act, GU, Group, Msg, NewU, objNetwork, PW, Q1, Q1a, Q2, Q2a, Q3, Q3a, S_5, V : S_5 = Space(5) : V = vbCrLf '''' VARIBLES
Set Act = CreateObject("Wscript.Shell") : Set objNetwork = CreateObject("Wscript.Network") '''' OBJECT FOR SCRIPT
strComputer = objNetwork.ComputerName : Set colAccounts = GetObject("WinNT://" & strComputer & "") '''' COMPUTER NAME
'''' ARRAY FOR TEXT MESSAGES
Msg = Array("User Has Cancel This Script","Is This Correct","Did You Want To Quit This Script?",_
"Did You Want To Redo The ","Yes To Re Do The ","No To Exit This Script","Redo or Quit")
Function ListGroups '''' MAKES THE LIST OF USER GROUPS
Set colGroups = GetObject("WinNT://" & strComputer & "") : colGroups.Filter = Array("group")
For Each objGroup In colGroups : GU = GU & V & objGroup.Name : Next
End Function
Function NewUser '''' ADD USER NAME
NewU = InputBox("Please Type In The New User Name","Add User",,5500,4800)
If NewU = "" Then : Act.Popup Msg(0),5, "User Canel",0 + 32 : End If
If NewU <> "" Then
Q1 = MsgBox(Msg(1) & " User Name" & V & S_5 & NewU, 4 + 32, "Confirm Name")
If Q1 = vbyes Then
PW_Add
ElseIf Q1 = vbno Then
Q1a = MsgBox (Msg(2) & V & Msg(3) & " User Name?" & V & S_5 & Msg(4) & " User Name" & V & S_5 & Msg(5),4 + 32,Msg(6))
If Q1a = vbyes Then : NewUser : End If
If Q1a = vbno Then : WScript.Quit : End If
End If
Exit Function
End If
End Function
Function PW_Add '''' ADD PASS WORD
PW = InputBox("Please Type In The Pass Word","Add Pass Word",,5500,4800)
If PW = "" Then : Act.Popup Msg(0),5, "User Canel",0 + 32 : End If
If PW <> "" Then
Q2 = MsgBox(Msg(1) & " Pass Word" & vbCrLf & S_5 & PW, 4 + 32, "Confirm Pass Word")
If Q2 = vbyes Then
AddGroup
ElseIf Q2 = vbno Then
Q2a = MsgBox(Msg(2) & V & Msg(3) & " Pass Word?" & V & S_5 & Msg(4) & " Pass Word" & V & S_5 & Msg(5), 4 + 32,Msg(6))
If Q2a = vbyes Then : PW_Add : End If
If Q2a = vbno Then : WScript.Quit : End If
End If
Exit Function
End If
End Function
Function AddGroup '''' ADD TO GROUP
ListGroups
Group = InputBox("Type In The Group For The User" & vbCrLf & GU,"Add Group",,5500,4800)
If Group= "" Then : Act.Popup Msg(0),5, "User Canel",0 + 32 : End If
If Group <> "" Then
Q3 = MsgBox(Msg(1) & " User Group" & vbCrLf & S_5 & Group, 4 + 32, "Confirm User Group")
If Q2 = vbyes Then
UserAdd
ElseIf Q3 = vbno Then
Q3a = MsgBox(Msg(2) & V & Msg(3) & " User Group?" & V & S_5 & Msg(4) & " User Group" & V & S_5 & Msg(5),4 + 32,Msg(6))
If Q3a = vbyes Then : AddGroup : End If
If Q3a = vbno Then : WScript.Quit : End If
End If
Exit Function
End If
End Function
Function UserAdd '''' WHERE ALL INPUT INFO GOES TO
Set objGroup = GetObject("WinNT://" & strComputer & "/" & Group & ",group")
Set objUser = colAccounts.Create("user", "" & NewU & "")
objUser.SetPassword "" & PW & ""
objUser.SetInfo
objGroup.Add(objUser.ADsPath)
End Function
NewUser '''' START THE SCRIPT
'''' CLEAN UP THE SCRIPT
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("MkLocalUserAccount.vbs") Then : Fso.DeleteFile("MkLocalUserAccount.vbs") : End If

Notes This deletes the file comment out if you are not using SFX file

Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FileExists("DeleteLocalUser.vbs") Then : Fso.DeleteFile("DeleteLocalUser.vbs") : End If

Save As DeleteLocalUser.vbs

Dim Comp, LUser, strComputer, strUser
Set objNetwork = CreateObject("Wscript.Network")
strComputer = objNetwork.ComputerName
Set colAccounts = GetObject("WinNT://" & strComputer & "")
colAccounts.Filter = Array("user")
For Each objUser In colAccounts '''' ARRAY TO LIST LOCAL USERS
LUser = LUser & vbCrLf & "User Name : " & objUser.Name
Next
strUser = InputBox(Space(7) & strComputer & vbCrLf & "Please Type In The User Name That You"_
& " Want To Delete From " & strComputer & vbCrLf & LUser ,"Delete User Name",,5500,4800)
If strUser = "" Then
CreateObject("Wscript.Shell").Popup "User Has Cancel", 15,"User Cancel", 0 + 48
End If
If strUser <> "" Then
Set Comp = GetObject("WinNT://" & strComputer & "")
Comp.Delete "user", strUser
End If
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("DeleteLocalUser.vbs") Then : Fso.DeleteFile("DeleteLocalUser.vbs") : End If

Here is a link to a HTA that I made that can add and remove User Accounts

ManageUserTool.exe

DeleteLocalUser.exe

MkLocalUserAccount.exe

Edited June 3, 2006 by gunsmokingman

**PROBLEMCHYLD** · May 30, 2006

Can a vbs script be made to make windows 98SE transparent

Edited May 30, 2006 by PROBLEMCHYLD

**gunsmokingman** · May 31, 2006

Here a VBS Script that cleans up the right context menu templates.

It removes create new briefcase, bmp, doc, ppt, PspImage

Notes

If you do not want to delete the VBS script then remove the below lines from

the script.

'/-> DELETES THE VBS FILE

Fso.DeleteFile("CleanUpContextMenu.vbs")

On Error Resume Next 
  Dim Act, DelReg, Fso, StrDel
  Set Act = CreateObject("WScript.Shell")
  Set Fso = CreateObject("Scripting.FileSystemObject")
'/-> ARRAY FOR WHAT TO GETS DELETED
  DelReg = Array( "HKCR\.bfc\ShellNew\Config\",_
				  "HKCR\.bfc\ShellNew\",_
				  "HKCR\.bmp\ShellNew\",_
				  "HKCR\.doc\Word.Document.6\ShellNew\",_
				  "HKCR\.doc\Word.Document.8\ShellNew\",_
				  "HKCR\.doc\WordDocument\ShellNew\",_
				  "HKCR\.doc\WordPad.Document.1\ShellNew\",_
				  "HKCR\.ppt\PowerPoint.Show.4\ShellNew\",_
				  "HKCR\.ppt\PowerPoint.Show.8\ShellNew\",_
				  "HKCR\.PspImage\PaintShopPro9.Image\ShellNew\")
'/-> LOOP THAT DELETES THE REG ENTRIES		   
   For Each StrDel In DelReg
	Act.RegDelete StrDel
   Next 
'/-> COMPLETED MESSAGE 
	Act.Popup "Completed Cleaning up the right click context menu", 4, "Clean Up Context menu", 0 + 32
'/-> DELETES THE VBS FILE
	Fso.DeleteFile("CleanUpContextMenu.vbs")

Here is a SFX file of the above code

CleanUpContextMenu.exe

Edited August 6, 2007 by gunsmokingman

**gunsmokingman** · June 3, 2006

Here is a VBS script that will intergrate Service Pack 2 and any updates it finds in ANY_HARD_DRIVE:\XPCD.

Function

1:\ It searches the local hard drives for either of these files

\XPCD\i386\ZONEOC.DL_

\XPCD\i386\WINNT32.EXE

2:\ When found it then intergrates SP2 then it moves SP2 to

\XP_Updates

3:\ It then updates any updates in \XPCD then moves them to

\XP_Updates

4:\ Makes a text files with a list of updates that got intergrated

Dim Act, Drv, Dtop, Fso, StrDrv, Ts, VBS  
  Dim collectFiles, FolderName, Ln1, objFolder, objFile
  Dim Archive, ChkFile1, ChkFile2, ChkFile3, ChkFolder1
  ChkFile1 = "\XPCD\i386\ZONEOC.DL_"
  ChkFile2 = "\XPCD\i386\WINNT32.EXE"
  ChkFile3 = "\XPCD\i386\svcpack.inf"
  ChkFolder1 = "\XPCD\i386\svcpack"
  Dim Cnt : Cnt = 0
  Ln1 = Space(3) & Chr(171) & " --------------- " & Chr(187)& vbCrLf 
  Set Act = CreateObject("Wscript.Shell")
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Dtop = Act.SpecialFolders("Desktop")
  VBS = Act.ExpandEnvironmentStrings("%SystemDrive%\IntergrateUpdates.vbs")
  Set Drv = Fso.Drives 
'/-> FIND THE XPCD 
  Function FindXPCD
   Set Ts = Fso.CreateTextFile(Dtop & "\IntergrateReport.txt")
	Ts.WriteLine Ln1 & Space(5) & "Start Time	  : " & Now() & vbCrLf &_
	Space(5) & "Computer Name   : " & Act.ExpandEnvironmentStrings("%ComputerName%") & vbCrLf &_
	Space(5) & "Windows Drive   : "  & Act.ExpandEnvironmentStrings("%SystemRoot%") & vbCrLf & Ln1 
   For Each StrDrv In Drv 
	If StrDrv.DriveType = 2 Then 
	 If Fso.FileExists(StrDrv & ChkFile1)  Or (StrDrv & ChkFile2) = True  Then 
	 If Fso.FolderExists(StrDrv & ChkFolder1) Then Fso.DeleteFolder(StrDrv & ChkFolder1) End If
	  Archive = StrDrv & "\XP_Updates"
	  If Fso.FileExists(StrDrv & Chkfile3) Then Fso.DeleteFile(StrDrv & Chkfile3) End If 
	   Ts.WriteLine Space(5) & "Found The XPCD -> " & StrDrv & "\XPCD" & vbCrLf & Ln1 
		Set objFolder = Fso.GetFolder(StrDrv & "\XPCD")
		 Set collectFiles = objFolder.Files
		  AddSP2
		  Exit For 
		 If Fso.FileExists(StrDrv & ChkFile1)  Or (StrDrv & ChkFile2) = False  Then 
		Ts.WriteLine Space(5) & "Cannot Find XPCD : Ending the script" & vbCrLf & Ln1 
	   End If 
	  End If
	 End If  
	Next 
   End Function 
'/-> CHECK FOR SERVICE PACK 2 ONLY THEN INTERGRATE SERVICE PACK 2 
   Function AddSP2
	 For Each objFile in collectFiles
	  If InStr(objFile.Name,"KB835935") Then 
	   If InStr(objFile.Name,"exe") Then
		 Ts.WriteLine Space(5) & "Intergrate SP2 -> " & objFile.Name & vbCrLf & Ln1	   
		 Intergrate : CopyArchive : AddUpdates
		Else 
		 Ts.WriteLine Space(5) & "Missing SP2	-> " & "Error : Cannot Complete The Script" & vbCrLf & Ln1
		Exit For
	   Exit Function 
	   End If
	  End If 
	Next
   End Function 
'/-> CHECK FOR UPDATES ONLY THEN INTERGRATES THEM 
   Function AddUpdates
	For Each objFile in collectFiles
	 If InStr(objFile.Name,"KB") Then
	  If InStr(objFile.Name,"exe") Then
	   If InStr(objFile.Name,"835935") Then '/-> MAKES SURE SERVICE PACK 2 DOES NOT GET DONE TWO TIMES
		On Error  Resume Next  
		Else  
		If Cnt < 9 Then 
		  Cnt = "0" & Cnt + 1
		  Ts.WriteLine Space(5) & Cnt & ":\This Update Was Added -> " & objFile.Path & vbCrLf & Ln1
		  Intergrate : CopyArchive
		 Else 
		  Cnt = Cnt + 1
		  Ts.WriteLine Space(5) & Cnt & ":\This Update Was Added -> " & objFile.Path & vbCrLf & Ln1
		  Intergrate : CopyArchive
		 End If 
		End If
		 Else
		 Ts.WriteLine Space(5) & "Missing Error  -> " & "There Was No Updates to be found" & vbCrLf & Ln1
		Exit For  
	   Exit Function		 
	  End If 
	 End If
	Next  
   End Function
'/-> INTERGRATE SP2 AND UPDATES
   Function Intergrate
	 Act.run (objFile.Path & " /passive /norestart /L /o -s:" & StrDrv & "\XPCD"),1,true
	Exit Function 
   End Function 
'/-> MOVES SP2 AND UPDATES AFTER THEY BEEN INTERGRATED
   Function CopyArchive
	 If Not Fso.FolderExists(Archive) Then Fso.CreateFolder(Archive & "\") End If 
	 Fso.CopyFile(objFile.Path), (Archive & "\"), True 
	 Fso.DeleteFile(objFile.Path)
	Exit Function 
   End Function 
   FindXPCD
	Ts.WriteLine Ln1 & Space(5) & "Finish Time	 : " & Now()
	Ts.WriteLine Space(5) & "User Name	   : " & Act.ExpandEnvironmentStrings("%UserName%") &_
	 vbCrLf & Ln1 
   Ts.Close
   Act.Run("Notepad.exe " & Dtop & "\IntergrateReport.txt"), 1, True 
   If Fso.FileExists(VBS) Then Fso.DeleteFile(VBS)

Edited September 18, 2007 by gunsmokingman

**Yezpahr** · January 9, 2007

Have you also tried the /? switch?

So you can see what switches ARE possible.

I may be out of line but, could I ask one of you knowledgable folks to do a .vbs script for an unattended install of Webshots Desktop and Webroot's Spysweeper?
I have tried the /s, /silent, /VERYSILENT, /R , /QB..................You name it, I've tried it.
I even tried .vbs scripts myself but failed miserably. (Probably due to the fact that I don't know what I'm doing. I just changed a couple of settings on Westi's Adaware 6 script to see if it would work)
Help?

**blahface** · January 30, 2007

Is this kinda like AutoIt?

Do you have to change the sleep waiting time???

Sign In

VBS Scripts

Recommended Posts

SibTiger

BritishBulldog

durex

SibTiger

BritishBulldog

Nologic

Cteckie

MHz

gunsmokingman

PROBLEMCHYLD

gunsmokingman

gunsmokingman

Yezpahr

blahface

Please sign in to comment

Recently Browsing 0 members

Activity

Browse