2009/03/10

VBScriptで、日付付きFileBackup・・・


FileBackupper.vbs と .vbe を、暫定で今使ってるままをうpしました。
ファイル/フォルダ右クリックのコンテキストメニューに、
[バックアップ作成]を追加する機能はまだ付いていない版です。

デキルコトは、対象ファイル/フォルダの名称を、
"[元FileName] yyyymmdd hhnnss.[拡張子]" に 変え、コピーを取るだけ。

実働のブツなので使えますが、未使用関数が載ったままになってたりと、
効率が悪い部分が残っています。

改訂版も後日うpするので、コノ分は、あくまで、参考までに・・・

   FileBackupper.zip    
▲ を、右クリックしてファイルとして保存してください。

使い方は至って簡単、ファイルやフォルダをドラッグするだけ。
ショートカットでの利用も可。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
'File/Folder Backuper
'- Created by LazwardFox -

'TargetFile Autobackup
'ドラッグ(パラメータ指定)されたファイルを、
'名称に年月日時分秒を付けて同じフォルダ内にコピーをとる

'Update 20090209 2035
'Release 20060712 1736 フォルダのコピーにも対応させ、正式発行
'DevStart 20060413 1026

'***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************

Set Parameters = WScript.Arguments 'パラメーター取得
If Parameters.Count <= 0 Then
Wscript.Quit
End If

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル制御

'***** ↓↓↓ Decralations ↓↓↓ *************************************************

Public Target, Source, ThisScript
Public Extention, NameOnly, ProcessFolder
Dim SourceFolder, SourceFiles, SourceFile, RNameOnly
Public Result

Dim BackupFile, strFiles, strResult, SettedPF

'***** ↓↓↓MainRoutine↓↓↓ *********************************************************
ThisScriptFull = Wscript.ScriptFullName
ThisScript = Fs.GetBaseName(ThisScriptFull)

For Each SourceFile in Parameters
BackupFile = BackupName(SourceFile )
If Extention = "" Then
Fs.CopyFolder SourceFile, BackupFile
Control = "FolderCopy"
Else
Fs.CopyFile SourceFile, BackupFile
Control = "FileCopy"
End If
'ResultMake '▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
If strResult = "" then
strResult = vbCrlf & "● " & ProcessFolder & "  " & vbCrlf
SettedPF = ProcessFolder
Else
If SettedPF = ProcessFolder Then
Else
SettedPF = ProcessFolder
strResult = strResult & vbCrlf & vbCrlf & "● " & ProcessFolder & "  " & vbCrlf
End If
End If
strResult = strResult & vbCrlf & "  " & NameOnly & "  " & vbCrlf & vbTab & " ▼  " & vbCrlf & "  " & vbTab & RNameOnly & "  " & vbCrlf
'▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
Next
Msgbox strResult,,ThisScript & " " & Control
Set Fs = Nothing
Set WSHShell = Nothing

Wscript.Quit

'***** ↓↓↓Functions↓↓↓ *********************************************************
'------------------------------------
'BackupName - バックアップ後の名称を構築
'- Created by LazwardFox -

'フルパスを返す
'結果表示用変数に値を代入
'NameOnly - ファイル名
'RNameOnly - 変換後ファイル名
'ファイル/フォルダの識別
'Extention - 値が空白で返されたら 対象はフォルダ

'注)完全な独立関数にはなっていない。

'Release 20060712 1743

Public Function BackupName(SourceName )
Dim FoldersFiles, FoldersCount, FileNamesEx, BlockCount, BackupString
FileNamesEx = Split(SourceName,".")
BlockCount = UBound(FileNamesEx)
If BlockCount > 0 Then 'File
Extention = "." & FileNamesEx(BlockCount)
Else 'Folder
Extention = ""
End If
BackupString = " " & iDT(""," ","",0) & Extention

FoldersFiles = Split(SourceName,"\")
FoldersCount = UBound(FoldersFiles)
If Extention = "" Then 'Folder
NameOnly = SourceName
ProcessFolder = SourceName
RNameOnly = SourceName & BackupString
BackupName = RNameOnly
Else 'File
NameOnly = FoldersFiles(FoldersCount)
ProcessFolder = Replace(SourceName, NameOnly, "")
BackupName = Replace(SourceName, Extention, BackupString)
RNameOnly = Replace(BackupName, ProcessFolder, "")
End If
End Function

Public Function FolderSelector()
OnFolder = UpdatesCopy()
For Each SourceFile In SourceFolder.SubFolders
Set SourceFolder = SourceFile
OnFolder = UpdatesCopy()
'▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
msgbox "2 - サブフォルダ数 - " & OnFolder,,ThisScript
'▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
If OnFolder = 0 Then
Else
Set LSourceFolder = SourceFolder
For Each tSourceFolder In LSourceFolder.SubFolders
Set SourceFolder = tSourceFolder
FolderSelector()
Set tSourceFolder = SourceFolder
Next
Set SourceFolder = LSourceFolder
End If
Next
End Function

'------------------------------------
'UpdatesCopy
'- Created by LazwardFox -

Public Function UpdatesCopy()
'▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
If SourceFolder.Files.Count = 0 Then
If SourceFolder.Name="" Then
FolderName = "Root"
Else
FolderName = SourceFolder.Name
End If
msgbox "3 - " & FolderName & vbCrLf & "対象フォルダにファイルが無い",,"UpdatesCopy"
Else
tResult = SourceFolder.name & " - " & SourceFolder.Files.Count & vbCrLf
End If
'▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲

For Each SourceFile In SourceFolder.Files
tResult = tResult & SourceFile.Path & vbcrlf
Next

'▼ Tester ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
tResult = Replace(tResult & "_", vbcrlf & "_","")
If Not tResult = "_" Then
msgbox "4 - ファイル一覧" & vbCrLf & tResult,,ThisScript
End If
'▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲

UpdatesCopy = SourceFolder.SubFolders.Count
End Function

'------------------------------------
'iDT - 日時文字列 ないし 日/時配列取得 for VBScript
'- Created by LazwardFox -


' Update 20090228 0458 変数宣言変更
' Update 20090223 0959 時刻桁処理変更
' Update 20090223 0253 Len記述忘れ修正
' Update 20090223 0135 変数宣言忘れ修正
' Update 20090210 0218
' Update 20090210 0115
' Release 20090209 2035

' iDT (
' dSplitter - DateSplitString (Normal - "/")
' ,dtSeparater - Date/Time SepaleteString (Normal - " ")
' ,tSplitter - TimeSplitString (Normal - ":")
' ,Control - 配列化 0 or 1 (Default - 1)
' )

Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)
Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458
nX = Now()
nD = FormatDateTime(Date(),0)
nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) 'Update 20090223 0951
strHMS = FormatDateTime(nX,4) & nS 'Update 20090223 0951
If tSplitter = ":" Then
Else
strHMS = Replace(strHMS,":",tSplitter)
End If
sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS
If Control = 1 Then
iDT = Split(sResult,"*")
Else
iDT = Replace(sResult,"*",dtSeparater)
End If
End Function


しかし、リリース2006年かぁ・・・(遠い目) ファイル文字列処理に初々しさがあるよねw

ちなみに、もっと程度の低い版なら、2004年にはあったw
更に前だとWinBatch版、もっと前はBatファイルだったなぁ・・・(更に遠い目)

もう、過去のHDDクラッシュで、ソース紛失してるケド^_^;
<そのまま使えるVBscript 日付 添付 バックアップ ファイル フォルダ>

WindowsScriptEncoderを便利に・・・


    このログは、コチラのログ も併読してください。     

----------------- [ Update 20090317 2113 ]
このログのスクリプトのアーカイブはコチラの版に差し替えました。


通常のWindowsアプリケーションの挙動なら、その本体やショートカットを作成し、
対象ファイルをドロップすれば、ソースファイルのあるフォルダに結果を返してくれそうなものだが、
WindowsScriptEncoderは、そのままでは、長いファイル名に対応できてない上、書式がカナリ厄介。

書式)
   "[インストール先]\screnc.exe" "対象ファイル.vbs" "エンコード後のファイル.vbe"    


   screnc.exe - エンコーダ本体    
レジストリにも所在が登録されてない上、
Pathも通ってないので、起動の際は要フルパス記述。
ショートカット作成時には、作業フォルダにパスを指定しておいたほうが無難だ。

[インストール先フォルダ]
既定は "C:\Program Files\Windows Script Encoder\" だと思う、多分・・・
少なくともウチの機器ではココだった。

{"対象ファイル.vbs"}
対象ソースとなるVBScriptファイルをフルパスで指定

{"エンコード後のファイル.vbe"}
任意のファイル名に拡張子.vbeを付けてフルパス指定


まず、エンコード後の名称を、フルパスで拡張子までキッチリ指定しないと正しく動作しないってのがヘン。
また、コンソールアプリなので、スペースを含んでいたり、長いファイル名は、
[ " ]ダブルクォーテーションで囲む必要がある。

このような仕様では、どうやったって、単純にショートカットを配し、ドロップして利用・・・ とはイかないワケだワ(´ヘ`;)
最終的に、内容がエンコードされて、拡張子が変わるだけでいいのに、何故こんな指定方法なのか・・・
(安易な不正アクセスを防ぐイミでは、有効かもしれないケド・・・)
結果のファイル名.vbeを、ソース.vbsと異なるようにしたい向きを除き、とてもユーザーフレンドリーとは云いがたい・・・

今回も使い方は、以下スクリプトをコピってテキストエディタに貼り、
VBSEncodeConnection.vbs として保存後、実行スクリプト保存フォルダを任意に作成し、ソコへ放り込んで、
ショートカットをデスクトップ他、使いやすい場所に配してください。

あとは、作成した.vbsファイルをまとめてドラッグするだけで利用できます。

エンコーダのインストール先は、スクリプト中の
   Const Enc = "C:\Program Files\Windows Script Encoder\screnc.exe"    
を書き換えれば、任意に変更可能です。

今回は、組み込み関数は一切ないデスw つか、要らないと云うほうが正しいカナ。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
'VBSEncodeConnection
'- Created by LazwardFox -

'パラメータ指定、ないし、vbsファイルドロップで、
'同一フォルダ上にエンコード済みファイル(.vbe)を作成する。
'このスクリプトのショートカットに対してドロップしても有効。
'テキストエディタなどのマクロに登録しての利用も可

'単独起動 - 無効

'Update 20090309 1901 発行向けに調整
'Update 20090210 0109
'Release 20050112 1213
'DevStart 20050111 2117

'***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************
Dim Args, Wsh, Fs

Set Args = WScript.Arguments 'パラメーター取得
If Args.Count <= 0 Then
Wscript.Quit
End If
Set Wsh = WScript.CreateObject("WScript.Shell")
Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル操作

'***** ↓↓↓Decralations↓↓↓ *********************************************************
Dim vbSp, vbTc, vbCt, vbWt, vbTs, vbCs
Dim tFile, Tf, Ef, Info, pTarget

Const vbWq = """"
Const Enc = "C:\Program Files\Windows Script Encoder\screnc.exe"

vbSp = " "
vbTc = vbTab & vbCrlf
vbCt = vbCrlf & vbTab
vbWt = vbWq & vbTab
vbTs = String(2,vbTab)
vbCs = String(2,vbCrLf)

'***** ↓↓↓MainRoutine↓↓↓ *********************************************************
For iC = 0 To Args.count - 1
tFile = Args(iC)
If Fs.FileExists(tFile) then
Ext = Fs.GetExtensionName(tFile)
If Lcase(Ext) = "vbs" Then
Tf = vbWq & tFile & vbWq
Ef = Replace(Tf,"." & Ext,".vbe")
Info = "Before" & vbCrlf & vbSp & Tf & vbSp & vbCrlf & vbCrlf & _
"After" & vbCrlf & vbSp & Ef & vbSp & vbCrlf
If Msgbox(Info, vbYesNo, "VBS Encode") = vbYes then
pTarget = vbWq & Enc & vbWq & " " & Tf & " " & Ef
Wsh.Run pTarget, 0
End If
End If
End If
Next
Set Args = Nothing
Set Fs = Nothing
Set Wsh = Nothing

Wscript.Quit



ま、ソコはソレ、不便なら、問題を解消する策を講じられる位でないと、
MS製品なんて使ってられんと云うコトで・・・w


とは云え、今回は手順も面倒なので、ソースとエンコード済みのファイルをDL出来るようにしてみました、
   VBSEncodeConnection.zip    
▲ を、右クリックしてファイルとして保存してください。

----------------- [ Update 20090317 2113 ]
このアーカイブはコチラの版に差し替えました。


今までのモノも、似た対応できたんだけど、面倒だったのでw
あと、セキュリティ的に、テキストのほうが安心できる人も多いかと思ったし・・・ (^_^;

ちなみに、エンコード後のファイルはバイナリ形式な上、既にヒトが読めるカタチになってません、
修正や改変は出来ないので、ソースは大事に保管してください。

また、エンコード後のファイル.vbeは、Web環境で利用する場合、
対応している対象がIEだけらしいとのレポートを読んだ記憶があります。(未確認、誤報なら嬉しいが・・・)
あくまで、ローカルでの運用に留めた方が無難かと思われます。


-----------
次回は、FileBackUpper.vbe辺りをソース込みで うp予定。
対象ファイルの名称を "[元FileName] yyyymmdd hhnnss.[拡張子]" に 変え、コピーを取るだけのモノ。
長いこと利用しているブツで、HTML/JavaScript/VBScript etc.. 版管理に威力を発揮している。
初期起動で、ファイル/フォルダ右クリックのコンテキストメニューに、
[バックアップ作成]を追加するようレジストリ設定を行える機能の追加版を用意する予定。
乞うご期待。
<そのまま使えるVBscript WindowsScriptEncoder 容易 使い方>