Archive - May 2012

"To freely bloom - that is my definition of success." - Gerry Spence

Index

Disable XSS Filter Setting in IE9 - All Users
Create Bootable Thumb Drive from WIM
Change Computer Name to Service Tag
Deploy Google Bookmarks Win7/WinXP
Uninstall IE9
Return SID Windows 7
Configure BIOS Settings for MDT

Disable Hibernate - Enforce Always On
Retrieve Office 2007 Key
Retrieve Office 2010 Key
Retrieve Windows Keys
Robocopy Profiles When USMT Fails

Δ Thursday, May 31st, 2012

Δ Disable XSS Filter Setting in IE9 - All Users

How to disable a setting in IE9

[download resource files]

Demo

Uses WMI to return SID, and the SID gets added to a command string that applies the disabled
setting to each user registry hive.

on error resume next

'THIS CHANGES THE XSS FILTER SETTING IN IE 9 FROM ENABLED TO DISABLED
'WORKS ON ALL DOMAIN PROFILES ON COMPUTER

Set objShell = CreateObject("Wscript.Shell")

Const HKEY_LOCAL_MACHINE = &H80000002

'SETS CURRENT DIRECTORY TO VARIABLE
strCurrentDirectory = objShell.CurrentDirectory

'SETS COMPUTER NAME
strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objRegistry=GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
For Each objSubkey In arrSubkeys
 on error resume next
 strValueName = "ProfileImagePath"
 strSubPath = strKeyPath & "\" & objSubkey
 objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
 Const POPUP_TITLE = "User To SID Conversion"
 Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 
 Set objAccount = objWMIService.Get("Win32_SID.SID='" & objSubkey & "'")
 strUser = objAccount.AccountName
 'strDomain = objAccount.ReferencedDomainName'returns referenced domain

'DISPLAY PROFILE NAME & SID
 objSubkey = trim(objSubkey)'trims whitespace
 strUser = trim(strUser)'trims whitespace
 'msgbox "objSubkey: " & objSubkey'returns SID
 'msgbox strUser'returns username

'LOGIC TO DETERMINE IF REGISTRY ACCOUNT IS TO BE LOADED
if strUser = "SYSTEM" then strUser=""
if strUser = "LOCAL SERVICE" then strUser=""
if strUser = "NETWORK SERVICE" then strUser=""
if strUser = "ADMINISTRATOR" then strUser=""

if strUser <> "" then
on error resume next

REGEDIT1 = "%comspec% /c %windir%\system32\REG.exe ADD "& chr(34)&"HKEY_USERS\"&objSubkey&"\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1"&chr(34)&" /v "&chr(34)&"1409"&CHR(34)&" /d 3 /t REG_DWORD /f"
Err.Number = objShell.Run (REGEDIT1,0,True)

REGEDIT2 = "%comspec% /c %windir%\system32\REG.exe ADD "& chr(34)&"HKEY_USERS\"&objSubkey&"\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2"&chr(34)&" /v "&chr(34)&"1409"&CHR(34)&" /d 3 /t REG_DWORD /f"
Err.Number = objShell.Run (REGEDIT2,0,True)

REGEDIT3 = "%comspec% /c %windir%\system32\REG.exe ADD "& chr(34)&"HKEY_USERS\"&objSubkey&"\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"&chr(34)&" /v "&chr(34)&"1409"&CHR(34)&" /d 3 /t REG_DWORD /f"
Err.Number = objShell.Run (REGEDIT3,0,True)

end if

Δ [email me]

Δ Wednesday, May 30th, 2012

Δ Create Bootable Thumb Drive from WIM

How to create a bootable drive

[download resource files]

Uses diskpart.exe and xcopy.exe to create a bootable thumb/usb drive.

'  Program: CreateUSB.vbs  
 ' Description: This script creates a bootable USB thumb drive from a WIM file.  
 '              WinPE must be installed on the machine and its directory  
 '              specified in constant WinPELoc with no backslash after it. The  
 '              WIM files reside in the WinPELoc directory for which this script  
 '              reads from. A diskpart script must also be present in the WinPELOC  
 '              directory specifing the parameters for the thumb drive.  
 '              1) Partition and Format the USB Thumb Drive  
 '              2) Select the WIM file  
 '              3) Prompt to remove and reinsert the thumb drive  
 '              4) Copy the OS down to the thumb Drive and prompt when complete  
 '              5) Cleanup Global Variables  
 '*******************************************************************************  
 Option Explicit

REM Define Global Constants  
 CONST WinPELoc = "c:\winpe"

REM Define Global Variables  
 DIM strImageName : Set strImageName = Nothing

PartitionDisk()  
 SelectImage()  
 CopyWIM()  
 PromptThumbRemoval()  
 CopyOS()  
 Complete()  
 GlobalVariableCleanup()

'*******************************************************************************  
 '*******************************************************************************

Sub PartitionDisk()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables  
      DIM PartDisk : PartDisk = "diskpart.exe /s" & Chr(32) & WinPELoc & "\usbpartscript.txt"

oShell.Run PartDisk, 1, True

REM Cleanup Local Variables  
      Set oShell   = Nothing  
      Set PartDisk = Nothing

End Sub

'*******************************************************************************

Sub SelectImage()

REM Define Local Constants  
      CONST ForAppending = 2  
      CONST strComputer  = "."

REM Define Local Variables  
      DIM Count      : Count = 1  
      DIM FileName   : Set FileName   = Nothing  
      DIM FileVerify : Set FileVerify  = Nothing  
      DIM objFile    : Set objFile    = Nothing  
      DIM strList    : strList = "Select an Image File:"

REM Define Objects  
      DIM objFSO        : Set objFSO = CreateObject("Scripting.FileSystemObject")  
      DIM objWMIService : Set objWMIService = GetObject("winmgmts:" _  
                          & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  
      DIM colFileList   : Set colFileList = objWMIService.ExecQuery _  
                          ("ASSOCIATORS OF {Win32_Directory.Name=" & Chr(39) & WinPELoc & Chr(39) & "} Where " _  
                          & "ResultClass = CIM_DataFile")

REM Get List of WIM files  
      For Each objFile In colFileList  
           FileVerify = Right(objFile.Name, 3)  
           If FileVerify = "wim" then  
                FileName = Len(objFile.Name)  
                FileName = FileName - 9  
                FileName = Right(objFile.Name, FileName)  
                strList = strList & vbCrLf & Count & " - " & FileName  
                Count = Count + 1  
           End If  
           Set FileVerify = Nothing  
      Next  
      REM Select WIM File  
      strImageName = InputBox(strList, "Image")  
      strImageName = CInt(strImageName)  
      REM ReInitialize Variables  
      Count = 1  
      Set FileName = Nothing  
      Set FileVerify = Nothing  
      Set objFile = Nothing  
      REM Get File Name  
      For Each objFile In colFileList  
           FileVerify = Right(objFile.Name, 3)  
           If FileVerify = "wim" then  
                FileName = Len(objFile.Name)  
                FileName = FileName - 9  
                FileName = Right(objFile.Name, FileName)  
                If Count = strImageName then  
                     strImageName = FileName  
                End If  
                Count = Count + 1  
           End If  
           Set FileVerify = Nothing  
      Next

REM Cleanup Local Variables  
      Set colFileList   = Nothing  
      Set Count         = Nothing  
      Set FileName      = Nothing  
      Set FileVerify    = Nothing  
      Set objFile       = Nothing  
      Set objFSO        = Nothing  
      Set objWMIService = Nothing  
      Set strList       = Nothing

End Sub

'*******************************************************************************

Sub CopyWIM()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables  
      DIM CopyFile : CopyFile = "xcopy" & Chr(32) & WinPELoc & "\" & strImageName & Chr(32) & WinPELoc & "\iso\sources\boot.wim /y"

oShell.Run CopyFile, 1, True

REM Cleanup Local Variables  
      Set CopyFile = Nothing  
      Set oShell   = Nothing

End Sub

'*******************************************************************************

Sub PromptThumbRemoval()

MsgBox("Remove and Re-enter USB Thumb Drive. Press any key to continue")

End Sub

'*******************************************************************************

Sub CopyOS()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables  
      DIM CopyFiles : Set CopyFiles = Nothing

CopyFiles = "xcopy" & Chr(32) & WinPELoc & "\iso\*.* /s /e /f e:\"  
      oShell.Run CopyFiles, 1, True  
      CopyFiles = "xcopy" & Chr(32) & WinPELoc & "\iso\*.* /s /e /f f:\"  
      oShell.Run CopyFiles, 1, True

REM Cleanup Local Variables  
      Set oShell    = Nothing  
      Set CopyFiles = Nothing

End Sub

'*******************************************************************************

Sub Complete()

MsgBox("USB Image is Complete")

End Sub

'*******************************************************************************

Sub GlobalVariableCleanup()

Set strImageName = Nothing

End Sub

Δ [email me]

Δ Thursday, May 24th, 2012

Δ Change Computer Name to Service Tag

How to change computer name to service tag

[download resource files]

Use WMI to retrieve the serial and objComputer.Rename to rename the computer.

Δ [email me]

Δ Tuesday, May 22nd, 2012

Δ Deploy Google Bookmarks Win7/WinXP

How to deploy Google bookmarks

[download resource files]

So this was my problem: I was tasked with deploying Google bookmarks to the enterprise. After much research, I found out that GP was good for many things - except bookmarks. I created this to cycle through the machines profiles, copying a bookmark file containing all the specified bookmarks. Worked like a charm.

on error resume next

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Const HKEY_LOCAL_MACHINE = &H80000002
Const OverwriteExisting = TRUE
Source1 = "bookmarks"

'SETS CURRENT DIRECTORY TO VARIABLE
strCurrentDirectory = objShell.CurrentDirectory

on error resume next

'Target is dynamic is assigned below

strComputer = "."

'DISPLAY PROFILE NAME & SID
 objSubkey = trim(objSubkey)'trims whitespace
 strUser = trim(strUser)'trims whitespace
 'msgbox "objSubkey: " & objSubkey'returns SID
 'msgbox strUser'returns username

if strUser <> "" then
on error resume next
'yes, you could shorten this
objShell.Run "%comspec% /c md " & chr(34) & "C:\users\" & strUser & "\AppData\Local\Google\" & chr(34),0,true
Wscript.Sleep 1000
objShell.Run "%comspec% /c md " & chr(34) & "C:\users\" & strUser & "\AppData\Local\Google\Chrome\" & chr(34),0,true
Wscript.Sleep 1000
objShell.Run "%comspec% /c md " & chr(34) & "C:\users\" & strUser & "\AppData\Local\Google\Chrome\User Data\" & chr(34),0,true
Wscript.Sleep 1000
objShell.Run "%comspec% /c md " & chr(34) & "C:\users\" & strUser & "\AppData\Local\Google\Chrome\User Data\Default\" & chr(34),0,true
Wscript.Sleep 1000
Target1 = "C:\users\" & strUser & "\AppData\Local\Google\Chrome\User Data\Default\"
Target2 = "C:\users\" & strUser & "\AppData\Local\Google\Chrome\User Data\"

On error resume next
objFSO.CopyFile chr(34) & strCurrentDirectory & "\bookmarks" & chr(34), Target1, OverwriteExisting
objFSO.CopyFile Source1, Target1, OverwriteExisting

end if

Δ [email me]

Δ Monday, May 21st, 2012

Δ Uninstall IE9

How to uninstall IE9

[download resource files]

Uses the pkgmgr.exe to uninstall IE9. This assumes that there was an upgrade done from IE8 to IE9.

On Error Resume Next
Const TraceWindow = 0
Const HKEY_LOCAL_MACHINE = &H80000002
Dim LogFile :LogFile = "c:\temp\IE9_uninstall.log"
strComputer = "."

Set objshell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set regex = new regexp
regex.IgnoreCase = true
regex.Pattern = "Microsoft-Windows-InternetExplorer-[a-zA-Z-]+~[a-zA-Z0-9~-]+9.[a-zA-Z0-9.~]+.mum"

objshell.Run "%comspec% /c md c:\temp",0,true
objshell.Run "%comspec% /c taskkill.exe /f /im iexplore.exe",0,true

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Internet Explorer"
strEntryName = "Version"

objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEntryName,strValue

If CINT(LEFT(strValue,instr(strValue,".")-1)) >= 9 Then
LogMessage ("Uninstalling Internet Explorer version: " & strValue)
Set oEnv = objshell.Environment("PROCESS")
sysFolder = oEnv("WINDIR")

Set rootFolder = objFSO.GetFolder(sysFolder & "\servicing\Packages")
Set colFiles = rootFolder.Files
For each file in colFiles
If (regex.test(file.name)) Then
LogMessage ("Removing " & "pkgmgr /up:" & Replace(file.name,".mum","") & " /quiet /norestart")
objshell.Run "pkgmgr /up:" & Replace(file.name,".mum","") & " /quiet /norestart",TraceWindow,True
End If
Next

If err.number <> 0 Then
LogMessage "Uninstall Error " " & err.description & ":" & err.number
Else
LogMessage ("Uninstalling Complete, Reboot Required")
End If
Else
LogMessage ("Found Internet Explorer version: " & strValue & " Exiting Script, No Action Taken")
End If

objshell.Run "FORFILES /P %WINDIR%\servicing\Packages /M Microsoft-Windows-InternetExplorer-*9.*.mum /c ""cmd /c echo Uninstalling package @fname && start /w pkgmgr /up:@fname /quiet /norestart""",9,true

Set objShell = nothing
Set objFSO = nothing

Sub LogMessage(msg)
on error resume next
Dim oLogFile
If IsEmpty(oLogFile) Then Set oLogFile = objFSO.OpenTextFile(LogFile, 8, True)
oLogFile.writeline Now & " " & msg
End Sub

Δ [email me]

Δ Monday, May 14th, 2012

Δ Return SID Windows 7

How to return SID

[download resource files]

Demo

Uses the WMI to return the SID. Very useful to accomplish many tasks where you need to
access all or specific user profiles.

on error resume next

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Const HKEY_LOCAL_MACHINE = &H80000002
Const OverwriteExisting = TRUE

'SETS CURRENT DIRECTORY TO VARIABLE
strCurrentDirectory = objShell.CurrentDirectory

on error resume next
'LSource1 = strCurrentDirectory & "\preferences"
'LSource2 = strCurrentDirectory & "\First Run"

'Target is dynamic is assigned below

strComputer = "."

'DISPLAY PROFILE NAME & SID
 objSubkey = trim(objSubkey)'trims whitespace
 strUser = trim(strUser)'trims whitespace
 'msgbox "objSubkey: " & objSubkey'returns SID
 'msgbox strUser'returns username

if strUser <> "" then
on error resume next
msgbox objSubkey

end if

Δ [email me]

Δ Friday, May 11th, 2012

Δ Configure BIOS Settings for MDT

How to configure the BIOS settings

[download resource files]

This will do the following to the MDT/SCCM generated WIM files: ' inject the Dell CCTK, inject the
HAPI drivers, and modify the ' unattend.xml file. Uses the dism.exe command.

'*******************************************************************************   
 '      Program:   
 '      Version:   
 '  Description: This will do the following to the MDT/SCCM generated WIM files:   
 '        inject the Dell CCTK, inject the HAPI drivers, and modify the   
 '        unattend.xml file.   
 '
 ' Requirements: Microsoft WAIK, location for the locally stored WinPE files   
 '        (WinPEDIR Global Variable), MDT Server (I have 2 servers   
 '        MDT01 and MDT02), designation of architecture, and Dell CCTK.   
 '        NOTE: This script has been created to automate the update process   
 '        on a Windows 7 64-bit PC, therefor the directory locations of   
 '        the CCTK files will differ for an x86 machine.   
 '*******************************************************************************   
 Option Explicit  
 
 REM Define Constants   
 CONST TempFolder  = "c:\temp\"   
 CONST LogFolderName = "CCTK"   
 CONST MDT01     = "MDT01"   
 CONST MDT02     = "MDT02"   
 CONST WinPEDIR   = "c:\winpe\"   
 CONST x64      = "x64"   
 CONST x86      = "x86"

REM Define Global Variables   
 DIM LogFolder   : LogFolder    = TempFolder & LogFolderName & "\"   
 DIM RelativePath : Set RelativePath = Nothing

DefineRelativePath()   
 REM Refresh Local WIM Files from MDT Servers   
   DeleteLocalWIMFiles()   
   CopyWIMFiles( MDT01 )   
   RenameWIMFiles( MDT01 )   
   CopyWIMFiles( MDT02 )   
   RenameWIMFiles( MDT02 )   
 REM Process Local x86 file for MDT01   
   MountWIM MDT01,x86   
   AddWMI(x86)   
   CopyHAPIFiles( x86 )   
   CopyCCTKFiles( x86 )   
   EditUnattend( x86 )   
   DismountWIM()   
 REM Process Local x64 File for MDT01   
   MountWIM MDT01,x64   
   AddWMI(x64)   
   CopyHAPIFiles( x64 )   
   CopyCCTKFiles( x64 )   
   EditUnattend( x64 )   
   DismountWIM()   
 REM Process Local x86 File for MDT02   
   MountWIM MDT02,x86   
   AddWMI(x86)   
   CopyHAPIFiles( x86 )   
   CopyCCTKFiles( x86 )   
   EditUnattend( x86 )   
   DismountWIM()   
 REM Process Local x64 File for MDT02   
   MountWIM MDT02,x64   
   AddWMI(x64)   
   CopyHAPIFiles( x64 )   
   CopyCCTKFiles( x64 )   
   EditUnattend( x64 )   
   DismountWIM()   
 Complete()   
 GlobalVariableCleanup()

'*******************************************************************************   
 '*******************************************************************************

Sub DefineRelativePath()

REM Get File Name with full relative path   
   RelativePath = WScript.ScriptFullName   
   REM Remove file name, leaving relative path only   
   RelativePath = Left(RelativePath, InStrRev(RelativePath, "\"))

End Sub

'*******************************************************************************

Sub DeleteLocalWIMFiles()

REM Define Local Objects   
   DIM FSO    : Set FSO    = CreateObject("Scripting.FileSystemObject")   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM Parameters : Parameters = "/F /Q"   
   DIM sCMD_1 : sCMD_1 = "%COMSPEC% /c del " & RelativePath & "*MDT01.wim"   
   DIM sCMD_2 : sCMD_2 = "%COMSPEC% /c del " & RelativePath & "*MDT02.wim"   
   DIM sCMD_3 : sCMD_3 = "%COMSPEC% /c del " & RelativePath & "generic*.wim"

oShell.Run sCMD_1 & Parameters, 1, True   
   oShell.Run sCMD_2 & Parameters, 1, True   
   oShell.Run sCMD_3 & Parameters, 1, True

REM Cleanup Local Variables   
   Set sCMD_1     = Nothing   
   Set sCMD_2     = Nothing   
   Set sCMD_3     = Nothing   
   Set FSO        = Nothing   
   Set oShell     = Nothing   
   Set Parameters = Nothing

End Sub

'*******************************************************************************

Function CopyWIMFiles(Server)

REM Define Local Objects   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM Source      : Source      = "\\" & Server & "\DeploymentShare\Boot"   
   DIM Destination : Destination = "c:\winpe"   
   DIM Parameters  : Parameters  = "*.wim /eta /r:1 /w:0"   
   DIM Command01   : Command01   = "robocopy" & Chr(32) & Source & Chr(32) & Destination & Chr(32) & Parameters

oShell.Run Command01, 1, True  
 
   REM Cleanup Local Variables   
   Set Command01   = Nothing   
   Set Destination = Nothing   
   Set oShell      = Nothing   
   Set Parameters  = Nothing   
   Set Source      = Nothing

End Function

'*******************************************************************************

Function RenameWIMFiles(Server)

REM Define Local Objects   
   DIM FSO  : Set FSO  = CreateObject("Scripting.FileSystemObject")

REM Define Local Variables   
   DIM Source_x86 : Source_x86 = RelativePath & "LiteTouchPE_x86.wim"   
   DIM Source_x64 : Source_x64 = RelativePath & "LiteTouchPE_x64.wim"   
   DIM Dest_x86  : Dest_x86  = RelativePath & "LiteTouchPE_x86_" & Server & ".wim"   
   DIM Dest_x64  : Dest_x64  = RelativePath & "LiteTouchPE_x64_" & Server & ".wim"

If FSO.FileExists(Source_x86) then   
     If NOT FSO.FileExists(Dest_x86) then   
       FSO.MoveFile Source_x86, Dest_x86   
     End If   
   End If   
   If FSO.FileExists(Source_x64) then   
     If NOT FSO.FileExists(Dest_x64) then   
       FSO.MoveFile Source_x64, Dest_x64   
     End If   
   End If

REM Cleanup Local Variables   
   Set Dest_x86   = Nothing   
   Set Dest_x64   = Nothing   
   Set FSO        = Nothing   
   Set Source_x86 = Nothing   
   Set Source_x64 = Nothing

End Function

'*******************************************************************************

Function MountWIM(Server,Architecture)

REM Define Local Objects   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM MountDIR  : MountDIR  = RelativePath & "Mount"   
   DIM WIMFile   : WIMFile  = RelativePath & "LiteTouchPE_" & Architecture & "_" & Server & ".wim"   
   DIM Command01 : Command01 = "DISM /Mount-Wim /WIMFile:" & WIMFile & Chr(32) & "/Index:1 /MountDIR:" & MountDIR
   
   oShell.Run Command01, 1, True

REM Cleanup Local Variables   
   Set Command01 = Nothing   
   Set MountDIR  = Nothing   
   Set oShell    = Nothing   
   Set WIMFile   = Nothing 
  
 End Function

'*******************************************************************************

Sub AddWMI(Architecture)

REM Define Local Objects   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM Image           : Image       = "/Image:" & RelativePath & "Mount"   
   DIM AddPackage      : AddPackage   = "/Add-Package"   
   DIM PackagePath     : Set PackagePath = Nothing   
   DIM PackagePath_x86 : PackagePath_x86 = "/PackagePath:" & Chr(34) &_   
                       "C:\Program Files\Windows AIK\Tools\PETools\x86\WinPE_FPs\winpe-wmi.cab" & Chr(34)   
   DIM PackagePath_x64 : PackagePath_x64 = "/PackagePath:" & Chr(34) &_   
                       "C:\Program Files\Windows AIK\Tools\PETools\amd64\WinPE_FPs\winpe-wmi.cab" & Chr(34)   
   DIM Command01       : Set Command01  = Nothing

If Architecture = "x86" Then   
     PackagePath = PackagePath_x86   
   Else   
     PackagePath = PackagePath_x64   
   End If   
   Command01 = "DISM" & Chr(32) & Image & Chr(32) & AddPackage & Chr(32) & PackagePath   
   oShell.Run Command01, 1, True

REM Cleanup Local Variables   
   Set AddPackage      = Nothing   
   Set Command01       = Nothing   
   Set Image           = Nothing   
   Set oShell          = Nothing   
   Set PackagePath     = Nothing   
   Set PackagePath_x86 = Nothing   
   Set PackagePath_x64 = Nothing

End Sub

'*******************************************************************************

Sub CreateFolderStructure(Architecture)

REM Define Local Objects   
   DIM FSO    : Set FSO    = CreateObject("Scripting.FileSystemObject")   
   DIM oShell : Set oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM Command01     : Set Command01 = Nothing   
   DIM Directory     : Set Directory = Nothing   
   DIM Directory_x86 : Directory_x86 = RelativePath & "Mount\CCTK\x86\HAPI"   
   DIM Directory_x64 : Directory_x64 = RelativePath & "Mount\CCTK\x86_64\HAPI"

If Architecture = "x86" Then   
     Directory = Directory_x86   
   Else   
     Directory = Directory_x64   
   End If   
   If NOT FSO.FolderExists(Directory) then   
     FSO.CreateFolder(Directory)   
   End If

REM Cleanup Local Variables   
   Set Command01     = Nothing   
   Set Directory     = Nothing   
   Set Directory_x86 = Nothing   
   Set Directory_x64 = Nothing   
   Set FSO           = Nothing   
   Set oShell        = Nothing

End Sub

'*******************************************************************************

Sub CopyHAPIFiles(Architecture)

REM Define Local Objects   
   DIM FSO    : Set FSO    = CreateObject("Scripting.FileSystemObject")   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM sCMD_1     : Set sCMD_1 = Nothing   
   DIM sCMD_2     : Set sCMD_2 = Nothing   
   DIM Source     : Set Source = Nothing   
   DIM Source_x86 : Source_x86 = "C:\Program Files (x86)\Dell\CCTK\X86\HAPI\*.*"   
   DIM Source_x64 : Source_x64 = "C:\Program Files (x86)\Dell\CCTK\X86_64\HAPI\*.*"   
   DIM Dest       : Set Dest   = Nothing   
   DIM Dest_x86   : Dest_x86   = RelativePath & "mount\CCTK\x86\HAPI"   
   DIM Dest_x64   : Dest_x64   = RelativePath & "mount\CCTK\x86_64\HAPI"

If Architecture = "x86" Then   
     Source = Source_x86   
     Dest  = Dest_x86   
   Else   
     Source = Source_x64   
     Dest  = Dest_x64   
   End If   
   sCMD_1 = "%COMSPEC% /c mkdir " & Dest   
   If NOT FSO.FolderExists(Dest) then   
     oShell.Run sCMD_1, 1, True   
   End If   
   sCMD_2 = "%COMSPEC% /c copy " & Chr(34) & Source & Chr(34) & Chr(32) & Dest & Chr(32) & "/V /Y"   
 '  If FSO.FolderExists(Source) then   
     oShell.Run sCMD_2, 1, True   
 '  End If

REM Cleanup Local Variables   
   Set Dest       = Nothing   
   Set Dest_x86   = Nothing   
   Set Dest_x64   = Nothing   
   Set FSO        = Nothing   
   Set oShell     = Nothing   
   Set sCMD_1     = Nothing   
   Set sCMD_2     = Nothing   
   Set Source     = Nothing   
   Set Source_x86 = Nothing   
   Set Source_x64 = Nothing 
  
 End Sub

'*******************************************************************************

Sub CopyCCTKFiles(Architecture)

REM Define Local Objects   
   DIM FSO : Set FSO = CreateObject("Scripting.FileSystemObject")

REM Define Local Variables   
   DIM CCTKFile   : CCTKFile  = "cctk.exe"   
   DIM MXMLFile   : MXMLFile  = "mxml1.dll"   
   DIM INIFile    : INIFile  = "multiplatform.ini"   
   DIM PCIFile    : PCIFile  = "pci.ids"   
   DIM NetSource  : NetSource = "\\global.gsp\data\clients\na_clients\Dell\BIOS\"   
   DIM Source     : Set Source = Nothing   
   DIM Source_x86 : Source_x86 = "C:\Program Files (x86)\Dell\CCTK\X86\"   
   DIM Source_x64 : Source_x64 = "C:\Program Files (x86)\Dell\CCTK\X86_64\"   
   DIM Dest       : Set Dest  = Nothing   
   DIM Dest_x86   : Dest_x86  = RelativePath & "mount\CCTK\x86\"   
   DIM Dest_x64   : Dest_x64  = RelativePath & "mount\CCTK\x86_64\"

If Architecture = "x86" Then   
     Source = Source_x86   
     Dest  = Dest_x86   
   Else   
     Source = Source_x64   
     Dest  = Dest_x64   
   End If   
   If NOT FSO.FolderExists(Dest) then   
     FSO.CreateFolder(Dest)   
   End If   
   If FSO.FolderExists(Source) then   
     FSO.CopyFile Source & CCTKFile, Dest, 1   
   End If   
   If FSO.FolderExists(Source) then   
     FSO.CopyFile NetSource & INIFile, Dest, 1   
   End If   
   If FSO.FolderExists(Source) then   
     FSO.CopyFile Source & PCIFile, Dest, 1   
   End If   
   If FSO.FolderExists(Source) then   
     FSO.CopyFile Source & MXMLFile, Dest, 1   
   End If

REM Cleanup Local Variables   
   Set CCTKFile   = Nothing   
   Set INIFile    = Nothing   
   Set MXMLFile   = Nothing   
   Set PCIFile    = Nothing   
   Set Dest       = Nothing   
   Set Dest_x86   = Nothing   
   Set Dest_x64   = Nothing   
   Set FSO        = Nothing   
   Set Source     = Nothing   
   Set Source_x86 = Nothing   
   Set Source_x64 = Nothing

End Sub

'*******************************************************************************

Sub EditUnattend(Architecture)

REM Define Local Constants   
 CONST ForReading = 1   
 CONST ForWriting = 2

REM Define Local Objects   
 DIM File    : File    = "C:\winpe\mount\unattend.xml"   
 DIM strOld1 : strOld1 = "<Order>1</Order>"   
 DIM strNew1 : strNew1 = "<Order>4</Order>"   
 DIM strOld2 : strOld2 = "<RunSynchronous>"   
 DIM strNew2 : strNew2 = "<RunSynchronous>" & Chr(10) &_   
                     "<RunSynchronousCommand wcm:action=" & Chr(34) & "add" & Chr(34) & ">" & Chr(10) &_   
                     "<Description>Map BIOS Drive</Description>" & Chr(10) &_   
                     "<Order>1</Order>" & Chr(10) &_   
                     "<Path>net use \\global.gsp\data\clients\na_clients\dell\bios /user:{username/password}</Path>" & Chr(10) &_   
                     "</RunSynchronousCommand>" & Chr(10) &_   
                     "<RunSynchronousCommand wcm:action=" & Chr(34) & "add" & Chr(34) & ">" & Chr(10) &_   
                     "<Description>Initiate HAPI</Description>" & Chr(10) &_   
                     "<Order>2</Order>" & Chr(10) &_   
                     "<Path>X:\CCTK\x86_64\HAPI\hapint -i -k C-C-T-K -p X:\CCTK\x86_64\HAPI\</Path>" & Chr(10) &_   
                     "</RunSynchronousCommand>" & Chr(10) &_   
                     "<RunSynchronousCommand wcm:action=" & Chr(34) & "add" & Chr(34) & ">" & Chr(10) &_   
                     "<Description>Set BIOS Settings</Description>" & Chr(10) &_   
                     "<Order>3</Order>" & Chr(10) &_   
                     "<Path>x:\CCTK\x86_64\cctk.exe -i \\global.gsp\data\clients\na_clients\Dell\BIOS\multiplatform.ini</Path>" & Chr(10) &_   
                     "</RunSynchronousCommand>"   
 DIM objFSO        : Set objFSO    = CreateObject("Scripting.FileSystemObject")   
 DIM objFile       : Set objFile    = objFSO.getFile(File)   
 DIM objTextStream : Set objTextStream = objFile.OpenAsTextStream(ForReading)   
 DIM strInclude    : strInclude    = objTextStream.ReadAll

objTextStream.Close   
 Set objTextStream = Nothing   
 If InStr(strInclude,strOld1) > 0 Then   
   strInclude = Replace(strInclude,strOld1,strNew1)   
   Set objTextStream = objFile.OpenAsTextStream(ForWriting)   
   objTextStream.Write strInclude   
   objTextSTream.Close   
   Set objTextStream = Nothing   
 End If   
 If InStr(strInclude,strOld2) > 0 Then   
   strInclude = Replace(strInclude,strOld2,strNew2)   
   Set objTextStream = objFile.OpenAsTextStream(ForWriting)   
   objTextStream.Write strInclude   
   objTextSTream.Close   
   Set objTextStream = Nothing   
 End If  
 
 REM Cleanup Local Variables   
 Set File          = Nothing   
 Set objFile       = Nothing   
 Set objFSO        = Nothing   
 Set objTextStream = Nothing   
 Set strInclude    = Nothing   
 Set strNew1       = Nothing   
 Set strNew2       = Nothing   
 Set strOld1       = Nothing   
 Set strOld2       = Nothing

End Sub

'*******************************************************************************

Sub DismountWIM()

REM Define Local Objects   
   DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables   
   DIM MountDIR  : MountDIR  = RelativePath & "Mount"   
   DIM Command01 : Command01 = "DISM /Unmount-WIM /MountDir:" & MountDIR & Chr(32) & "/commit"

oShell.Run Command01, 1, True

REM Cleanup Local Variables   
   Set Command01 = Nothing   
   Set MountDIR  = Nothing   
   Set oShell    = Nothing

End Sub

'*******************************************************************************

Sub Complete()

MsgBox "Process Complete"

End Sub

'*******************************************************************************

Sub GlobalVariableCleanup()

Set LogFolder    = Nothing   
   Set RelativePath = Nothing
 End Sub

Δ [email me]

Δ Thursday, May 10th, 2012

Δ Disable Hibernate - Enforce Always On

How to maximize the power config

[download resource files]

Uses the power management powercfg.exe to maximize power settings.

'======================================================
' VBScript Source File
' COMMENT: This script will disable hibernate and set strict power settings
'			to ensure the system does not power off, hibernate or go into 
'			standby. This will work on all client operating systems 2000 
'			and newer.
'======================================================
 
 
On Error Resume Next
 
' Basic checks to see if this will even work and exit if not
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("c:\windows\system32\powercfg.exe") = False Then wscript.quit
If Err Then wscript.quit
 
' Call client os function to determine if it is a server or not
' This script needs modification to run against servers as it is 
' meant only for client operating systems.
Dim strOS : strOS = isClientOperatingSystem()
If strOS = False Then wscript.quit
 
Dim objWshShell : Set objWshShell = WScript.CreateObject("WScript.Shell")
 
' Disable hibernate if it is enabled
If objFSO.FileExists("c:\hiberfil.sys") Then
	If InStr(strOS,"XP") > 0 Then
		objWshShell.Run "powercfg /hibernate off", 0, True
	Else
		objWshShell.Run "powercfg -h off", 0, True
	End If
End If
 
' Turn off standby and monitor timeout (while plugged in)
If InStr(strOS,"XP") > 0 Or InStr(strOS,"2000") > 0 Then
	' XP and 2000 specific settings
	objWshShell.Run "powercfg /X " & chr(34) & "home/office desk" & chr(34) & _
					" /standby-timeout-ac 0",0,True
	objWshShell.Run "powercfg /X " & chr(34) & "home/office desk" & chr(34) & _
					" /monitor-timeout-ac 0",0,True
	objWshShell.Run "powercfg /setactive " & chr(34) & "home/office desk" & chr(34),0,True
Else
	' Vista, 7
	objWshShell.Run "powercfg -s 381B4222-F694-41F0-9685-FF5BB260DF2E",0,True
	objWshShell.Run "powercfg -change -standby-timeout-ac 0",0,True
	objWshShell.Run "powercfg -change -monitor-timeout-ac 0",0,True
End If
 
' Clean house
Set objWshShell = Nothing
Set objFSO = Nothing
 
 
Private Function isClientOperatingSystem()
	' Purpose: This will return true only if the system can be verified as a client OS
	' Usage: strOS = isClientOperatingSystem()
	'		 If strOS = False Then wscript.quit
	Dim objWMIService, objItem, colItems
	Dim strOS
 
	On Error Resume Next
		' WMI Connection to the object in the CIM namespace
		Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
		' WMI Query to the Win32_OperatingSystem
		Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
 
		' For Each... In Loop (Next at the very end)
		For Each objItem in colItems
			strOS = objItem.Caption
		Next
 
		' Below might be a better way but I want to make sure it is one of the operating systems that has been tested, YMMV
		' InStr(strOS,"Server") > 0 Then isClientOperatingSystem = False
		If InStr(strOS,"Windows 7") <> 0 Or InStr(strOS,"XP") <> 0 Or InStr(strOS,"2000 Professional") <> 0 Or InStr(strOS,"Vista") <> 0 Then
			isClientOperatingSystem = strOS
		Else
			isClientOperatingSystem = False
		End If
 
		If Err.Number <> 0 Then isClientOperatingSystem = False
 
		strOS = Empty
		Set objItem = Nothing
		Set colItems = Nothing
		Set objWMIService = Nothing
	On Error GoTo 0
End Function

Δ [email me]

Δ Wednesday, May 9th, 2012

Δ Retrieve Office 2007 Key

How to retrieve office keys

[download resource files]

Demo

Decodes the Microsoft key from the registry.

'  ############################################################## 
 '  # VBScript to find the DigitalProductID for your             # 
 '  # Microsoft Office 2007 Installation and decode              # 
 '  # it to retrieve your Product Key                            # 
 '  ############################################################## 
 ' 
 ' <--------------- Open Registry Key and populate binary data into an array --------------------------> 
 ' 
 on error resume next
 
 const HKEY_LOCAL_MACHINE = &H80000002  
 strKeyPath = "SOFTWARE\Microsoft\Office\14.0\Registration\{90140000-003B-0000-0000-0000000FF1CE}" 
 strValueName = "DigitalProductId" 
 strComputer = "." 
 dim iValues() 
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _  
       strComputer & "\root\default:StdRegProv") 
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues 
 Dim arrDPID 
 arrDPID = Array() 
 For i = 52 to 66 
 ReDim Preserve arrDPID( UBound(arrDPID) + 1 ) 
 arrDPID( UBound(arrDPID) ) = iValues(i) 
 Next 
 ' <--------------- Create an array to hold the valid characters for a microsoft Product Key --------------------------> 
 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") 
  
 ' <--------------- The clever bit !!! (Decrypt the base24 encoded binary data) --------------------------> 
 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 
 Next 
 strFinalKey = strProductKey 
 ' 
 ' <--------------- This part of the script displays a completed/summary message -----------------> 
 ' 
 Set wshShell=CreateObject("wscript.shell") 
 strPopupMsg = "Your Microsoft Office 2007 Product Key is:" & vbNewLine & vbNewLine & strFinalKey 
 strPopupTitle = "Product Key" 
 wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation 
 wshShell.run "%comspec% /c echo Office 2007: " &  strProductKey  & ">>key.txt",0,true
 WScript.Quit

Δ [email me]

Δ Monday, May 7th, 2012

Δ Retrieve Office 2010 Key

How to retrieve Office keys

[download resource files]

Decodes the Microsoft key from the registry.

'  ############################################################## 
 '  # VBScript to find the DigitalProductID for your             # 
 '  # Microsoft Office 2010 Installation and decode              # 
 '  # it to retrieve your Product Key                            # 
 '  ############################################################## 
 ' 
 ' <--------------- Open Registry Key and populate binary data into an array --------------------------> 
 ' 
 on error resume next
 
 const HKEY_LOCAL_MACHINE = &H80000002  
 strKeyPath = "SOFTWARE\Microsoft\Office\14.0\Registration\{90140000-003B-0000-0000-0000000FF1CE}" 
 strValueName = "DigitalProductId" 
 strComputer = "." 
 dim iValues() 
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _  
       strComputer & "\root\default:StdRegProv") 
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues 
 Dim arrDPID 
 arrDPID = Array() 
 For i = 52 to 66 
 ReDim Preserve arrDPID( UBound(arrDPID) + 1 ) 
 arrDPID( UBound(arrDPID) ) = iValues(i) 
 Next 
 ' <--------------- Create an array to hold the valid characters for a microsoft Product Key --------------------------> 
 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") 
  
 ' <--------------- The clever bit !!! (Decrypt the base24 encoded binary data) --------------------------> 
 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 
 Next 
 strFinalKey = strProductKey 
 ' 
 ' <--------------- This part of the script displays a completed/summary message -----------------> 
 ' 
 Set wshShell=CreateObject("wscript.shell") 
 strPopupMsg = "Your Microsoft Office 2007 Product Key is:" & vbNewLine & vbNewLine & strFinalKey 
 strPopupTitle = "Product Key" 
 wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation 
 wshShell.run "%comspec% /c echo Office 2007: " &  strProductKey  & ">>key.txt",0,true
 WScript.Quit

Δ [email me]

Δ Friday, May 4th, 2012

Δ Retrieve Windows Keys

How to retrieve Windows keys

[download resource files]

Decodes the Microsoft key from the registry.

' Find Product Activation Key on Remote Machine

strComputer = "."

Dim Digits (24)
Digits (0) = "B" : Digits (1) = "C": Digits (2) = "D": Digits (3) = "F":
Digits (4) = "G": Digits (5) = "H": Digits (6) = "J": Digits (7) = "K":
Digits (8) = "M": Digits (9) = "P": Digits (10) = "Q": Digits (11) = "R":
Digits (12) = "T": Digits (13) = "V": Digits (14) = "W": Digits (15) = "X":
Digits (16) = "Y": Digits (17) = "2": Digits (18) = "3": Digits (19) = "4":
Digits (20) = "6" : Digits (21) = "7" : Digits (22) = "8": Digits (23) = "9"

Dim HexBuf (100), HexDigitalPID (15)
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")

objReg.GetBinaryValue &H80000002, "SOFTWARE\Microsoft\Windows NT" _
& "\CurrentVersion\", "DigitalProductId", HexBuf

' Extract Relevant Section of Digital Product ID
StartOffset = 52 : EndOffset =67
For i = StartOffset to EndOffset
HexDigitalPID (i-StartOffset) = HexBuf(i)
next

' Convert Encoded Product ID to Activation Key
dLen = 29 : sLen = 15
KEYSTRING =""
for i=dLen-1 to 0 step -1
if ((i + 1) mod 6) = 0 then
KEYSTRING = KEYSTRING & "-"
else
HN = 0
For N = (sLen -1) to 0 step -1
Value = ( (HN *2^8 ) Or HexDigitalPID (N))
HexDigitalPID (N) = Value \ 24
HN = (Value mod 24)
next
KEYSTRING = KEYSTRING & Digits(HN)
end if
next
KEYSTRING2 = StrReverse (KEYSTRING)
WScript.Echo KEYSTRING2
 Set wshShell=CreateObject("wscript.shell") 
 wshShell.run "%comspec% /c echo Windows: " &  KEYSTRING2  & ">>key.txt",0,true

Δ [email me]

Δ Tuesday, May 1st, 2012

Δ Robocopy Profiles When USMT Fails

How to copy profiles when usmt fails

[download resource files]

This script will robocopy a profile from one machine to another. ' It is intended to be used when the USMT
fails. The user must ' logon to the new machine before running this script. If this is ' executed before a
profile is created, a new profile will be ' created <profile>.xxx and the user will not see any of the ' copied
data. ' There needs to be a %NetworkPath%\PSTools directory containing ' PSTools. Robocopy needs to be
present in the PSTools directory. ' PSTools allows for the robocopy to run locally on the old ' machine,
thereby conserving bandwidth if it is at a remote ' location.

'*******************************************************************************  
 '
 '    Modified:  
 ' Description: This script will robocopy a profile from one machine to another.  
 '                 It is intended to be used when the USMT fails. The user must  
 '                 logon to the new machine before running this script. If this is  
 '                 executed before a profile is created, a new profile will be  
 '                 created <profile>.xxx and the user will not see any of the   
 '                 copied data.  
 '                 There needs to be a %NetworkPath%\PSTools directory containing  
 '                 PSTools. Robocopy needs to be present in the PSTools directory.  
 '                 PSTools allows for the robocopy to run locally on the old  
 '                 machine, thereby conserving bandwidth if it is at a remote  
 '                 location.   
 '*******************************************************************************  
 Option Explicit

REM Define Constants  
 CONST TempFolder  = "c$\temp\"  
 CONST LogFolderName = "ProfileCopy"  
 CONST NetworkPath  = "\\global.gsp\data\special\Deploy\USMT\"

REM Define Global Variables  
 DIM NewComputer   : Set NewComputer   = Nothing  
 DIM OldComputer   : Set OldComputer   = Nothing  
 DIM NewComputerOS : Set NewComputerOS = Nothing  
 DIM OldComputerOS : Set OldComputerOS = Nothing  
 DIM LogFolder     : Set LogFolder     = Nothing  
 DIM OS            : Set OS            = Nothing  
 DIM RelativePath  : Set RelativePath  = Nothing  
 DIM ReturnCode    : ReturnCode        = "0"  
 DIM UserName      : Set UserName      = Nothing

REM Define relative installation path  
 DefineRelativePath()  
 REM Prompt for Old Computer Name, New Computer Name, and Username  
 GetComputerInfo()  
 REM Create the log folder  
 CreateLogFolder()  
 REM Determine which OS this script is being run from  
 DetermineOS()  
 MSGBOX OldComputerOS & Chr(32) & NewComputerOS  
 If (OldComputerOS = "WindowsXP") and (NewComputerOS = "WindowsXP") then  
      REM Robocopy the profile from the old XP machine to the new XP machine  
      CopyFilesXP2XP()  
 End If  
 If (OldComputerOS = "WindowsXP") and (NewComputerOS = "Windows7") then  
      REM Robocopy the profile from the old XP machine to the new Windows 7 machine  
      CopyFilesXP2Win7()  
 End If  
 If (OldComputerOS = "Windows7") and (NewComputerOS = "Windows7") then  
      REM Robocopy the profile from the old Windows 7 machine to the new Windows 7 machine  
      CopyFilesWin72Win7()  
 End If  
 REM Verify there were no errors during the robocopy  
 VerifyCopy()  
 REM Cleanup Global Variables  
 GlobalMemoryCleanup()

'*******************************************************************************  
 '*******************************************************************************  
 Sub DefineRelativePath()

REM Get File Name with full relative path  
      RelativePath = WScript.ScriptFullName  
      REM Remove file name, leaving relative path only  
      RelativePath = Left(RelativePath, InStrRev(RelativePath, "\"))

End Sub  
 '*******************************************************************************  
 Sub GetComputerInfo()

OldComputer = InputBox( "Enter the old computer name:" )  
      NewComputer = InputBox( "Enter the new computer name:" )  
      UserName  = InputBox( "Enter the username:" )

End Sub  
 '*******************************************************************************  
 Sub CreateLogFolder()

REM Define Local Objects  
      DIM FSO : Set FSO = CreateObject("Scripting.FileSystemObject")

REM Define Local Variables  
      DIM Logs : Set Logs = Nothing

REM Initialize Local Variables  
      LogFolder = "\\" & OldComputer & "\" & TempFolder & LogFolderName & "\"  
      Logs      = LogFolder & "robocopy.log"

If NOT FSO.FolderExists("\\" & OldComputer & "\" & TempFolder) then  
           FSO.CreateFolder("\\" & OldComputer & "\" & TempFolder)  
      End If  
      If NOT FSO.FolderExists(LogFolder) then  
           FSO.CreateFolder(LogFolder)  
      End If  
      If FSO.FileExists(Logs) then  
           FSO.DeleteFile(Logs)  
      End If

REM Cleanup Local Variables  
      Set FSO  = Nothing  
      Set Logs = Nothing

End Sub  
 '*******************************************************************************  
 Sub DetermineOS()

REM Define Local Objects  
      DIM FSO : Set FSO = CreateObject("Scripting.FileSystemObject")

IF FSO.FolderExists("\\" & OldComputer & "\c$\users\") then  
           OldComputerOS = "Windows7"  
      Else  
           OldComputerOS = "WindowsXP"  
      End If  
      IF FSO.FolderExists("\\" & NewComputer & "\c$\users\") then  
           NewComputerOS = "Windows7"  
      Else  
           NewComputerOS = "WindowsXP"  
      End If

REM Cleanup Local Variables  
      Set FSO = Nothing

End Sub  
 '*******************************************************************************  
 Sub CopyFilesXP2XP()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Initialize Robocopy Variables  
      Switches     = "/e /eta /r:1 /w:0"  
      ExcludeDir   = "/xd LocalService NetworkService *Links* *temp *TEMPOR~1 *cache"  
      ExcludeFiles = "/xf ntuser.* *.exd *.nk2 *.srs extend.dat *cache* *.oab index.* {* *.ost UsrClass.* SharePoint*.pst history* *tmp*"  
      Logs         = "/log:" & LogFolder & "robocopy.log"  
      Parameters   = Chr(32) & Switches & Chr(32) & ExcludeDir & Chr(32) & ExcludeFiles  
      RoboCopy     = RemoteExec & NetworkPath & "PSTools\robocopy.exe " & Chr(34) & "c:\Documents and Settings\" & UserName & Chr(34) &_  
                          Chr(32) & Chr(34) & "\\" & NewComputer & "\c$\Documents and Settings\" & UserName & Chr(34) & Parameters

ReturnCode = oShell.Run(RoboCopy, 1, True)

REM Local Memory Cleanup  
      Set oShell       = Nothing  
      Set Switches     = Nothing  
      Set ExcludeDir   = Nothing  
      Set ExcludeFiles = Nothing  
      Set Logs         = Nothing  
      Set Parameters   = Nothing  
      Set RemoteExec   = Nothing  
      Set RoboCopy     = Nothing

End Sub  
 '*******************************************************************************  
 Sub CopyFilesXP2Win7()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Define Local Variables  
      DIM ExcludeDir   : Set ExcludeDir   = Nothing  
      DIM ExcludeFiles : Set ExcludeFiles = Nothing  
      DIM Logs         : Set Logs         = Nothing  
      DIM Parameters   : Set Parameters   = Nothing  
      DIM RoboCopy     : Set RoboCopy     = Nothing  
      DIM Switches     : Set Switches     = Nothing  
      DIM RemoteExec   : RemoteExec       = RelativePath & "PSTools\PsExec.exe \\" & OldComputer &_  
                                                        Chr(32) & "-u nash\win2kload -p 2kosload" & Chr(32) 
 
      REM Initialize Robocopy Variables  
      Switches     = "/e /eta /r:1 /w:0"  
      ExcludeDir   = "/xd Application* Cookies IETldCache *Links* Local* NetHood NetworkService PrintHood PrivacIE Recent SendTo Start* *temp Templates *TEMPOR~1 Tracing *cache"  
      ExcludeFiles = "/xf ntuser.* ilent* *.exd *.nk2 *.srs extend.dat *cache* *.oab index.* {* *.ost UsrClass.* SharePoint*.pst history* *tmp*"  
      Logs         = "/log:" & LogFolder & "robocopy.log"  
      Parameters   = Chr(32) & Switches & Chr(32) & ExcludeDir & Chr(32) & ExcludeFiles  
      RoboCopy     = RemoteExec & NetworkPath & "PSTools\robocopy.exe " & Chr(34) & "c:\Documents and Settings\" & UserName & Chr(34) &_  
                          Chr(32) & Chr(34) & "\\" & NewComputer & "\c$\users\" & UserName & Chr(34) & Parameters

ReturnCode = oShell.Run(RoboCopy, 1, True)

End Sub  
 '*******************************************************************************  
 Sub CopyFilesWin72Win7()

REM Define Local Objects  
      DIM oShell : SET oShell = CreateObject("Wscript.Shell")

REM Initialize Robocopy Variables  
      Switches     = "/e /eta /r:1 /w:0"  
      ExcludeDir   = "/xd LocalService NetworkService *Links* *temp *TEMPOR~1 *cache"  
      ExcludeFiles = "/xf ntuser.* *.exd *.nk2 *.srs extend.dat *cache* *.oab index.* {* *.ost UsrClass.* SharePoint*.pst history* *tmp*"  
      Logs         = "/log:" & LogFolder & "robocopy.log"  
      Parameters   = Chr(32) & Switches & Chr(32) & ExcludeDir & Chr(32) & ExcludeFiles  
      RoboCopy     = RemoteExec & NetworkPath & "PSTools\robocopy.exe " & Chr(34) & "c:\users\" & UserName & Chr(34) &_  
                          Chr(32) & Chr(34) & "\\" & NewComputer & "\c$\users\" & UserName & Chr(34) & Parameters

ReturnCode = oShell.Run(RoboCopy, 1, True)

End Sub  
 '*******************************************************************************  
 Sub VerifyCopy()

If ReturnCode = "0" then  
           MsgBox("The profile, " & UserName & ", on " & OldComputer & " successfully copied to " & NewComputer & ".")  
      Else  
           MsgBox("The profile, " & UserName & ", on " & OldComputer & " failed to copy to " & NewComputer & " due to error " & ReturnCode & ".")  
      End If

End Sub  
 '*******************************************************************************  
 Sub GlobalMemoryCleanup()

Set NewComputer  = Nothing  
      Set OldComputer  = Nothing  
      Set RelativePath = Nothing  
      Set UserName     = Nothing  
end sub

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author