' ################################################################# ' # Desktop Migration Script # ' # By Mark Grenham # ' ################################################################# ' # Distributed Under 'The GNU General Public Licence Version 2' # ' # http://www.gnu.org/licenses/gpl.txt # ' ################################################################# ' # Revistion History # ' # # ' # 08 Nov 2006 - v 0.01 - Mark Grenham - Initial Release # ' # 09 Nov 2006 - v 0.02 - Mark Grenham - Logging Added # ' # 10 Nov 2006 - v 0.03 - Mark Grenham - File Migration Added # ' # 22 Nov 2006 - v 0.04 - Mark Grenham - Enhanced Error Handling # ' # 28 Nov 2006 - v 0.05 - Mark Grenham - Bug Fix: IgnoreProfiles # ' # 12 Dec 2006 - v 0.06 - Mark Grenham - Ignores profile root # ' # when searching c: # ' # # ' ################################################################# strVersion = "0.06" ' ######################### ' # Configuration Section # ' ######################### ' Profiles Not To Migrate (Seperate with a comma) strIgnoreProfiles = "LocalService, Administrator, All Users, Default User, NetworkService, _sophosupd, _sweepupd, _xpdeploy" ' Oldest Active Profile Date (DD/MM/YYYY Format) - Profiles older than this date will not be migrated strIgnoreDate = "01/09/2006" ' UNC Path to Network Share for Migration Data (No Leading \) strNetworkShare = "\\xpdeploy\migrate" ' List of File Extenstions or Files to Migrate (Hot Files) Example pdf doc strHotFiles = "pst ost pab doc xls ppt mdb" ' ############################################################ ' # Code Section # ! WARNING ! - Do Not Edit Below This Line # ' ############################################################ ' ############# ' # Main Code # ' ############# On Error Resume Next ' Our Error Counter intErrors = 0 ' Detect Hostname Set objNetwork = WScript.CreateObject("WScript.Network") strHostname = objNetwork.ComputerName ' Create Log File Set objFS = CreateObject("Scripting.FileSystemObject") strLogFile = "" & strNetworkShare & "\__Logs__\" & strHostname & ".log" If Not objFS.FileExists(strLogFile) Then ' Create the Log File Set objLog = objFS.CreateTextFile(strLogFile, True) objLog.WriteLine " Entry Time Stamp Error Code Log Entry Comment" objLog.WriteLine " | | |" objLog.WriteLine " V V V" objLog.WriteLine "[DD/MM/YYYY HH:MM:SS] [#] - Information" objLog.Close End If ' Open for appending Set objLog = objFS.OpenTextFile(strLogFile, 8, True) ' Print Script Header Information Message "**********************************" Message "* Desktop Migration Script v" & strVersion & " *" Message "* *" Message "* - By Mark Grenham *" Message "* *" Message "**********************************" ' Detect Windows Version dblOSVersion = GetOsVersionnumber() If dblOSVersion < 4 Then ' Not an NT Based Version Of Windows Message "Windows Version Detected: " & dblOSVersion Message " ! WARNING ! - Non NT Based Version Of Windows Detected" ' Exit Safely ExitScript Else ' Print Windows Version Message "Windows Version Detected: NT " & dblOSVersion End If ' Set the correct Profile Root strProfileRoot = "" If dblOSVersion > 4 Then ' 2000 Or Better Use Documents & Settings strProfileRoot = "C:\Documents and Settings" Else ' Must Be NT 4, Use C:\Winnt\Profiles strProfileRoot = "C:\WinNT\Profiles" End If ' Print Profile Root Message "Profile Root: " & strProfileRoot ' Print Detected Hostname Message "Detected Computer Hostname: " & strHostname ' Create Migration Folders on Share Message "Creating Migration Folders for this Computer..." strMigrateRoot = "" & strNetworkShare & "\" & strHostname If Not objFS.FolderExists(strMigrateRoot) Then objFS.CreateFolder(strMigrateRoot) objFS.CreateFolder("" & strMigrateRoot & "\Profiles") objFS.CreateFolder("" & strMigrateRoot & "\C_Drive") Else Message "!!!Warning!!! - Migration Folders Already Exist" Message " PC May have already been migrated" ' Exit Safely ExitScript End If ' Get Profiles in Profile Root Folder Set objFolder = objFS.GetFolder(strProfileRoot) ' Iterate through each profile Message "Starting Profile Migration..." Message "Ignoring Profiles not used since: " & strIgnoreDate For Each objDir In objFolder.SubFolders ' Get Profile Name strProfileName = objDir.Name Message "Checking Profile: " & strProfileName ' Check if Profile is in the Ignore List If inStr(1, strIgnoreProfiles, strProfileName, 1) = 0 Then ' Ok Profile is not in ignore list ' Get Profile Modification Date Set objFile = objFS.GetFile(objDir.Path & "\NTUser.dat") strProfileUpdated = objFile.DateLastModified Message " Last Active: " & strProfileUpdated ' Check If Profile is Unused Since Ignore Date If DateDiff("d", strIgnoreDate, strProfileUpdated) > 0 Then ' Profile has been used since ignore date Message " Creating Migration Folder for Profile..." objFS.CreateFolder("" & strMigrateRoot & "\Profiles\" & strProfileName) Message " Migrating Favorites..." strCopyFrom = "" & strProfileRoot & "\" & strProfileName & "\Favorites" strCopyTo = "" & strMigrateRoot & "\Profiles\" & strProfileName & "\" objFS.CopyFolder strCopyFrom, strCopyTo Message " Searching for Hot Files in Profile..." strResults = split( Search("" & strProfileRoot & "\" & strProfileName, strHotFiles), "|" ) Message " Migrating Hot Files in Profile..." 'Sanitize Array and Copy Files For Each strFile in strResults ' Skip if Blank If strFile = "" Then ' Skip Else ' Copy Them Over ObjFS.CopyFile strFile, strCopyTo Message " Copy: " & strFile End If Next Else ' Ignore Profile has not been used since the ignore date Message " Falls Before Ignore Date - Skipping" End If Else ' Profile is in the ignore list so skip it Message " Profile in Ignore List - Skipping" End If ' Print Message that we are finished with this profile Message "Done With Profile: " & strProfileName ' Next Profile Next ' Migrate Hot Files on the C: Drive Message " Searching for Hot Files on C: Drive..." strResults = split( Search("C:\", strHotFiles), "|" ) ' We are going to get a Error Code 70 here. This is expected and cannot ' be avoided as the pagefile and some system files will not be accessible ' so we just clear the error if it is an error 70 and continue If Err.Number = 70 Then ' Clear the Error Err.Clear End If Message "Migrating Hot Files on C: Drive..." 'Sanitize Array and Copy Files For Each strFile in strResults ' Skip if Blank If strFile = "" Then ' Skip Else ' Ignore the profile root as these files have already been migrated If inStr(1, strProfileRoot, strFile, 1) = 0 Then ' Copy Them Over strCopyTo = "" & strMigrateRoot & "\C_Drive\" ObjFS.CopyFile strFile, strCopyTo Message " Copy: " & strFile End If End If Next ' Should Check for Errors. Message "***********************" Message "* Migration Completed *" Message "***********************" ExitScript ' ############# ' # Functions # ' ############# Function Message (strMsg) ' Function to Print Message on Screen and to Log File with Timestamp ' Generate Time Stamp strTimeStamp = "[" & Date & " " & Time & "]" ' Append TimeStamp to Message strMsg = "" & strTimeStamp & " [" & Err.Number & "] - " & strMsg ' Print Message on Screen WScript.Echo strMsg ' Append Message to Log File objLog.WriteLine strMsg ' Check if we had an error If Err.Number <> 0 Then ' We had an error so increment our error counter and clear the error intErrors = intErrors + 1 Err.Clear End If End Function Function ExitScript() Message "Exiting Script" Message "ERROR COUNT: " & intErrors WScript.Quit End Function Function Search(strFolder, strList) Set objFS = CreateObject("Scripting.FileSystemObject") Dim strResults If objFS.FolderExists(strFolder) Then Set objFolder = objFS.GetFolder(strFolder) ' Get Files For Each objFile in objFolder.Files If inStr(1, strList, Right( LCase( objFile.Name), 3 ), 1) = 0 Then ' Skip The File Else ' Add File to our List strResults = strResults & objFile.Path & "|" End If Next ' Get SubFolders and Recurse through them For Each objDir In objFolder.SubFolders strTemp = Search(objDir.Path, strList) If strTemp = "" Then ' Skip Else strResults = strResults & strTemp & "|" End If Next Else strResults = "" End if ' Return our Results Search = strResults End Function Function GetOsVersionNumber() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Determines OS by reading reg val & comparing to known values ' OS version number returned as number of type double: ' Windows 95: 1 ' Windows 98: 2 ' Windows ME: 3 ' Windows NT4: 4 ' Windows 2k: 5 ' Windows XP: 5.1 ' Windows Server 2003: 5.2 ' Windows x: >5.2 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim oShell, sOStype, sOSversion Set oShell = CreateObject("Wscript.Shell") On Error Resume Next sOStype = oShell.RegRead(_ "HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType") If Err.Number<>0 Then ' Hex(Err.Number)="80070002" ' - Could not find this key, OS must be Win9x Err.Clear sOStype = oShell.RegRead(_ "HKLM\SOFTWARE\Microsoft\Windows" & _ "\CurrentVersion\VersionNumber") Select Case sOStype Case "4.00.950" sOSversion = 1 ' Windows 95A Case "4.00.1111" Dim sSubVersion sSubVersion = oShell.RegRead(_ "HKLM\SOFTWARE\Microsoft\Windows" & _ "\CurrentVersion\SubVersionNumber") Select Case sSubVersion Case " B" sOSversion = 1 ' Windows 95B Case " C" sOSversion = 1 ' Windows 95C Case Else sOSversion = 1 ' Unknown Windows 95 End Select Case "4.03.1214" sOSversion = 1 ' Windows 95B Case "4.10.1998" sOSversion = 2 ' Windows 98 Case "4.10.2222" sOSversion = 2 ' Windows 98SE Case "4.90.3000" sOSversion = 3 ' Windows Me Case Else sOSversion = 1 ' Unknown W9x/Me End Select Else ' OS is NT based sOSversion = oShell.RegRead(_ "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion") If Err.Number<>0 Then GetOsVersion = "Unknown NTx" ' Could not determine NT version Exit Function ' >>> End If End If ' Setting Locale to "en-us" to be indifferent to country settings. ' CDbl might err else OldLocale = GetLocale() SetLocale "en-us" GetOsVersionNumber = CDbl(sOSversion) SetLocale OldLocale End Function ' ############### ' # End Of File # ' ###############