Scripts

Archive for Scripts

Enable RDP Access

Quick script to enable RDP sessions on a computer

Taken from

1
2
3
4
5
6
7
8
9
10
Const ENABLE_CONNECTIONS = 1
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
 
Set colItems = objWMIService.ExecQuery("Select * from Win32_TerminalServiceSetting")
 
For Each objItem in colItems
    errResult = objItem.SetAllowTSConnections(ENABLE_CONNECTIONS)
Next

Posted in: Scripts, Technical

Leave a Comment (1) →

Silently Uninstall Software

Here is a handy script I found to uninstall software as an automated task.
This will be a lot better when GFI implement a feature to run a script once off.

I have modified it to not be case sensitive and also to match contains.
This means if you run /Program:adobe reader it will match anything that contains adobe reader in the title.

Make sure you test the uninstall codes 1st as not every program uses MSI’s to install.
Here is an example how to use it:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
'------------------------------------------------------------------------------ 
' magic_uninstall.vbs 
'------------------------------------------------------------------------------ 
' generic uninstaller script to uninstall applications based on the Add/Remove 
' Programs DisplayName and UninstallString properties 
'------------------------------------------------------------------------------ 
' Author: David M. Dolan 
' Created: 4/19/2005 
' Modified: 21/03/2012 (Info@Screwloose.com.au) 
'------------------------------------------------------------------------------ 
' Use this script for whatever you want -- I'm stating that there is no warranty 
' and that I'm not responsible for any damage you do with it. 
'------------------------------------------------------------------------------ 
' designed for use with MSI's but it should work on any other program that 
' specifies and uninstall string -- but you have to miff out the /Options 
' (" " works) 
'------------------------------------------------------------------------------ 

 
'On error resume next 

'------------------------------------------------------------------------------ 
' constants 
'------------------------------------------------------------------------------ 
Const HKEY_LOCAL_MACHINE = &H80000002 
Const KeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall" 
 
'modify this if you want to, I default mine for MSIs, and if you're silly enough 
' not to pass your own options and accidentally uninstall something, I want 
' the dialog to pop up telling you what you just foobarred 
Const defaultOptions = "/qb+" 
'------------------------------------------------------------------------------ 

'------------------------------------------------------------------------------ 
' read the command line paramters, and bomb out if there is a problem 
'------------------------------------------------------------------------------ 
progToRemove = WScript.Arguments.Named("Program") 
 
MSIOptions = WScript.Arguments.Named("Options") 
If MSIOptions = "" Then 
 MSIOptions = defaultOptions 
End If 
 
 
'------------------------------------------------------------------------------ 
' Main Program 
'------------------------------------------------------------------------------ 
If progToRemove = "" Then 
 usage 
Else 
 
 SeekAndDestroy 
 
End If 
WScript.Quit(0) 
 
'------------------------------------------------------------------------------ 
Sub usage 
 '------------------------------------------------------------------------------ 
 WScript.Echo "usage: magic_uninstall.vbs /Program:<DisplayNameString> /Options:<commandlineopts>" 
 WScript.Echo " ex: magic_uninstall.vbs /Program:""Orca"" /Options:""/qb-""" 
 WScript.Quit(1) 
End Sub 
'------------------------------------------------------------------------------ 
Sub SeekAndDestroy 
 '------------------------------------------------------------------------------ 
 
 Set locator = CreateObject("WbemScripting.SWbemLocator") 
 Set oWMI = locator.ConnectServer(".","root/default") 
 
 
 Set objReg = oWMI.Get("StdRegProv") 
 
 lRC = objReg.EnumKey (HKEY_LOCAL_MACHINE, KeyPath, arrSubKeys) 
 
 
 'ok, so we're at the install key, loop through the sub keys... 
 For Each Subkey In arrSubKeys 
 
 'look at the next key 
 newKeyPath = KeyPath & "\" & SubKey 
 
 'get all of the values and store them in two arrays -- value names in arrEntryNames 
 '    -- value Types in to arrValueTypes 
 objReg.EnumValues HKEY_LOCAL_MACHINE,_ 
 newKeyPath,arrEntryNames,arrValueTypes 
 
 'make sure we have an array, then grok it 
 If IsArray(arrEntryNames) Then 
 
 uninstallable = "f" 
 
 'loop through the entry names and keep the ones we're looking for 
 For i = 0 To UBound(arrValueTypes) 
 entryName = arrEntryNames(i) 
 
 Select Case entryName 
 
 Case "DisplayName" 
 
 'ok, display name, so what's the value? put it into sName 
 objReg.GetStringValue HKEY_LOCAL_MACHINE, _ 
 newKeyPath, entryName, sName 
 
 Case "DisplayVersion" 
 'ok, displayVersion, so store it into sVers 
 
 objReg.GetStringValue HKEY_LOCAL_MACHINE, _ 
 newKeyPath, entryName, sVers 
 
 Case "UninstallString" 
 objReg.GetStringValue HKEY_LOCAL_MACHINE, _ 
 newKeyPath, entryName, sUninstall 
 uninstallable = "t" 
 End Select 
 
 Next '-- value 
 
 If sName <> "" And uninstallable = "t" Then 
 
 'ok so we know that we have a software name, and it's uninstallable, so 
 ' only now do we check to see if it's what we're looking for... 
 
 If InStr(LCase(sName), LCase(progToRemove)) <> 0 Then 
 
 'this is where the magic happens 
 Set oCmd = CreateObject("Wscript.Shell") 
 
 uninstallCommand = Replace(sUninstall, "/I", "/x") & " " & MSIOptions  
 commandLine = "%comspec% /c " & uninstallCommand  
 'wscript.echo commandLine 
 
 oCmd.Run commandLine, 0, True 
 wscript.Echo "UnInstalled " & sName & " Successfully!"
 WScript.Quit(0) ' haha we're done, quit digging in the registry now! 
 
 End If  
 End If 
 End If 
 
 sName = "" 
 sVers = "" 
 
 Next '-- subKey 
 wscript.Echo progToRemove & " Not Found."
End Sub

Posted in: Scripts, Technical

Leave a Comment (0) →

Silently Install Software

A common request in these threads is how to deploy software, so heres my take on it.
Allows you to download a file and run parameters to silently install it.
Once again, this will be more useful when GFI implements the ability to run a script once off.

As for what switches to Install the files you will need to find yourselves.
You can check out which has a lot of command switches for popular software.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
'------------------------------------------------------------------------------ 
' silent_install.vbs 
'------------------------------------------------------------------------------ 
' Script that will download and install software. 
'------------------------------------------------------------------------------
'Usage: silent_install.vbs /URL:<FileURL> /Execute:<InstallCommand> /SaveTo:<OptionalOutputFolder> /Overwrite:[True/False]
' 
'   URL: File To download
'   Execute: Command to install
'   (Optional) SaveTo: Folder to download File
'   (Optional) Overwrite: Overwrite file if already Exists
' 
' ex: silent_install /URL:"http://fs10.filehippo.com/5277/b168ef4247da470195bae799a4a9df0d/ccsetup316.exe" /Execute:"ccsetup316.exe /S"
'
'------------------------------------------------------------------------------ 
' Author: Jake Paternoster
' Created: 21/03/2012 (Info@Screwloose.com.au)
'------------------------------------------------------------------------------ 

strURL = WScript.Arguments.Named("URL")
strExecute = WScript.Arguments.Named("Execute")
strSaveTo = WScript.Arguments.Named("SaveTo")
If LCase(WScript.Arguments.Named("Overwrite")) = "true" Then blnOverwrite = True
 
If strURL = "" Or strExecute = "" Then
 usage
End If
 
If strSaveTo = "" Then
 strSaveTo = WScript.CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)
End If
 
' 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(strSaveTo) Then
 strFile = objFSO.BuildPath(strSaveTo, Mid(strURL, InStrRev(strURL, "/" ) + 1 ) )
ElseIf objFSO.FolderExists(Left(strSaveTo, InStrRev(strSaveTo, "\" ) - 1 ) ) Then
 strFile = strSaveTo
Else
 WScript.Echo "ERROR: Target folder not found."
 WScript.Quit(2)
End If
 
If blnOverwrite = "" Then
 blnOverwrite = False
End If
 
If objFSO.Fileexists(strFile) And blnOverwrite = False Then 
 WScript.Echo strFile & " Already Exists!"
 WScript.Echo "Exiting..."
 WScript.Quit(0)
ElseIf objFSO.Fileexists(strFile) And blnOverwrite = True Then
 WScript.Echo strFile & " Already Exists!"
 WScript.Echo "Forcing Overwrite..."
 objFSO.DeleteFile strFile
End If
 
WScript.Echo "Downloading " & strURL & " to " & strSaveTo
HTTPDownload strURL, strFile
 
Set oCmd = CreateObject("Wscript.Shell") 
 
commandLine = "%comspec% /c " & strSaveTo & "\" & strExecute 
WScript.Echo "Running " & commandLine
oCmd.Run commandLine, 0, True
WScript.Quit(0)
 
Sub usage 
 '------------------------------------------------------------------------------ 
 WScript.Echo "Usage: silent_install.vbs /URL:<FileURL> /Execute:<InstallCommand> /SaveTo:<OptionalOutputFolder> /Overwrite:[True/False]" 
 WScript.Echo " " 
 WScript.Echo "URL: File To download" 
 WScript.Echo "Execute: Command to install"
 WScript.Echo "(Optional) SaveTo: Folder to download File"
 WScript.Echo "(Optional) Overwrite: Overwrite file if already Exists"
 WScript.Echo " " 
 WScript.Echo " ex: silent_install /URL:""http://fs10.filehippo.com/5277/b168ef4247da470195bae799a4a9df0d/ccsetup316.exe"" /Execute:""ccsetup316.exe /S""" 
 WScript.Quit(1) 
End Sub 
 
Sub HTTPDownload(myURL, strFile)
 
 Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 
 objXMLHTTP.open "GET", myURL, false
 objXMLHTTP.send()
 
 If objXMLHTTP.Status = 200 Then
 Set objADOStream = CreateObject("ADODB.Stream")
 objADOStream.Open
 objADOStream.Type = 1 'adTypeBinary

 objADOStream.Write objXMLHTTP.ResponseBody
 objADOStream.Position = 0 'Set the stream position to the start

 objADOStream.SaveToFile strFile
 objADOStream.Close
 Set objADOStream = Nothing
 End if
 
 Set objXMLHTTP = Nothing
End Sub

Posted in: Scripts, Technical

Leave a Comment (0) →

WSUS Cleanup Script

Here is a handy little script that cleans up WSUS 3 Automatically

1
2
3
4
5
6
7
8
9
10
11
[reflection.assembly]::LoadWithPartialName("Microsoft.UpdateServices.Administration") | out-null 
 $wsus = [Microsoft.UpdateServices.Administration.AdminProxy]::GetUpdateServer(); 
 $cleanupScope = new-object Microsoft.UpdateServices.Administration.CleanupScope; 
 $cleanupScope.DeclineSupersededUpdates = $true 
 $cleanupScope.DeclineExpiredUpdates = $true 
 $cleanupScope.CleanupObsoleteUpdates = $true 
 $cleanupScope.CompressUpdates = $true 
 #$cleanupScope.CleanupObsoleteComputers = $true 
 $cleanupScope.CleanupUnneededContentFiles = $true 
 $cleanupManager = $wsus.GetCleanupManager(); 
 $cleanupManager.PerformCleanup($cleanupScope);

Posted in: Scripts, Technical

Leave a Comment (3) →

Extract Office Install Key (2000/XP/2003/2007/2010)

Here is a little script to get the office keys.
Should work for office 2000/XP/2003/2007/2010

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
Dim ScriptHelper
Set ScriptHelper = New ScriptHelperClass
 
ScriptHelper.RunMeWithCScript()
strComputer = ScriptHelper.Network.ComputerName
 
CONST HKEY_CLASSES_ROOT = &H80000000
CONST HKEY_CURRENT_USER = &H80000001
CONST HKEY_LOCAL_MACHINE = &H80000002
CONST HKEY_USERS = &H80000003
CONST KEY_QUERY_VALUE = 1
CONST KEY_SET_VALUE = 2
CONST SEARCH_KEY = "DigitalProductID"
 
Dim arrSubKeys(10,1)
Dim foundKeys
Dim iValues, arrDPID
 
foundKeys = Array()
iValues = Array()
 
'Windows
arrSubKeys(0,0) = "Windows PID Key:           "
arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
'Office 2010
arrSubKeys(1,0) = "Office 2010 PID Key:       "
arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\14.0\Registration"
arrSubKeys(2,0) = "Office 2010 PID Key:       "
arrSubKeys(2,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\14.0\Registration"
'Office 2007
arrSubKeys(3,0) = "Office 2007 PID Key:       "
arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
arrSubKeys(4,0) = "Office 2007 PID Key:       "
arrSubKeys(4,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\12.0\Registration"
'Office 2003
arrSubKeys(5,0) = "Office 2003 PID Key:       "
arrSubKeys(5,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
arrSubKeys(6,0) = "Office 2003 PID Key:       "
arrSubKeys(6,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\11.0\Registration"
'Office XP
arrSubKeys(7,0) = "Office XP PID Key:       "
arrSubKeys(7,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
arrSubKeys(8,0) = "Office XP PID Key:       "
arrSubKeys(8,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\10.0\Registration"
'Office 2000
arrSubKeys(9,0) = "Office 2000 PID Key:       "
arrSubKeys(9,1) = "SOFTWARE\Microsoft\Office\9.0\Registration"
arrSubKeys(10,0) = "Office 2000 PID Key:       "
arrSubKeys(10,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\9.0\Registration"
 
GetKeys()
 
Public Function GetKeys()
 
 For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
 ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
 
 If Not IsNull(arrDPIDBytes) Then
 Call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
 Else
 ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
 
 If Not IsNull(arrGUIDKeys) Then
 For Each GUIDKey In arrGUIDKeys
 ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
 
 If Not IsNull(arrDPIDBytes) Then
 Call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
 End If
 Next
 End If
 End If
 Next
 
End Function
 
 
 Public Function decodeKey(iValues, strProduct)
 
 Dim arrDPID
 arrDPID = Array()
 
 For i = 52 to 66
 ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
 arrDPID( UBound(arrDPID) ) = iValues(i)
 Next
 
 Dim arrChars
 arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")
 
 For i = 24 To 0 Step -1
 k = 0
 
 For j = 14 To 0 Step -1
 k = k * 256 Xor arrDPID(j)
 arrDPID(j) = Int(k / 24)
 k = k Mod 24
 Next
 
 strProductKey = arrChars(k) & strProductKey
 
 If i Mod 5 = 0 And i <> 0 Then
 strProductKey = "-" & strProductKey
 End If
 Next
 
 ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
 foundKeys( UBound(foundKeys) ) = strProductKey
 strKey = UBound(foundKeys)
 Wscript.Echo "     " & strProduct & "" & foundKeys(strKey)
 End Function
 
 
 
 
 
 
 
 
 
 '// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'//
'// ScriptHelperClass and EnvironmentClass are helper classes to simplify
'// script work. Declare and use globally throughout the script.
'//
'//     Example code:
'//
'//     Option Explicit
'//     Dim ScriptHelper
'//     Set ScriptHelper = New ScriptHelperClass
'//     ScriptHelper.RunMeWithCScript()
'//     ScriptHelper.ElevateThisScript()
'//     WScript.Echo "User profile : " & ScriptHelper.Environment.UserProfile
'//     WScript.Echo "Domain : " & ScriptHelper.Network.UserDomain
'//     ScriptHelper.CreateFolder "\\SERVER\Share\Folder\With\Path"
'//     ScriptHelper.FileSystem.FileExists("C:\command.com")
'//     ScriptHelper.Shell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
'//
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Class ScriptHelperClass
 
 Private objEnvironment
 Private objFileSystem
 Private objNetwork
 Private objShell
 Private objSWBemlocator
 Private objWMI
 Private objRegistry
 Private objSWbemDateTime
 
 Public Computer
 
 Public Property Get Environment
 If objEnvironment Is Nothing Then
 Set objEnvironment = New EnvironmentClass
 objEnvironment.Shell = Shell
 End If
 Set Environment = objEnvironment
 End Property
 
 Public Property Get FileSystem
 If objFileSystem Is Nothing Then Set objFileSystem = CreateObject("Scripting.FileSystemObject")
 Set FileSystem = objFileSystem
 End Property
 
 Public Property Get Network
 If objNetwork Is Nothing Then Set objNetwork = CreateObject("WScript.Network")
 Set Network = objNetwork
 End Property
 
 Public Property Get Shell
 If objShell Is Nothing Then Set objShell = CreateObject("WScript.Shell")
 Set Shell = objShell
 End Property
 
 Public Property Get WMI
 If objWMI Is Nothing Then
 On Error Resume Next
 Set objSWBemlocator = CreateObject("WbemScripting.SWbemLocator")
 Set objWMI = objSWBemlocator.ConnectServer(Computer, "root\CIMV2")
 objWMI.Security_.ImpersonationLevel = 3
 On Error Goto 0
 End If
 Set WMI = objWMI
 End Property
 
 Public Property Get Registry
 If objRegistry Is Nothing Then Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 Set Registry = objRegistry
 End Property
 
 Public Property Get SWbemDateTime
 If objSWbemDateTime Is Nothing Then Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
 Set SWbemDateTime = objSWbemDateTime
 End Property
 
 Private Sub Class_Initialize()
 Computer = "."
 Set objEnvironment = Nothing
 Set objFileSystem = Nothing
 Set objNetwork = Nothing
 Set objShell = Nothing
 Set objSWBemlocator = Nothing
 Set objWMI = Nothing
 Set objRegistry = Nothing
 Set objSWbemDateTime = Nothing
 End Sub
 
 Private Sub Class_Terminate
 Set objSWbemDateTime = Nothing
 Set objRegistry = Nothing
 Set objWMI = Nothing
 Set objSWBemlocator = Nothing
 Set objShell = Nothing
 Set objNetwork = Nothing
 Set objFileSystem = Nothing
 Set objEnvironment = Nothing
 End Sub
 
 Public Property Get ScriptPath()
 ScriptPath = FileSystem.GetFile(WScript.ScriptFullName).ParentFolder
 End Property
 
 Public Function GetCurrentUserSID()
 Dim intCount, colItems, objItem, strSID
 
 Set colItems = WMI.ExecQuery("SELECT * FROM Win32_UserAccount WHERE Name = '" & Network.Username & "' AND Domain = '" & Network.UserDomain & "'", , 48)
 
 intCount = 0
 For Each objItem In colItems
 strSID = Cstr(objItem.SID)
 intCount = intCount + 1
 Next
 
 If intCount > 0 Then
 GetCurrentUserSID = strSID
 Else
 GetCurrentUserSID = "NOTFOUND"
 End If
 End Function
 
 Public Sub CreateFolder(strFldPath)
 Dim fldArray, x, intStartIndex, blnUNC, strDestFold : strDestFold = ""
 
 If Left(strFldPath, 2) = "\\" Then
 blnUNC = True
 intStartIndex = 3 'Start at the first folder in UNC path
 Else
 blnUNC = False
 intStartIndex = 0
 End If
 
 fldArray = Split(strFldPath, "\") 'Split folders into array
 
 If fldArray(intStartIndex) = "" Then Exit Sub
 
 For x = intStartIndex To UBound(fldArray)
 
 If strDestFold = "" Then
 If blnUNC Then
 strDestFold = "\\" & fldArray(x-1) & "\" & fldArray(x) 'Prefix UNC with server and share
 Else
 strDestFold = fldArray(x)
 End If
 Else
 strDestFold = strDestFold & "\" & fldArray(x) 'Append each folder to end of path
 End If
 
 If Not FileSystem.FolderExists(strDestFold) Then FileSystem.CreateFolder(strDestFold)
 Next
 End Sub
 
 Public Sub DeleteFolder(strFldPath)
 If FileSystem.FolderExists(strFldPath) Then FileSystem.DeleteFolder strFldPath, True
 End Sub
 
 '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 '// Subroutine: RunMeWithCScript()
 '//
 '// Purpose:    Forces the currently running script to use Cscript.exe as the Script
 '//             engine.  If the script is already running with cscript.exe the sub exits
 '//             and continues the script.
 '//
 '//             Sub Attempts to call the script with its original arguments.  Arguments
 '//             that contain a space will be wrapped in double quotes when the script
 '//             calls itself again.  To verify your command string you can echo out the
 '//             scriptCommand variable.
 '//
 '// Usage:      Add a call to this sub (RunMeWithCscript) to the beggining of your script
 '//             to ensure that cscript.exe is used as the script engine.
 '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Public Sub RunMeWithCScript()
 
 Dim scriptEngine, engineFolder, Args, arg, scriptName, argString, scriptCommand
 
 scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
 engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
 argString = ""
 
 If scriptEngine = "WSCRIPT.EXE" Then
 Dim Shell : Set Shell = CreateObject("Wscript.Shell")
 Set Args = Wscript.Arguments
 
 For each arg in Args 'loop though argument array as a collection to rebuild argument string
 If instr(arg," ") > 0 Then arg = """" & arg & """" 'if the argument contains a space wrap it in double quotes
 argString = argString & " " & Arg
 Next
 
 'Create a persistent command prompt for the cscript output window and call the script with its original arguments
 scriptCommand = "cmd.exe /k " & engineFolder & "cscript.exe """ & Wscript.ScriptFullName & """" & argString
 
 Shell.Run scriptCommand,,False
 Wscript.Quit
 Else
 Exit Sub 'Already Running with Cscript Exit this Subroutine
 End If
 
 End Sub
 
 '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 '// Subroutine: ElevateThisScript()
 '//
 '// Purpose:    (Intended for Vista+)
 '//             Forces the currently running script to prompt for UAC elevation if it
 '//             detects that the current user credentials do not have administrative
 '//             privileges.
 '//
 '//             If run on Windows XP this script will cause the RunAs dialog to appear if
 '//             the user does not have administrative rights, giving the opportunity to
 '//             run as an administrator.
 '//
 '//             This Sub Attempts to call the script with its original arguments.
 '//             Arguments that contain a space will be wrapped in double quotes when the
 '//             script calls itself again.
 '//
 '// Usage:      Add a call to this sub (ElevateThisScript) to the beginning of your
 '//             script to ensure that the script gets an administrative token.
 '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Public Sub ElevateThisScript()
 
 Const HKEY_CLASSES_ROOT = &H80000000
 Const HKEY_CURRENT_USER = &H80000001
 Const HKEY_LOCAL_MACHINE = &H80000002
 Const HKEY_USERS = &H80000003
 const KEY_QUERY_VALUE = 1
 Const KEY_SET_VALUE = 2
 
 Dim scriptEngine, engineFolder, argString, arg, Args, scriptCommand, HasRequiredRegAccess
 Dim objShellApp : Set objShellApp = CreateObject("Shell.Application")
 
 scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
 engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
 argString = ""
 
 Set Args = Wscript.Arguments
 
 For each arg in Args 'loop though argument array as a collection to rebuild argument string
 If instr(arg," ") > 0 Then arg = """" & arg & """" 'if the argument contains a space wrap it in double quotes
 argString = argString & " " & Arg
 Next
 
 scriptCommand = engineFolder & scriptEngine
 
 Dim objReg, bHasAccessRight
 Set objReg=GetObject("winmgmts:"_
 & "{impersonationLevel=impersonate}!\\" &_
 Computer & "\root\default:StdRegProv")
 
 'Check for administrative registry access rights
 objReg.CheckAccess HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Control\CrashControl", _
 KEY_SET_VALUE, bHasAccessRight
 
 If bHasAccessRight = True Then
 
 HasRequiredRegAccess = True
 Exit Sub
 
 Else
 
 HasRequiredRegAccess = False
 objShellApp.ShellExecute scriptCommand, " """ & Wscript.ScriptFullName & """" & argString, "", "runas"
 WScript.Quit
 End If
 
 End Sub
 End Class
 
 Class EnvironmentClass
 Private objShell
 Private strLogonServer
 Private strProgramFiles
 Private strProgramFilesX86
 Private strUserProfile
 Private strWinDir
 
 Public Cache
 
 Public Property Let Shell(objParentShell)
 Set objShell = objParentShell
 End Property
 
 Public Property Get LogonServer
 If IsNull(strLogonServer) Or Cache = False Then strLogonServer = objShell.ExpandEnvironmentStrings("%LOGONSERVER%")
 LogonServer = strLogonServer
 End Property
 
 Public Property Get ProgramFiles
 If IsNull(strProgramFiles) Or Cache = False Then strProgramFiles = objShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
 ProgramFiles = strProgramFiles
 End Property
 
 Public Property Get ProgramFilesX86
 If IsNull(strProgramFilesX86) Or Cache = False Then strProgramFilesX86 = objShell.ExpandEnvironmentStrings("%PROGRAMFILES(x86)%")
 ProgramFilesX86 = strProgramFilesX86
 End Property
 
 Public Property Get UserProfile
 If IsNull(strUserProfile) Or Cache = False Then strUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
 UserProfile = strUserProfile
 End Property
 
 Public Property Get WinDir
 If IsNull(strWinDir) Or Cache = False Then strWinDir = objShell.ExpandEnvironmentStrings("%WINDIR%")
 WinDir = strWinDir
 End Property
 
 Private Sub Class_Initialize()
 Cache = True
 strLogonServer = Null
 strProgramFiles = Null
 strProgramFilesX86 = Null
 strUserProfile = Null
 strWinDir = Null
 End Sub
 End Class

Posted in: Scripts, Technical

Leave a Comment (1) →

Determine Office Edition Script

By request, here is a script to detect the installed edition of Office.
Currently only supports 2007 and 2010 but can be adapted easily enough.

This site was used as a reference – http://support.microsoft.com/kb/2186281

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Set objWord = CreateObject("Word.Application")
 
SelectCase objWord.Version
Case"12.0"
strYear = "2007"
Case"14.0"
strYear = "2010"
CaseElse
strYear = "Unsupported Version"
EndSelect
 
intRelease = Right(Left(objWord.ProductCode(),2), 1)
 
SelectCase intRelease
Case"0"
strRelease = "Pre Release"
Case"1"
strRelease = "Beta 1"
Case"2"
strRelease = "Beta 2"
Case"3"
strRelease = "RC 0"
Case"4"
strRelease = "RC 1"
Case"9"
strRelease = "RTM"
CaseElse
strRelease = "Unknown"
EndSelect
 
intType = Right(Left(objWord.ProductCode(),3),1)
 
SelectCase intType
Case"0"
strType = "Volume license"
Case"1"
strType = "Retail/OEM"
Case"2"
strType = "Trial"
Case Else
strType = "Unknown"
EndSelect
 
intProduct = Split(objWord.ProductCode(),"-")(1)
 
SelectCase intProduct
Case"0011"
strProduct = "Professional Plus"
Case"0012"
strProduct = "Standard"
Case"0013"
strProduct = "Basic"
Case"0014"
strProduct = "Prosessional"
Case"002F"
strProduct = "Home and Student"
Case"008B"
strProduct = "Office Small Business Basics"
Case Else
strProduct = "Unknown"
EndSelect
 
intArch = Split(objWord.ProductCode(),"-")(3)
 
SelectCase intArch
Case"1000"
strArch = "x64"
Case"0000"
strArch = "x86"
EndSelect
 
WScript.Echo "Microsoft Office " & strProduct & " " & strYear & " " & strArch & " [" & strType & "] " & strRelease
WScript.Echo "Product Code: " & objWord.ProductCode()
objWord.Quit

Posted in: Scripts, Technical

Leave a Comment (0) →
Page 4 of 4 1234