趣味プログラミングblog

今回は珍しくバッチファイル。

不定期にリリースフォルダのファイルを差し替える作業が発生していて
それを自動化した。


手動での作業手順は以下の通り。
①配置用のファイル名を見て、リリース先を確認。
②リリースフォルダのファイルをローカルにバックアップ（ファイル名変更）
③配置用ファイルをリリースフォルダに上書きコピー

たったこれだけの作業ではあるけれど、
リリース関係の作業は失敗するとやばいのでMP消費が激しい。

いつもならVBScriptで作るところだけど、
ファイルのコピーはコマンドプロンプトで一発でできるので、
今回はバッチファイルで作ることにした。

前回の洗濯機修理の続き。

ベルトが外れてエラーが出たので応急処置として、ベルトをはめるとこまでは良かった。

交換用の部品を調べて注文。待ちを短くするため同じものを別サイトで購入。
木曜の深夜に注文して、日曜に届いた。もう一つは木曜到着。

会社帰りにバドミントン行って帰ってきたら、洗濯機が壊れてた。

画面の表示はHと57を交互に表示。
取説みたらコンセントを抜いて販売店に連絡せよだって。

コンセントって、電源系がやばい？？

A5アプリを使っているんだけど、
データベースからCSVファイルを抽出するときに、
タイトル行を出力するかしないかオプションで選択できる。

設定すると次回抽出するときに保持されるので、
たまにタイトル行が不要なときにめんどくさい。

あと、たくさんのCSVファイルを抽出するのに
いちいちファイル名を正しく入力するのもめんどくさい。


めんどくさがりな自分のために、
CSVファイルのタイトル行を削除して、特定のファイル名に変更するスクリプトを作った。

これまで作ったVBScriptとあんまり変わんないけど、
ドラッグドロップを使って進捗状況を表示する機能は
一般的に使えそうなので投稿。

当初は、テキストの内容をバッファに保持して、
まとめてテキストに書き込む作りにしていたけど、
CSVファイルの行数が多いと遅くなるので
読みだした文字列をそのまま出力ファイルに送る仕様にした。

圧倒的に速い！！！

以下、ソース。ソーステキストは こちら。

Option Explicit

'ファイルドロップ共通モジュール　起動条件で分岐してメイン処理を呼ぶ
call FileDrop()

'ファイルをドロップした場合
sub Main_File(strFullName)

if right(strFullName, 4) <> ".csv" then call errorEnd("CSV以外のファイルは対応していません。")

dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim inputFile: Set inputFile = FSO.OpenTextFile(strFullName, 1, False, 0)
dim strHead: strHead =inputFile.ReadLine 'タイトル行は別名で読みだして捨てる

'出力フォルダは、ファイルと同じ階層にoutputフォルダを作る
Dim outPath: outPath = getPath(strFullName) & "output\"
call makeFolder(outPath)

'出力ファイル名は、フルパスからファイル名を取り出して、makeNewname関数を通す
dim outName: outName = makeNewname(getFileName(strFullName))
dim outputFile : set outputFile = FSO.OpenTextFile(outPath & outName , 2, True)

'読みだした文字列をそのまま書き込む（バッファに入れると遅くなる）
Do Until inputFile.AtEndOfStream
outputFile.write inputFile.ReadLine & chr(10)
Loop

inputFile.Close' バッファを Flush してファイルを閉じる
outputFile.Close' バッファを Flush してファイルを閉じる
set FSO = nothing

end sub

Function getPath(strFullName)
dim fileName : fileName = getFileName(strFullName)
dim filePath : filePath =left(strFullName,len(strFullName)-len(fileName))
getPath = filePath
end function

Function getFileName(FileName )
Dim yPos
yPos = InStrRev(FileName, "\")
If yPos <> 0 Then
getFileName = Right(FileName, Len(FileName) - yPos)
Else
getFileName = ""
End If
End Function

'特定ファイルは固定名、他は"_delTitle"を追加
function makeNewname(fName)
dim outName
dim baseName : baseName = replace(fName,".csv","")
select case baseName
case "1": outName = "A.csv"
case "2": outName = "B.csv"
case "3": outName = "C.csv"
case else : outName = baseName & "_delTitle.csv"
end select
makeNewname = outName
end function

'ファイルドロップ共通'-----------------------------------------------------------ここから
sub FileDrop
'ファイルドロップ共通モジュール　ファイルならメイン処理を呼ぶ
dim strFileName, strFullName
dim cnt, prgPath:prgPath = getPath(Wscript.scriptFullname) '進捗表示用

If WScript.Arguments.count = 0 then '引数なし
call Main_noFile()
else '引数ありの場合
with CreateObject("Scripting.FileSystemObject")
for each strFullName In WScript.Arguments
cnt = cnt + 1
call outputProgress(cnt & "件／" & WScript.Arguments.count,prgPath)'プログレス表示

If .FolderExists(strFullName) then ' is folder.
call Main_Folder(strFullName)
ElseIf .FileExists(strFullName) then' is file.
Call Main_Filer(strFullName)
else ' is unknown.
call errorEnd("謎のデータがドロップされました。終了します。")
End If
Next
end with
end if
call outputProgress("",prgPath)'プログレス表示
msgbox cnt & "件のファイルのタイトル行を削除しました。"
end sub

sub Main_noFile()'VBSを直接実行した場合
call errorEnd("リネーム対象のファイルをドラッグドロップしてください。")
end sub

sub Main_Folder(strFullName)'フォルダをドロップした場合
call errorEnd("フォルダは対象外です。リネーム対象のファイルをドラッグドロップしてください。")
end sub
'ファイルドロップ共通'-----------------------------------------------------------ここまで

'フォルダがなければ作る。あればメッセを出す
sub makeFolder(DirName)
dim objFS,str_path
' ファイルストリーム・オブジェクト生成
Set objFS = CreateObject("Scripting.FileSystemObject")

If objFS.FolderExists(DirName) Then
'msgbox "すでにフォルダが存在します"
else
' フォルダを生成する
str_path = objFS.CreateFolder(DirName)
end if
end sub

'エラーメッセージを表示して終了する
sub ErrorEnd(msg)
set FSO = nothing
WScript.Echo msg
WScript.Quit
end sub


'プログレス表示ファイル
sub outputProgress(text,oPath)
call deletePrgrsFile(oPath)
if text <> "" then call makePrgrsFile(text,oPath)
end sub

private sub deletePrgrsFile(oPath)
on error resume next
dim tarFile:tarFile = oPath & "*.prgrs"
with CreateObject("Scripting.FileSystemObject")
.DeleteFile tarFile
end with
end sub

private Sub makePrgrsFile(text,oPath)
dim strNow: strNow = replace(now,"/","")
dim strFile: strFile = oPath & "VBS進行率：" & text & ".prgrs"

dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
dim obfFile : Set obfFile = objFS.CreateTextFile(strFile) ' ファイル作成
set objFS = nothing
set obfFile = nothing
end sub

サーバーの監視といえば、異常発生時に監視用のパソコンでアラームが鳴るのが一般的だと思う。

サーバーの移転とかがあると、監視員と監視用PCが別拠点にあって
リモートデスクトップ（RDP)で監視するパターンもある。

そこで問題になるのが、RDPだと静かに接続が切れて監視できていないことに気付かないこと。


今回は、リモートデスクトップ先のPCとの疎通確認をして、異常時にブザーを鳴らすバッチファイルについて。

先に白状すると、９割がネットからパクったソース。
ping監視に関する動作は、そのまま移植させてもらった。
世の中には同じことを考えることが多いこと。