I have managed to write a VB script that will move most of them, namely all those that are in a folder starting $NtUninstall.... anything it cant find in the registry it wont touch.
The script does the following for each input argument:
1. Extracts the update name from the folder path
2. Finds this update in the registry
3. Copies the update folder to the the destination path (set in the script)
4. Modifies the registry entry to reflect the new file path.
5. removes the old update folder.
6. pops up "completed operations" when its finished
7. Saves a log file in the destPath
What is doesnt do is handle errors, if you run out of space on your destination path whilst copying an update you will be left with half a folder on your update drive. Dont worry though, it wont then edit the registry, or remove the old folder.
If you use this script it is entirely at your own risk, i.e. test it first, then really test it, then assume it wont work and check your DR plan
Find the source code after the break
How you could use this script
1. copy the test below and save it in a file, e.g. updateMover.vbs
2. change the destPath in the script to your chosen destination (this must exisit)
3. drag and drop update files onto the script
4. wait for the pop message to say its done
5. reveiw the log.
'**********************************
'Update Mover Script
'Aurthor: Jonathan Freestone
'Date: 19/11/07
'Version: 1.0
'Change log:
'**********************************
const ASECHO = false
Const HKEY_LOCAL_MACHINE = &H80000002 'HKEY_LOCAL_MACHINE
CONST destFolder = "c:\WINDOWS"
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
Dim objRegistry
Dim strCopmuter
Dim regKey
Const TEMP_FOLDER = 2
Const FOR_WRITING = 2
Const ForWriting = 2
Const ForAppending = 8
LogFileIdent = destFolder & "\UpdateLog.rtf"
'CREATE LOGGING OBJECT
Set objShell = CreateObject("WScript.Shell")
Set fsObj = CreateObject ("scripting.fileSystemObject")
If fsObj.FileExists(LogFileIdent) Then
Set logFile = fsObj.OpenTextFile(LogFileIdent, ForAppending)
Else
Set logFile = fsObj.CreateTextFile(LogFileIdent)
logFile.close
Set logFile = fsObj.OpenTextFile(LogFileIdent, ForAppending)
End If
logFile.WriteLine("")
logFile.WriteLine("begining Update move now "& Now)
logFile.WriteLine("===========================================")
strCopmuter = "."
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strCopmuter & "/root/default:StdRegProv")
if (objArgs.Count >0 ) then
LoopThroughArgs
else
msgbox("Please drag and drop update folders onto this script")
end if
handlemessage "Completed operations"
msgbox "Completed operations"
logFile.close
'For each file in the command line array
'Find the update name
'Find the name in the registry
'Move the files
'Change the registry
'Delete the old files.
Function LoopThroughArgs
Set objArgs = WScript.Arguments
for each fileIdent in objArgs
handlemessage(fileIdent)
FindInRegistry GetUpdateName(fileIdent)
handlemessage "Found reg key: "®Key
if len(regkey) > 0 then
destPath = destFolder & "\" &Right(fileIdent,len(fileIdent) - inStrRev(fileIdent,"\"))
MoveFiles fileIdent,destPath
ChangeRegistry regKey &"\UninstallCommand", fileIdent, destPath
RemoveFolder fileIdent,true
handlemessage "Removed folder: " & fileIdent
handlemessage ""
end if
next
end Function
Function GetUpdateName(fileIdent)
updateName = Right(fileIdent,len(fileIdent) - inStrRev(fileIdent,"\"))
updateName = Replace(updateName, "$NtUninstall","")
updateName = Replace(updateName, "$","")
HandleMessage "Update name: "& UpdateName
GetUpdateName = updateName
end Function
Function FindInRegistry(findStr)
strKey = "SOFTWARE\Microsoft\Updates"
HandleMessage "Searching registry for: "&findStr
FindInRegistry = SearchReg(strKey, findStr)
end Function
'Searchs the registry recursivly for the KB number
Function SearchReg(strKeyPath, findStr)
Dim RC, strSubKey, arrSubKeys, compareStr
if inStrRev(strKeyPath,"\") > 0 then
compareStr = Right(strKeyPath,len(strKeyPath) - inStrRev(strKeyPath,"\"))
else
compareStr = ""
end if
'handleMessage(strKeyPath &" - "&compareStr &" - "& inStrRev(strKeyPath,"\"))
If findStr = compareStr then
regKey = strKeyPath
'HandleMessage "Found Key: "®Key
Exit Function
end if
'call Function recursively To deal With subkeys
RC = objRegistry.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys)
If IsArray(arrSubKeys)Then
For Each strSubKey In arrSubKeys
'HandleMessage( strKeyPath & "\" & strSubKey)
SearchReg (strKeyPath & "\" & strSubKey), findStr
Next
Else
Exit Function
End If
End Function
Function MoveFiles(source, dest)
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(source) Then
filesys.CopyFolder source, dest
End If
handleMessage "Copied Folder: "&source & " to "&dest
end Function
Function ChangeRegistry(key, fileIdent, destPath)
Set Shell = CreateObject( "WScript.Shell" )
key = "HKEY_LOCAL_MACHINE\" & key
oldValue = Shell.RegRead( key )
updateFolder = Right(fileIdent,len(fileIdent) - inStrRev(fileIdent,"\"))
handlemessage updateFolder
newValue = destPath &"\"& Right(oldValue,len(oldValue) - inStrRev(oldValue,updateFolder)-len(updateFolder))
handlemessage "Changing: "& key
handlemessage "From: "&oldValue
handlemessage "To: " & newValue
Shell.RegDelete key
Shell.RegWrite key, newValue, "REG_SZ"
end Function
sub HandleMessage(message)
if ASECHO = true then
WScript.echo message
else
logFile.WriteLine(message)
end if
end sub
Sub RemoveFolder(sPath,fRemoveSelf)
Dim oFS
Dim oFSFolder
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FolderExists(sPath) <> True Then
Set oFS = Nothing
Exit Sub
End If
Set oFSFolder = oFS.GetFolder(sPath)
RemoveSubFolders oFSFolder
If fRemoveSelf = True Then
If oFS.FolderExists(sPath) = True Then
oFSFolder.Delete True
Else
Set oFSFolder = Nothing
Set oFS = Nothing
Exit Sub
End If
End If
Set oFSFolder = Nothing
Set oFS = Nothing
End Sub
Sub RemoveSubFolders(oFSFolder)
Dim oFSFile
Dim oFSSubFolder
For Each oFSFile In oFSFolder.Files
oFSFile.Delete True
Next
For Each oFSSubFolder In oFSFolder.SubFolders
RemoveSubFolders oFSSubFolder
oFSSubFolder.Delete True
Next
Set oFSFile = Nothing
End Sub
Sub RemoveFile(sFilePathAndName)
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(sFilePathAndName) = True Then
oFS.DeleteFile sFilePathAndName, True
end if
Set oFS = Nothing
End Sub
No comments:
Post a Comment