Скрипт копирования данных из профиля пользователя Windows XP при подготовке компьютера к переустановке системы.

Wscript копирует папки рабочий стол, закладки IE, мои документы, картинка рабочего стола, закладки Opera, файлы Outlook (pst) и реестровая запись учётной записи + немного доп инфы о сети и названии пк.

 

Visual Basic Script

Сохраните приведённый скрипт в файле ЛюбоеНазвание.vbs

' VBScript для копирования данных:
'папки рабочий стол, закладки IE, мои документы, картинка рабочего стола
' файлы Outlook (pst) и реестровая запись учётной записи
' + немного доп инфы о сети и названии пк
' ver 1.2  07/02/2012
' (c) Alex_Per http://pc-s.ru/
'
'

Option Explicit
Dim WshShell, SF, FSO, objShell, WshNetwork
Dim sDisk, sPathBackup, sKey, sReg, sOutlook, sInfo, sTxtFile, sOpera
Dim objApShell, objFolder, objFolderItem
Dim sActivac, sActivacBak
'
Set WshShell = WScript.CreateObject("WScript.Shell")
Set SF = WshShell.SpecialFolders
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
'
' Выбор или создание папки:
Const WINDOW_HANDLE = 0
Const OPTIONS = 0 '17   '16384
Set objApShell = CreateObject("Shell.Application")
Set objFolder = objApShell.BrowseForFolder _
    (WINDOW_HANDLE, "Select a folder:", OPTIONS,"17")
If objFolder Is Nothing Then
    Wscript.Quit
End If
Set objFolderItem = objFolder.Self
sPathBackup = objFolderItem.Path
'Wscript.Echo sPathBackup
' Выбор или создание папки end
' Полный путь в папку бэкапа:
sPathBackup = sPathBackup & "\"
'
' Путь к картинке рабочего стола:
sKey = "HKEY_CURRENT_USER\Control Panel\Desktop\ConvertedWallpaper"
sReg = WshShell.RegRead(sKey)
' Путь к картинке рабочего стола End
' Копируем картинку в папку WallPaper:
If FSO.FolderExists(sPathBackup & "WallPaper")= False Then FSO.CreateFolder sPathBackup & "WallPaper"
FSO.CopyFile sReg, sPathBackup & "WallPaper\", 1
'
'Копируем папки:
FSO.CopyFolder SF("Desktop"), sPathBackup, 1 'копируем папку рабочий стол
FSO.CopyFolder SF("Favorites"), sPathBackup, 1 'копируем закладки IE
FSO.CopyFolder SF("MyDocuments"), sPathBackup, 1 'копируем папку мои документы
' Outlook:
sOutlook = WshShell.ExpandEnvironmentStrings("%UserProfile%") & "\Local Settings\Application Data\Microsoft\Outlook"
If FSO.FolderExists(sOutlook) = True Then FSO.CopyFolder sOutlook, sPathBackup, 1
' Outlook end
' сохранение учётной записи Outlook импорт ветки реестра
objShell.Exec "%COMSPEC% /k regedit /e " & chr(34) & sPathBackup & "outlook.reg " & chr(34) & chr(34)  & "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook" & chr(34)
'копируем закладки Оперы:
sOpera = SF("AppData") & "\Opera\Opera\bookmarks.adr"
If FSO.FileExists(sOpera) Then FSO.CopyFile sOpera, sPathBackup, 1
'
'
'
' Инфо о компьютере и пользователе
sInfo = "Имя компютера: " & WshNetwork.ComputerName
sInfo = sInfo & vbCrLf & "Пользователь компютера: " & WshNetwork.UserName
sInfo = sInfo & vbCrLf & "UserDomain: " & WshNetwork.UserDomain
' MsgBox sInfo
'Вывод в тектсовый файл
Set sTxtFile = FSO.CreateTextFile(sPathBackup & "info.txt")
sTxtFile.WriteLine(sInfo)
sTxtFile.Close
'
' IPconfig в файл
objShell.Exec "%COMSPEC% /k ipconfig /all > " & chr(34) & sPathBackup & "lan.txt" & chr(34)
'
' route print в файл
objShell.Exec "%COMSPEC% /k route print > " & chr(34) & sPathBackup & "route.txt" & chr(34)
'
'Как избежать повторной активации.
'При каждой переустановке windows xp приходится связываться с компанией microsoft и заново активировать операционную систему. Чтобы избежать этих хлопот, нужно скопировать существующий файл с сигнатурой оборудования, который windows xp создает с учетом конфигурации вашего компьютера и заново вставляет в свежеустановленную версию windows xp. Для этого в конце переустановки windows выберите отказ от активации, а по завершении перезапустите ПК в безопасном режиме, нажав перед запуском ОС клавишу . Когда windows раскроется в безопасном режиме, замените ранее скопированными файлами (в папку sys32) их новые версии в папке c:windowssystem32.
'Замечание. Этот прием сработает только на том ПК, на котором файл wpa.dbl изначально был создан; обойти процедуру активации windows xp на других компьютерах он не позволит. А если вы до переустановки вносили в аппаратную часть ПК серьезные изменения, то, вероятно, все равно придется активировать ПК заново.
If FSO.FolderExists(sPathBackup & "sys32")= False Then FSO.CreateFolder sPathBackup & "sys32"
sActivac = WshShell.ExpandEnvironmentStrings("%WinDir%") & "\system32\wpa.dbl"
'msgbox sActivac
If FSO.FileExists(sActivac) = True Then FSO.CopyFile sActivac, sPathBackup & "sys32\", 1
sActivacBak = WshShell.ExpandEnvironmentStrings("%WinDir%") & "\system32\wpa.bak"
If FSO.FileExists(sActivacBak) = True Then FSO.CopyFile sActivacBak, sPathBackup & "sys32\", 1

MsgBox "Копирование выполнено"