Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dFolder = WScript.CreateObject("Scripting.Dictionary") 'バックアップするフォルダ
Set dFile = WScript.CreateObject("Scripting.Dictionary") 'バックアップするファイル
Set dIgnore = WScript.CreateObject("Scripting.Dictionary") '無視するファイル・フォルダ
Set dReg = WScript.CreateObject("Scripting.Dictionary") 'レジストリキー
sRegBackup = sBackupRoot & "registry"
sLog = Fs.BuildPath(Fs.GetParentFolderName(WScript.ScriptFullName),"log.txt")
sErrorLog = Fs.BuildPath(Fs.GetParentFolderName(WScript.ScriptFullName),"error.txt")
sListFile = Fs.BuildPath(Fs.GetParentFolderName(WScript.ScriptFullName),"backup_list.txt")
If LCase(Fs.GetFileName(WScript.FullName)) = "wscript.exe" Then
MsgBox "cscriptで再起動します"
WshShell.Run "cscript """ & WScript.ScriptFullName & """", 1, False
WScript.Quit
End If
lCheckFile = 0 'チェックしたファイル数
lCheckFolder = 0 'チェックしたフォルダ数
lCheckSize = 0 'チェックしたファイルの容量
lUpdateFile = 0 '上書き更新したファイル数
lNewFile = 0 '新しく追加したファイル数
lNewFolder = 0 '新しく追加したフォルダ数
lDeleteFile = 0 'バックアップから削除したファイル数
lDeleteFolder = 0 'バックアップから削除したフォルダ数
lBackupSize = 0 'バックアップファイルの容量
lErr = 0 'エラー数
If Not Fs.FileExists(sListFile) Then
MsgBox "バックアップリストファイルがありません。"
WScript.Quit
End If
Set ts = Fs.OpenTextFile(sListFile)
If Not Fs.FolderExists(sBackupRoot) Then
Fs.CreateFolder sBackupRoot
End If
Do Until ts.AtEndOfStream
sTemp = ts.ReadLine
If Left(sTemp,2) = "//" Or sTemp = "" Then
'コメント、空行
ElseIf Left(sTemp,1) = "-" Then
sTemp=LCase(Mid(sTemp,2))
If Not dIgnore.Exists(sTemp) Then
dIgnore.Add sTemp, ""
End If
ElseIf Left(sTemp,4) = "HKEY" Then
If Not dReg.Exists(sTemp) Then
dReg.Add sTemp, ""
End If
Else
If Fs.FolderExists(sTemp) Then
dFolder.Add sTemp, ""
ElseIf Fs.FileExists(sTemp) Then
dFile.Add sTemp, ""
End If
End If
Loop
ts.Close
WriteAndShowLog Date & " " & Time
'レジストリバックアップ
WriteAndShowLog "Backup Registry..."
WScript.Echo
If Not Fs.FolderExists(sRegBackup) Then
Fs.CreateFolder sRegBackup
End If
'レジストリすべて書き出し
'WshShell.Run "regedit /s /e " & sRegBackup & "all.reg",,True
For Each sReg In dReg.Keys
WshShell.Run "regedit /s /e " & sRegBackup & "" & _
Replace(sReg,"","_") & ".reg " & sReg,,True
Next
'ファイル・フォルダのバックアップ
WScript.Echo
WriteAndShowLog "Backup files..."
WScript.Echo
'ファイルのバックアップ
For Each sFile In dFile.Keys
WriteAndShowLog "[" & sFile & "]"
sTarget = sBackupRoot & "" & Left(Fs.GetDriveName(sFile), 1) & _
Mid(Fs.GetParentFolderName(sFile), 3)
CreateFolderEx sTarget
CopyFile Fs.GetFile(sFile), sTarget 'バックアップ
Next
'フォルダのバックアップ
For Each sFolder In dFolder.Keys
WriteAndShowLog "[" & sFolder & "]"
CopyFolder Fs.GetFolder(sFolder) 'バックアップ
Next
'バックアップの削除
WScript.Echo
WriteAndShowLog "Check files..."
WScript.Echo
If Fs.FolderExists(sBackupRoot) Then
On Error Resume Next
For Each oFolder In Fs.GetFolder(sBackupRoot).SubFolders
If LCase(oFolder.Path) LCase(sRegBackup) Then
WriteAndShowLog "Check " & oFolder.Path
DeleteFolder oFolder
End If
Next
On Error Goto 0
End If
WriteAndShowLog vbCrLf & "チェックしたファイル数 " & lCheckFile & vbCrLf & _
"上書き更新したファイル数 " & lUpdateFile & vbCrLf & _
"新しく追加したファイル数 " & lNewFile & vbCrLf & _
vbCrLf & _
"チェックしたフォルダ数 " & lCheckFolder & vbCrLf & _
"新しく追加したフォルダ数 " & lNewFolder & vbCrLf & _
vbCrLf & _
"チェックしたファイルの容量 " & ModifySize(lCheckSize) & vbCrLf & _
"バックアップファイルの容量 " & ModifySize(lBackupSize) & vbCrLf & _
vbCrLf & _
"バックアップから削除したファイル数 " & lDeleteFile & vbCrLf & _
"バックアップから削除したフォルダ数 " & lDeleteFolder & vbCrLf & _
vbCrLf & _
"エラー数 " & lErr & vbCrLf & _
"done" & vbCrLf
Sub WriteAndShowLog(str)
Set ts1 = Fs.OpenTextFile(sLog, 8, True)
ts1.Write str & vbCrLf
ts1.Close
WScript.Echo str
End Sub
Sub WriteAndShowErrorLog(str)
Set ts1 = Fs.OpenTextFile(sErrorLog, 8, True)
ts1.Write str & vbCrLf
ts1.Close
WScript.Echo "!!Error!!" & str
End Sub
Sub CopyFile(File, Target)
'ファイルのコピー
sTargetFile = Fs.BuildPath(Target, File.Name)
If Not (dIgnore.Exists(LCase(File.Path)) Or dIgnore.Exists(LCase(File.Name))) Then
lCheckFile = lCheckFile + 1
lCheckSize = lCheckSize + File.Size
sTargetFile = Fs.BuildPath(Target, File.Name)
If Fs.FileExists(sTargetFile) Then
Set oTargetFile = Fs.GetFile(sTargetFile)
If oTargetFile.Size File.Size Or Abs(DateDiff("s", oTargetFile.DateLastModified, File.DateLastModified)) > 2 Then
'もしサイズが違うか、最終更新日が2sec以上違っていたら、
On Error Resume Next
File.Copy Target & "", True'ターゲット上書き。
If Err.Number0 Then
WriteAndShowErrorLog File.Path & " can't be updated."
lErr = lErr + 1
Err.Clear
Else
lUpdateFile = lUpdateFile + 1
WScript.Echo File.Path & " >> " & Target
End If
On Error Goto 0
Else
'ファイルサイズと更新日が同じなら何もしない。
End If
Else
'ファイルが存在しないならコピーする
On Error Resume Next
File.Copy Target & ""
If Err.Number0 Then
WriteAndShowErrorLog File.Path & " can't be copied."
lErr = lErr + 1
Err.Clear
Else
lNewFile = lNewFile + 1
WScript.Echo File.Path & " > " & Target
End If
On Error Goto 0
End If
End If
End Sub
Sub CopyFolder(Folder)
'フォルダのコピー
'元のフォルダ名のC:→sBackupRootcに置換したフォルダ。
sTarget = sBackupRoot & "" & Left(Fs.GetDriveName(Folder.Path), 1) & Mid(Folder.Path, 3)
CreateFolderEx sTarget
lCheckFolder = lCheckFolder + 1
'ファイルのコピー
For Each oFile In Folder.Files
CopyFile oFile,sTarget
Next
'サブフォルダ
For Each oSubFolder In Folder.SubFolders
oSubFolder.Attributes = 0 '属性を解除する
If Not (dIgnore.Exists(LCase(oSubFolder.Path)) Or dIgnore.Exists(LCase(oSubFolder.Name))) Then
'無視リストに入ってなければ再帰
CopyFolder oSubFolder
End If
Next
End Sub
Sub DeleteFolder(Folder)
'バックアップファイルの削除
'バックアップにはあるが、現存しないファイル/フォルダを削除する
sSource = Mid(Folder.Path, Len(sBackupRoot) + 2)
sSource = Left(sSource,1) & ":" & Mid(sSource,2)
If Not Fs.FolderExists(sSource) Then
On Error Resume Next
'当該バックアップフォルダが、コピー元に存在しない場合
sTempFolderPath = Folder.Path
Folder.Delete 'バックアップフォルダをフォルダごと削除する
If Err.Number 0 Then
WriteAndShowErrorLog Folder.Path & " can't be deleted."
lErr = lErr + 1
Err.Clear
Else
lDeleteFolder = lDeleteFolder + 1
WScript.Echo sTempFolderPath & " deleted."
Exit Sub
End If
On Error Goto 0
End If
For Each oFile In Folder.Files
If Not Fs.FileExists(Fs.BuildPath(sSource, oFile.Name)) Then
'コピー元が存在しなければ
On Error Resume Next
sTempFilePath = oFile.Path
oFile.Attributes = 0 '属性を解除する
oFile.Delete 'バックアップを削除する
If Err.Number0 Then
WriteAndShowErrorLog sTempFilePath & " can't be deleted."
lErr = lErr + 1
Err.Clear
Else
lDeleteFile = lDeleteFile + 1
WScript.Echo sTempFilePath & " deleted."
End If
On Error Goto 0
Else
lBackupSize = lBackupSize + oFile.Size
End If
Next
For Each oSubFolder In Folder.SubFolders
DeleteFolder oSubFolder
Next
End Sub
Sub CreateFolderEx(Path)
'一気にフォルダを作る。
sParent=Fs.GetParentFolderName(Path)
If Fs.FolderExists(sParent) And Not Fs.FolderExists(Path) Then
'親フォルダが存在し、そのフォルダがない場合は作る
lNewFolder = lNewFolder + 1
Fs.CreateFolder Path
ElseIf Fs.FolderExists(Path) Then
'もうフォルダがある→何もしない
Else
'親フォルダがない場合は親フォルダを作ってから、当該フォルダを作る。
CreateFolderEx sParent
Fs.CreateFolder Path
lNewFolder = lNewFolder + 1
End If
End Sub
Function ModifySize(sz)
If sz >= 1073741824 Then
ModifySize = CSng(Left(sz/1073741824,4)) & "GB"
ElseIf sz >= 1048576 Then
ModifySize = CSng(Left(sz/1048576,4)) & "MB"
ElseIf sz >= 1024 Then
ModifySize = CSng(Left(sz/1024,4)) & "KB"
Else
ModifySize = FormatNumber(sz,0) & "バイト"
End If
End Function
メンバー 
