スキップしてメイン コンテンツに移動

ZIP 形式でバックアップ

バックアップしたいファイルをフルパスで記載した外部ファイルを用意し、スケジューリングに組み込めるかもしれないWindows Scripting Host を使ったバックアップスクリプト。

元々は、圧縮してログを保存したい->RAR買ってバッチファイル書けよ、簡単で楽だぞ->ソフトがポリシーで入れらんない->諦めろ->なんとかして、といわれて、書いたものです。


  • 引数について
    第1引数
     バックアップ先、最後に \ 付ける
    第2引数
     バックアップファイルの最後に付ける識別子、特に指定せずとも可
    第3引数
     開始確認メッセージを表示するかどうか True で表示、False で非表示
    第4引数
     終了表示をするかどうか True で表示、False で非表示
    第5引数
     バックアップ履歴を残す数。0 を指定した場合は、履歴調整をしない。
    第6引数
     バックアップしたいファイルをフルパスで記載したファイルを指定

    例："c:\Temp\zip-bkupV3.vbs" "c:\Temp\Backup" "FooterTest" "True" "True" "5" "c:\Temp\FileList.txt"
  • ファイルリストの書き方
    ○バックアップしたいファイルはフルパスで指定します。UNC も通りますが、相対パスは通りませんので、相対パスで記述はしないでください。。
    ○改行コードのみの行や、; から始まる行は無視されます。リストの整形にどうぞ。
    ○文字コードは VBS が解釈できる文字コードなら、何でも良いはずです。
    ○改行コードは CR + LF を使用してください。CR のみや LF のみの場合は正常動作しません。
    ○リストファイルの拡張子は何でも構いません。.txt でも .lst でも、無くても構いません。

    例：
    ; テスト部分3
    ;
    ;バックアップ部分１
    c:\hoge\hoge.csv
    c:\hoge\hoge1.txt

    ; テスト部分2
    ;
    d:\hoge\foo.bar
スクリプトはここから。ファイル名は zip-bkupV3.vbs にしてました。
Option Explicit
'-- ZIP 形式でバックアップしてみる v3.00
'
' zip-bkupV3.vbs "第1引数" "第2引数" "第3引数" "第4引数" "第5引数" "第6引数"
' 第1引数 バックアップ先ディレクトリを指定
' 第2引数 バックアップファイルの最後に付ける識別子
' 第3引数 開始確認メッセージを表示するかどうか True で表示、False で非表示
' 第4引数 終了表示をするかどうか True で表示、False で非表示
' 第5引数 バックアップ履歴を残す数。0 の場合は、履歴調整をしない。
' 第6引数 バックアップしたいファイルをフルパスで記載したファイルを指定
'
' v2 との違い
'  ファイルやフォルダの存在チェックをするようにした
'  バックアップ一覧を記載したファイルを用意してもらい、そのファイルパスを引数に入れてもらうようにした
'  その他いろいろ。
'
'-- 開始メッセージ（タイトル）
Dim strMsgTitle  'As String
strMsgTitle = "バックアップ処理"
'-- 終了メッセージ（タイトル）
Dim strMsgTitleEnd 'As String
strMsgTitleEnd = "バックアップ処理の完了"
'-- 終了メッセージ（本文）
Dim strMsgEnd  'As String
strMsgEnd = "バックアップ処理が完了しました" & vbCrlf & _
 "※指定したファイル数やサイズによっては圧縮中の場合があります。" & vbCrlf & _
 "　左上に進捗状況の画面が表示されている場合は、その画面が消えるまでお待ち下さい。"

Dim strSTOPMsg  'As String '-- エラー表示用
strSTOPMsg = ""
Call mainProcess
If Not strSTOPMsg = "" Then Msgbox strSTOPMsg, vbOKOnly + vbCritical, ""

Private Sub mainProcess
 Dim Args 'As Object
 Set Args = WScript.Arguments
 '-- 引数の数チェック
 If ArgsCountCheck() Then Exit Sub
 '-- 引数の妥当性チェック
 If ArgsValidityCheck() Then Exit Sub
 '-- バックアップのメッセージボックスによる確認
 If Args.Item(2) Then
  If ProcessConfirm() Then Exit Sub
 End If
 '-- バックアップ処理
 Call ZipCompress(Args.Item(0), Args.Item(1), Args.Item(5))
 '-- バックアップファイル数調整処理
 If Args.Item(4) <> 0 Then Call BkupFilesCheck(Args.Item(4), Args.Item(0))
 '-- 結果表示
 If (strSTOPMsg = "" And LCase(Args.Item(3)) = "true") Then _
  Msgbox strMsgEnd, vbOkOnly, strMsgTitleEnd
End Sub

Private Sub ZipCompress(strBackupPath, strFileNameFooter, strBkupFileList)
 Dim objSA  'As Object
 Set objSA = WScript.CreateObject("Shell.Application")
 Dim i   'As Integer
 i = 0
 Dim intArgCount  'As Integer
 Dim strZipFileName 'As String
 Dim copyFileName 'As String
 Dim FileAry  'As Variant 'ファイル名格納用の配列
 Dim blnFileValid 'As Boolean
 blnFileValid = False
 '-- \ 処理
 If Right(strBackupPath, 1) <> "\" Then strBackupPath = strBackupPath & "\"
 '-- zip ファイル名生成
 strZipFileName = CreatZipFileName(strBackupPath, strFileNameFooter)
 '-- zip ファイル作成
 Call CreatZipFile(strZipFileName)
 '-- バックアップファイル名を配列へ格納
 FileAry = backupFileList(strBkupFileList)
 '-- 対象ファイルを放り込む
 With objSA.NameSpace(strZipFileName)
  For intArgCount = 0 To UBound(FileAry)
   '-- 何もないか ; で始まる場合は読み飛ばす
   If Not (FileAry(intArgCount) = "" Or _
    Left(FileAry(intArgCount),1) = ";") Then
    '-- ファイル存在チェック
    If FileValidityCheck(FileAry(intArgCount)) Then
     blnFileValid = True
     Exit For
    End If
    copyFileName = FileAry(intArgCount)
    .CopyHere copyFileName
    i = i + 1
    Do Until .Items.Count = i
     WScript.sleep 100
    Loop
   End If
  Next
 End With
 Set objSA  = Nothing
 If blnFileValid Then
  strSTOPMsg = "ファイル存在チェック：" & vbCrlf & _
   "次のファイルが存在しないため、バックアップ処理を中断しました" & vbCrlf & _
   " -> " & FileAry(intArgCount) & vbCrlf & _
   "バックアップ対象が記載されたファイルを確認してください"
  '-- ごみZIPファイル削除処理
  Dim objFS  'As Object
  Set objFS = CreateObject("Scripting.FileSystemObject")
  objFS.GetFile(strZipFileName).Delete
  Set objFS = Nothing
 End If
End Sub
'-- バックアップファイル名を配列へ格納
Private Function backupFileList(strBkupFileList)
 Dim FileAry 'As Variant 'ファイル名格納用配列
 Dim objFSO 'As Object
 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
 Dim objTS 'As Object
 Set objTS = objFSO.OpenTextFile(strBkupFileList)
 Dim strLines 'As String
 strLines = objTS.ReadAll
 Set objTS = Nothing
 FileAry = Split(strLines, vbCrlf) '--ほんとは、CR のみ LF のみとかも考慮すべきなんだがなぁ...
 backupFileList = FileAry
End Function
'-- ZIPファイル作成
Private Sub CreatZipFile(strZipFileName)
 Dim objFSO  'As Object
 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

 With objFSO.CreateTextFile(strZipFileName)
  .Write "PK" & Chr(5) & Chr(6) & String(18,0)
  .Close
 End With
 Set objFSO = Nothing
End Sub
'-- ZIPファイル名生成
Private Function CreatZipFileName(strBackupPath, strFileNameFooter) 'As String
 Dim dateNow  'As Date
 Dim dateArray(4) 'As Integer
 Dim i   'As Integer
 dateNow = Now
 dateArray(0) = Month(dateNow)
 dateArray(1) = Day(dateNow)
 dateArray(2) = Hour(dateNow)
 dateArray(3) = Minute(dateNow)
 dateArray(4) = Second(dateNow)
 For i = 0 to 4
  If Len(dateArray(i)) = 1 then dateArray(i) = "0" & dateArray(i)
 Next
 CreatZipFileName = strBackupPath & Year(dateNow) & dateArray(0) & dateArray(1) & "-" & dateArray(2) & dateArray(3) & dateArray(4) & strFileNameFooter & ".zip"
End Function
'-- バックアップ数調整処理
Private Sub BkupFilesCheck(intLogCount, strBackupPath)
 '-- \ 処理
 If Right(strBackupPath, 1) <> "\" Then strBackupPath = strBackupPath & "\"
 Dim objFS  'As Object
 Set objFS = CreateObject("Scripting.FileSystemObject")
 Dim objDir  'As Object
 Set objDir = objFS.GetFolder(strBackupPath)
 Dim FileAry()
 ReDim FileAry(objDir.Files.Count)
 Dim strFileName  'As String
 Dim i   'As Integer
 i = 0
 For Each strFileName In objDir.Files
  FileAry(i) = strFileName '-- ファイル名格納
  i = i + 1
 Next
 'Call DispArray(FileAry)
 '-- ファイル名で昇順ソート
 Call QuickSort(FileAry, 0, UBound(FileAry))
 'Call DispArray(FileAry)
 '-- 残すべきファイル数の決定
 intLogCount = UBound(FileAry) - intLogCount
 If intLogCount > 0 Then
  For i = 1 To intLogCount '-- ファイルソートすると、Null が先頭に来るので、1から開始
   'Msgbox "削除するファイル:" & FileAry(i)
   objFS.GetFile(FileAry(i)).Delete
  Next
 End If
 Set objDir = Nothing
 Set objFS  = Nothing
End Sub
'-- QuickSort
Private Sub QuickSort(valArray, valLeft, valRight)
 Dim valPivot  'As Variant
 Dim valHoldLeft  'As Variant
 Dim valHoldRight 'As Variant
 Dim valTemp  'As Variant
 valPivot = valArray(valLeft)
 valHoldLeft = valLeft
 valHoldRight = valRight
 Do
  While valArray(valHoldLeft) < valPivot
   valHoldLeft = valHoldLeft + 1
  Wend
  While valArray(valHoldRight) > valPivot
   valHoldRight = valHoldRight - 1
  Wend
  If valHoldLeft >= valHoldRight Then Exit Do
  valTemp = valArray(valHoldLeft)
  valArray(valHoldLeft) = valArray(valHoldRight)
  valArray(valHoldRight) = valTemp
  valHoldLeft = valHoldLeft + 1
  valHoldRight = valHoldRight - 1
 Loop
 If valLeft < valHoldLeft - 1 Then QuickSort valArray, valLeft, valHoldLeft - 1
 If valHoldRight + 1 < valRight  Then QuickSort valArray, valHoldRight + 1, valRight
End Sub

'-- 配列内容を表示
Private Sub DispArray(valArray)
 Dim valData 'As Variant
 Dim strMsg 'As String
 For Each valData In valArray
  strMsg = strMsg & valData & vbCrlf
 Next
 MsgBox strMsg
End Sub
'-- バックアップのメッセージボックスによる確認
Private Function ProcessConfirm 'As Boolean
 Dim blnStopFlag 'As Boolean
 blnStopFlag = False
 Dim Args 'As Object
 Set Args = WScript.Arguments
 Dim strMsg 'As String
 Dim strSpace 'As String
 strSpace = " -> "
 strMsg = "次の設定でバックアップを行います。" & vbCrlf & vbCrlf & _
  "○バックアップ先" & vbCrlf & strSpace & Args.Item(0) & vbCrlf & _
  "○バックアップファイル名" & vbCrlf & strSpace & "yyyymmdd-hhmmss" & Args.Item(1) & ".zip" & vbCrlf & _
  "○開始終了確認メッセージを表示する" & vbCrlf & strSpace & Args.Item(2) & vbCrlf & _
  "○結果表示を行う" & vbCrlf & strSpace & Args.Item(3) & vbCrlf & _
  "○バックアップ履歴数" & vbCrlf & strSpace & Args.Item(4) & vbCrlf & _
  "○バックアップリスト" & vbCrlf & strSpace & Args.Item(5)
 If Msgbox(strMsg, vbYesNo + vbDefaultButton2, strMsgTitle) = vbNo Then
  blnStopFlag = True
  strSTOPMsg = "中止しました。"
 End If
 ProcessConfirm = blnStopFlag
End Function
'-- 引数の妥当性チェック
Private Function ArgsValidityCheck() 'As Boolean
 Dim blnStopFlag 'As Boolean
 blnStopFlag = False
 Dim Args 'As Object
 Set Args = WScript.Arguments
 '--第1引数チェック
 If FolderValidityCheck(Args.Item(0)) Then
  blnStopFlag = True
  strSTOPMsg = "第1引数が不正です。" & vbCrlf & "　指定されたバックアップ先は存在しません"
 End If
 '--第3引数チェック
 If Not (LCase(Args.Item(2)) = "true" Or _
  LCase(Args.Item(2)) = "false") Then
  blnStopFlag = True
  strSTOPMsg = strSTOPMsg & vbCrlf & "第3引数が不正です。" & vbCrlf & "　True か False を指定してください"
 End If
 '--第4引数チェック
 If Not (LCase(Args.Item(3)) = "true" Or _
  LCase(Args.Item(3)) = "false") Then
  blnStopFlag = True
  strSTOPMsg = strSTOPMsg & vbCrlf & "第4引数が不正です。" & vbCrlf & "　True か False を指定してください"
 End If
 '--第6引数チェック　ファイル存在チェック
 If FileValidityCheck(Args.Item(5)) Then
  blnStopFlag = True
  strSTOPMsg = strSTOPMsg & vbCrlf & "第6引数が不正です。" & vbCrlf & "　バックアップ対象を取得するリストファイルは存在しません"
 End If
 ArgsValidityCheck = blnStopFlag
End Function

'-- 引数の数チェック
Private Function ArgsCountCheck() 'As Boolean
 Dim blnStopFlag 'As Boolean
 blnStopFlag = False
 Dim Args 'As Object
 Set Args = WScript.Arguments
 If Args.Count <> 6 Then
  blnStopFlag = True
  strSTOPMsg = "引数の数が不正です。[引数の数:" & Args.Count & "]" & vbCrlf & vbCrlf & _
   "※このメッセージは、引数無しでこのスクリプトを呼び出した場合や、" & vbCrlf & _
   "　引数の数が 6 以外の場合に表示されます。" & vbCrlf & _
   "　引数の詳細は、このファイルをメモ帳等で開いてコメントを読んで。"
 End If
 ArgsCountCheck = blnStopFlag
End Function

'-- ファイル存在チェック
Private Function FileValidityCheck(strFilePath) 'As Boolean
 Dim blnStopFlag 'As Boolean
 blnStopFlag = False
 Dim fso  'As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 If Not fso.FileExists(strFilePath) Then blnStopFlag = True
 FileValidityCheck = blnStopFlag
End Function
'-- フォルダ存在チェック
Private Function FolderValidityCheck(strDirPath) 'As Boolean
 Dim blnStopFlag 'As Boolean
 blnStopFlag = False
 Dim fso  'As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 If Not fso.FolderExists(strDirPath) Then blnStopFlag = True
 FolderValidityCheck = blnStopFlag
End Function

ラベル:

コメント

コメントを投稿

このブログの人気の投稿

無効にしたアプリ等

ドコモさん，消せない電話帳アプリとか入れないで下さい。要らないものは消せるようにして下さい。要らないから。常駐もしないで下さい，邪魔だから。 2014/02/15:追記 DcmWapPushHelper は，spモードメール等のドコモ謹製アプリでdocomo.ne.jpメールを使っている場合は，メール受信通知が遅い場合があるかもしれないので，使っている人は無効にしない方がいいかもしれません。 IMAP 経由で使ってりゃ関係なし。 無効にしたけど，本当は抹殺したい茸アプリ オートGPS しゃべって検索 スケジュール＆メモ デコメ絵文字マネージャー ドコモバックアップ ドコモ位置情報 ドコモ位置情報SUB ドコモ音声入力 ドコモ文字編集 メディアプレイヤー 取扱説明書 電話帳サービス DcmWapPushHelper（spモードメール使ってるなら無効を非推奨 DOCOMO Initialization iコンシェル iコンシェルコンテンツ NOTTV SDカードバックアップ エリア連動Wi-Fi 使わないから無効にしているアプリ 赤外線 Gガイド番組表DL 電子書籍 Reader by Sony Eメール Facebook mora Music Extension Music Unlimited Socialife Xperia AppShare (Facebook) Xperia Calendar Sync (Facebook) Xperia FB Setup Xperia Friends' Music Xperia Music Likes Xperia Proxy (Facebook) Xperia Proxy (Twitter) Xperia Social Engine Photos (Facebook) Xperia Social Engine Photos (Music Unlimited) Xperia Social Engine Sharing (Facebook) Xperia Social Engine Sharing (Twitter) Xperia Twitter Setup TV番組プレーヤー Sony Select 無効
コメントを投稿
続きを読む

squid - Chromebook で使えるノートアプリ比較

squid 評価 3/5 USIペンには，ボタンが無い。ファンクションの割り当てが出来ない為に，どうしてもペンの切替や消しゴムの選択には，筆記エリア外のボタン選択が必要になる。 squidの特徴として 指によるなぞりを削除に 割りあてる事が出来る。課金要素は，次の通り。 ・ ツールBOX（蛍光ペン，図形作成、テキスト入力） ・クラウドバックアップ（Dropbox,Box） ・PDFインポート ・背景（テンプレート）の充実（ サブスクリプション ） はっきり言って，ツールBOXへの課金は必須。 図形作成機能は，四角や線・丸を選んで描画するタイプ。好きな様に書くと補正 してくれるNoteselfの方式が自分は好み。いちいち 選ぶのが少しダルい。 背景（テンプレート）の充実がサブスクリプションしかない為， このアプリが用意してくれる背景が欲しければサブスクリプションで，全機能の解放が手軽かもしれない。 ただ，PDFのインポート機能を使えば，Web上にある種々のPDFを背景として使える為，買い切りでも十分対応可能。 スタイラスだと快適に使えるが，指でも使えるノートアプリって感じ。 欠点として， テキスト変換機能がない 。必然的に， 検索 機能 が 無い 。 機能毎に切り売りの無い，他のアプリがコスパに優れる。使いごこちは悪くないので今後の進化に期待。
コメントを投稿
続きを読む

Mozilla Firefox で Adguard の証明書をインストール

Firefox にオレオレ証明書を適用させるには次の２種類があります。 about:config の security.enterpriseroots.enabled を true にする。 Adguard のオレオレ証明書をインストールする。 Adguard windows 版をインストールした際に，https 通信もフィルタリングする設定にしたならば，Windows に Adguard の証明書もインストールされたはずですので，１の方法が一番簡単ではあります。 Chrome 系は Windows の証明書を使いますし。 なので，１だと非常に簡単ですが，まだベータ機能ではあります。一応は。 で。 元々２の方法しか出来なかった Firefox は，証明書を内蔵しているので，そこに証明書を登録してやらなきゃいけません。 Windows の証明書ストアから吐いても良いのですが， C:\ProgramData\Adguard\NetworkTemp\SSL に，Adguard の証明書があるので，こいつをインポートし，インポート後に信頼性の設定で，ウェブサイトの識別に使用する，へチェックを入れればOK。 ただ……１つぐらいのブラウザは，Adguard バイパス用途で持っていても良いかもしれません。Adguard 側でフィルタリングするソフトを指定できるとはいえ。
コメントを投稿
続きを読む