htsign's blog

ノンジャンルで書くつもりだけど技術系が多いんじゃないかと思います

簡易バックアップスクリプト

VBScript

会社で使う用に作ったのをまるまる持ってきた。

https://dl.dropboxusercontent.com/u/414379/script/MakeBackup.vbs

「送る」に置いて使うやつ。

修正の余地は腐るほどあろうかというところだけど、それはまぁボチボチといったところで。
とりあえず現段階でもそれなりに実用できてる。

ちなみに「送る」フォルダはWindows+Rからのshell:sendtoで一発で開けます。

以下ソースコード。

''' *************************************************
''' @name           MakeBackup.vbs
''' @description    コマンドライン引数に指定されたファイル（またはフォルダ）のバックアップを生成
'''                 （複数のファイル（フォルダ）が指定された場合はそれぞれ生成）する。
'''                 「送る」メニューに配置して運用されることを想定。
''' @author         htsign
''' 
''' @releasenote
'''     0.0.1   14.03.31
'''         ◆バックアップ機能を実装
'''     0.2.2   14.04.01
'''         ◆インデックス値を取るようにした
'''         ◆フォルダのバックアップにも対応した
'''         ◆正規表現文の構築時にエスケープされていなかったのを修正
'''     0.3.7   14.04.02
'''         ◆フォルダサイズが閾値を超えていると警告を出すようにした
'''         ◆子フォルダにアクセスできない場合にエラーを表示するようにした
'''     0.4.3   14.04.03
'''         ◆インデックス値を求める処理の正確性を向上・効率化
''' 
''' @license    MIT License
''' *************************************************

Option Explicit

''' 定数宣言（カッコ内はデフォルト値）
Const INDEX_LENGTH = 3              ' インデックス値の長さ (3)
Const SIZE_THRESHOLD = 20971520     ' 警告を出すフォルダサイズの閾値 (20971520 = 20MiB)

Dim LargeFlag : LargeFlag = False   ' 閾値を超えたフォルダを処理する場合 True に

Dim Args, Arg
Set Args = WScript.Arguments

For Each Arg In Args
    MakeBackup Arg
Next

If LargeFlag Then MsgBox("バックアップが終了しました。")



''' バックアップを作成するメインルーチン
''' @param  ObjPath {string}    対象ファイルのファイルパス
Sub MakeBackup(ByVal ObjPath)
    Dim Shell, FSO
    Dim TargetFile, TargetFolder, Size
    
    Set Shell = WScript.CreateObject("WScript.Shell")
    Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
    
    ' ファイルかフォルダかで場合分け
    Select Case GetObjType(ObjPath)
        Case 0
            Set TargetFile = FSO.GetFile(ObjPath)
            
            FSO.CopyFile TargetFile.Path, _
                TargetFile.Path & "\..\" & _
                FSO.GetBaseName(TargetFile.Path) & "_" & NewIndex(TargetFile, INDEX_LENGTH) & "_" & GetPostfix(Now) & _
                "." & FSO.GetExtensionName(TargetFile.Path)
    
        Case 1
            Set TargetFolder = FSO.GetFolder(ObjPath)
            
            ' 一部フォルダでサイズ取得時にエラー（権限の問題？）が起こるので
            On Error Resume Next
            Size = -1
            Size = TargetFolder.Size
            On Error GoTo 0
            
            ' フォルダサイズが閾値を超えていた場合に警告を出す
            If Size >= SIZE_THRESHOLD Then
                If MsgBox("『 " & TargetFolder.Name & " 』 のフォルダサイズが " & SizeFormat(Size) & " あります。" & vbCrLf & _
                          "バックアップに時間がかかることが予想されます。続行しますか？" & vbCrLf & _
                          vbCrLf & _
                          "※進捗状況は表示されません", _
                          vbYesNo + vbExclamation, _
                          "フォルダサイズ警告") = vbNo Then
                    Exit Sub
                Else
                    LargeFlag = True
                End If
            End If
            
            ' ファイスサイズ取得でエラーが起こっていた場合は通知
            If Size = -1 Then
                MsgBox("『 " & TargetFolder.Name & " 』 のバックアップに失敗しました。" & vbCrLf & _
                       "フォルダにアクセスする権限がない可能性があります。")
                Exit Sub
            End If
            
            FSO.CopyFolder TargetFolder.Path, _
                TargetFolder.Path & "\..\" & _
                TargetFolder.Name & "_" & NewIndex(TargetFolder, INDEX_LENGTH) & "_" & GetPostfix(Now)
    End Select
End Sub



''' 対象のオブジェクトがファイルかフォルダかを判断する
''' @param  ObjPath     {string}    ファイル（またはフォルダ）のパス
''' @return GetObjType  {int}       ファイルなら 0 , フォルダなら 1 , どちらでもなければ -1
Function GetObjType(ByVal ObjPath)
    Dim FSO
    Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
    
    If FSO.FileExists(ObjPath) Then
        GetObjType = 0
    
    ElseIf FSO.FolderExists(ObjPath) Then
        GetObjType = 1
    
    Else
        GetObjType = -1
    End If
End Function



''' 他と重複しない指定桁数のインデックス値を生成する
''' @param  TargetObj   {object}    対象となるファイル（またはフォルダ）オブジェクト
''' @param  Length      {int}       インデックス値の桁数
''' @return NewIndex    {string}    インデックス値
Function NewIndex(ByVal TargetObj, ByVal Length)
    Const FILELIST_TEMPFILE = "~MakeBackup_FileList.tmp"
    Const AS_READ = 1
    
    Dim Shell, FSO, RE
    Dim Obj, ObjType, ObjName, ObjExt
    Dim TargetObjLen
    Dim DirCommand, FileList
    Dim TempPath
    Dim Stream
    Dim RetIndex
    Dim i
    
    Set Shell = WScript.CreateObject("WScript.Shell")
    Set FSO   = WScript.CreateObject("Scripting.FileSystemObject")
    
    ' **コマンド文を構築**
    DirCommand = "cmd /c dir /b "
    ObjType = GetObjType(TargetObj.Path)
    ' ファイルかフォルダかで場合分け
    Select Case ObjType
        Case 0
            ObjExt = FSO.GetExtensionName(TargetObj.Name)
            DirCommand = DirCommand & "/a-d """ & FSO.GetParentFolderName(TargetObj.Path) & "\" & _
                FSO.GetBaseName(TargetObj.Path) & "_" & Padding("", "?", Length) & "_??????_????"
                
            ' 拡張子がある場合はコマンドに追加
            If Len(ObjExt) <> 0 Then DirCommand = DirCommand & "."
            DirCommand = DirCommand & ObjExt & """"
            
        Case 1
            DirCommand = DirCommand & "/ad """ & FSO.GetParentFolderName(TargetObj.Path) & "\" & _
                FSO.GetBaseName(TargetObj.Path) & "_" & Padding("", "?", Length) & "_??????_????"""
    End Select
    
    TempPath = FSO.BuildPath(Shell.ExpandEnvironmentStrings("%temp%"), FILELIST_TEMPFILE)
    DirCommand = DirCommand & " > """ & TempPath & """"
    ' **コマンド文構築ここまで**
    
    ' コマンドを実行して結果を拾う
    Shell.Run DirCommand, 0, True
    Set Stream = FSO.OpenTextFile(TempPath, AS_READ)
    
    ' 検索結果が0だった場合は戻り値は 1 で確定
    ' 結果が空なので、ファイルポインタが0であることは終端に到達していることに等しい
    If Stream.AtEndOfStream Then
        NewIndex = Padding(1, 0, Length)
        Stream.Close
        FSO.DeleteFile TempPath
        Exit Function
    End If
    
    FileList = Split(Stream.ReadAll, vbCrLf)
    Stream.Close
    FSO.DeleteFile TempPath
    
    ' 検索開始
    For i = UBound(FileList) - 1 To 0 Step -1
        ' Objにファイル（フォルダ）オブジェクトを格納
        On Error Resume Next
        Set Obj = FSO.GetFile  (TargetObj.Path & "\..\" & FileList(i))
        Set Obj = FSO.GetFolder(TargetObj.Path & "\..\" & FileList(i))
        On Error GoTo 0
        
        Set RE = New RegExp
        
        ' ファイルかフォルダかで場合分け
        Select Case ObjType
            Case 0
                ObjName    = FSO.GetBaseName(Obj.Path)
                RE.Pattern = FSO.GetBaseName(TargetObj.Path)
                TargetObjLen = Len(FSO.GetBaseName(TargetObj.Name))
                
            Case 1
                ObjName    = Obj.Name
                RE.Pattern = TargetObj.Name
                TargetObjLen = Len(TargetObj.Name)
        End Select
        
        RE.Pattern = "^" & RegExpEscape(RE.Pattern) & "_\d{" & Length & "}_\d{6}_\d{4}$"
        
        ' マッチングしたら、インデックス値と思われる数字の次の値をRetIndexとする
        If RE.Test(ObjName) Then
            RetIndex = CInt(Mid( _
                ObjName, _
                InStr(TargetObjLen, ObjName, "_", vbTextCompare) + 1, _
                Length))
            RetIndex = RetIndex + 1
            
            NewIndex = Padding(RetIndex, 0, Length)
            Exit Function
        End If
    Next
    
    ' 最後まで到達したら RetIndex = 1
    RetIndex = 1
    NewIndex = Padding(RetIndex, 0, Length)
End Function



''' バックアップファイル（フォルダ）名のpostfixを生成する
''' @param  cTime      {string}    日付・時刻を表す文字列
''' @return GetPostfix {string}    postfix
Function GetPostfix(ByVal cTime)
    Dim dYear, dMonth, dDay
    Dim dHour, dMinute
    
    dYear   = Right(Year(cTime), 2)
    dMonth  = Padding(Month(cTime), 0, 2)
    dDay    = Padding(Day(cTime), 0, 2)
    dHour   = Padding(Hour(cTime), 0, 2)
    dMinute = Padding(Minute(cTime), 0, 2)
    
    GetPostfix = dYear & dMonth & dDay & "_" & dHour & dMinute
End Function



''' 文字列の先頭に指定の文字を連ね、指定の長さにする
''' @param  Str     {string}    文字列
''' @param  Char    {string}    埋める文字
''' @param  Length  {int}       文字列長の目標
''' @return Padding {string}    0埋めされた文字列
Function Padding(ByVal Str, ByVal Char, ByVal Length)
    Dim InnerStr
    Dim i
    
    InnerStr = Str
    For i = 0 To Length - 1
        InnerStr = CStr(Char) & InnerStr
    Next
    
    Padding = Right(InnerStr, Length)
End Function



''' サイズ表記を整形する
''' @param  Size        {int}       ファイル（またはフォルダ）サイズ
''' @return SizeFormat  {string}    整形されたサイズ表記
Function SizeFormat(ByVal Size)
    Dim K : K = 1024
    Dim M : M = 1024 * K
    Dim G : G = 1024 * M
    Dim T : T = 1024 * G
    
    If Size >= T * 0.9 Then
        SizeFormat = Round(Size / T, 2) & " TB"
    
    ElseIf Size >= G * 0.9 Then
        SizeFormat = Round(Size / G, 2) & " GB"
    
    ElseIf Size >= M * 0.9 Then
        SizeFormat = Round(Size / M, 2) & " MB"
    
    ElseIf Size >= K * 0.9 Then
        SizeFormat = Round(Size / K, 2) & " KB"
    
    Else
        SizeFormat = Size & " B"
    End If
End Function



''' 正規表現文字列をエスケープする
''' @param  Str             {string}    対象の正規表現文字列
''' @return RegExpEscape    {string}    エスケープ後の正規表現文字列
Function RegExpEscape(ByVal Str)
    Str = Replace(Str, "-", "\-")
    Str = Replace(Str, ".", "\.")
    Str = Replace(Str, "!", "\!")
    Str = Replace(Str, "^", "\^")
    Str = Replace(Str, "$", "\$")
    Str = Replace(Str, "+", "\+")
    Str = Replace(Str, "(", "\(")
    Str = Replace(Str, ")", "\)")
    Str = Replace(Str, "[", "\[")
    Str = Replace(Str, "]", "\]")
    Str = Replace(Str, "{", "\{")
    Str = Replace(Str, "}", "\}")
    
    RegExpEscape = Str
End Function