アナログCPU:5108843109

ゲームと音楽とプログラミング(酒と女とロックンロールのノリで)

('ω') < イザユケエンジニャー

複数のファイルをフォルダごとコピーするスクリプト

今の現場、開発サーバーにソースコード上げる作業がかなりめんどくさいので、ちょっとだけスクリプト化しました。

gitにコミットしても自動で反映されるわけじゃない。
しかもFTPとかじゃなくてリモート接続。

なので、

  • サーバー側の変更対象ファイルをバックアップしておく
  • バックアップしたファイルとローカル側のファイルを差分チェックする
  • ローカル側のファイルをサーバーに設置する
  • 動作確認とかする
  • 場合によっては元に戻したりする

とかいう手順を踏むわけです。

このうちサーバー側の必要ファイルバックアップと、ローカルからサーバーに持っていくファイルを抽出する作業が地味にめんどくさいのですが
この二つの作業が大体同じなので、その部分だけスクリプト化してみました。
ローカルもサーバーもWindowsなのでまあVBSで。

やっていることは、「テキストファイルに一覧化したファイルを全部コピーして、フォルダ構造も再現しつつ指定したフォルダにペースト」です。
例えば、

C:\hoge\fuga\a.txt
C:\hoge\piyo\b.txt

というリストを作り、「C:\backup\」にコピーするようにしてスクリプトを実行すると、

C:\backup\hoge\fuga\a.txt
C:\backup\hoge\piyo\b.txt

にコピーされてくる、という感じです。
フォルダ階層が深いときはコピー先も無駄に深くなるけど…。

これさえあれば、このスクリプトでバックアップ対象と更新対象を抽出して、そのフォルダごとWinmergeで確認して、更新対象フォルダをサーバー側に放り込むだけで済みます。
もちろん元に戻すときはバックアップしておいたフォルダを放り込むだけ。
(とはいえフォルダを放り込むだけなので、更新にしろ元に戻すときにしろ、削除が発生する部分は手作業ですが…)

使い方

  • テキストファイルに、コピーしたいファイルをフルパスの改行区切りで並べておく
  • そのテキストファイルのパスと、コピー先のディレクトリパスを下記スクリプト内で設定する
  • スクリプト実行

プログラム

Option Explicit
On Error Resume Next

Dim root_dir
Dim copy_dir_path
Dim copy_file_list_path
Dim dir_separator

' 現在のディレクトリパス
root_dir = createObject("Scripting.FileSystemObject").getParentFolderName(WScript.ScriptFullName)

'=================================
' 設定エリア
'=================================
' ディレクトリの区切り記号
' (ディレクトリパス、ファイルパスなどで共通になるようにしてください)
dir_separator = "\"

' コピー先ディレクトリの名前(フルパス)
copy_dir_path = root_dir + dir_separator + "tmp"

' コピーするファイルの一覧を記載したファイルの名前(フルパス)
copy_file_list_path = root_dir + dir_separator + "local_反映ファイルリスト.txt"
'=================================

Dim copy_file_list
Dim i

' コピー先のディレクトリ作成
If mkdir(copy_dir_path, False) = False Then
	MsgBox("コピー先のフォルダ作成に失敗しました")
	WScript.Quit
End If

' ファイル一覧の読み込み
copy_file_list = convertTextToArray(copy_file_list_path)
If IsArray(copy_file_list) = False Then
	MsgBox("ファイル一覧の読み込みに失敗しました")
	WScript.Quit
End If

' ファイルのコピー
For i = 0 To UBound(copy_file_list)
	If filecopy(copy_dir_path, copy_file_list(i), dir_separator) = False Then
		MsgBox("コピーに失敗したファイルがあります")
		WScript.Quit
	End If
Next

MsgBox("処理が正常に完了しました")

''' ---------------------------------
''' メイン処理ここまで!!!
''' ---------------------------------

' ディレクトリを作る関数(引数は作るディレクトリのフルパスと、既にそのディレクトリが存在するときに無視するフラグ)
Private Function mkdir(ByVal path, ByVal ignore_duplicate)

	Dim fso ' FileSystemObject
	Set fso = WScript.CreateObject("Scripting.FileSystemObject")
	If Err.Number <> 0 Then
		mkdir = False
		Exit Function
	End If

	If fso.FolderExists(path) = True Then
		mkdir = ignore_duplicate
		Exit Function
	Else
		fso.CreateFolder(path)
		If Err.Number <> 0 Then
			mkdir = False
			Exit Function
		End If
	End If

	mkdir = True
End Function

' テキストファイルの中身を1行ずつ配列化する関数(引数はテキストファイルのフルパス)
Private Function convertTextToArray(ByVal path)

	Dim path_list()
	Dim cursor
	Dim tmpstr
	Dim i

	Dim fso ' FileSystemObject
	Set fso = WScript.CreateObject("Scripting.FileSystemObject")
	If Err.Number <> 0 Then
		convertTextToArray = False
		Exit Function
	End If

	Dim file
	Set file = fso.OpenTextFile(path, 1, False)
	If Err.Number <> 0 Then
		convertTextToArray = False
		Exit Function
	End If
	cursor = 0
	Do Until file.AtEndOfStream
		tmpstr = file.ReadLine
		If tmpstr <> "" Then
			ReDim Preserve path_list(cursor)
			path_list(cursor) = tmpstr
			cursor = cursor + 1
		End If
	Loop
	file.Close

	convertTextToArray = path_list
End Function

' ファイルをディレクトリ構造を維持してコピーする関数(引数はコピー先ディレクトリ、コピーしたいファイル、パスの区切り文字)
' 例えば「C:\hoge」「C:\fuga\piyo\foooo.txt」「\」を渡すと、「C:\hoge\fuga\piyo\foooo.txt」ができます
' ※上記mkdirをコールしています
Private Function filecopy(ByVal dirpath, ByVal filepath, ByVal dir_separator)

	Dim layer
	Dim tmpdirpath
	Dim tmpfrom
	Dim tmpto
	Dim i

	layer = Split(filepath, dir_separator)
	If UBound(layer) < 1 Then
		filecopy = False
		Exit Function
	End If

	tmpdirpath = dirpath
	For i = 1 To UBound(layer) - 1
		If mkdir(tmpdirpath + dir_separator + layer(i), True) = False Then
			filecopy = False
			Exit Function
		End If
		tmpdirpath = tmpdirpath + dir_separator + layer(i)
	Next

	Dim fso ' FileSystemObject
	Set fso = WScript.CreateObject("Scripting.FileSystemObject")
	tmpfrom = filepath
	tmpto   = tmpdirpath + dir_separator + layer(UBound(layer))

	Call fso.CopyFile(tmpfrom, tmpto)
	If Err.Number <> 0 Then
		filecopy = False
		Exit Function
	End If

	filecopy = True
End Function