[VBScript] 共通関数ファイルを自動配布＋更新後にインクルード実行する 適用例

どーもボキです。

共通関数ファイルを自動配布＋更新後にインクルード実行を使えば、突発トラブル対応もカンタン

うちの会社限定になるかもしれないが、大半の設定情報をテキストファイル（INIフォーマット）で管理しているので、
突発のトラブル対応もスクリプトを使いこなせればカンタンにできる。

この連休での突発トラブル対応で開発したプログラム例

以下はブログ用に書き直したもの。ただ処理の流れはこのまま。
共通関数ファイルの自動配布＋更新＋インクルード実行をテンプレートにしているので、この程度なら数分で作れる。



処理の考え方

1. 起動時の引数の有無によって処理を分ける。
   
2. 修正前の設定ファイルをバックアップする。
3. 設定ファイルを修正する。
4. アプリを終了待ちで起動する。
5. アプリ終了後、バックアップしておいた設定ファイルで元に戻す。

ダウンロード


'──────────────────
Execute Include("D:\vbCommon.vbs")
'──────────────────

SetScriptHost("cscript")

' -----------------------------------
' 起動方法ごとに処理を分ける
' -----------------------------------
If WScript.Arguments.Count = 0 Then
    ' VBSの単独実行
    dname = InputBox("データ名をいれてください。", WScript.ScriptName, "")
    If dname = "" Then WScript.Quit
    
    dpth = DataNameToDataFolder(dname)
Else
    ' フォルダドロップ
    dpth = WScript.Arguments(0) & "\"
    If Not objFS.FolderExists(dpth) Then WScript.Quit MsgBox("フォルダをドロップください。", vbInformation, WScript.ScriptName)
End If

' -----------------------------------
' 設定ファイルのバックアップ
' -----------------------------------
fpth_ini = dpth & "設定ファイル名"
If objFS.FileExists(fpth_ini) Then WScript.Quit MsgBox("データが見つかりません。", vbInformation, WScript.ScriptName)

fpth_backup = fpth_ini & "_backup"
If Not objFS.FileExists(fpth_backup) Then objFS.CopyFile fpth_ini, fpth_backup

' -----------------------------------
' 設定ファイルの書き換え
' -----------------------------------
Set ini = New TIniFile
ini.Load fpth_ini
ini.WriteValue "Section", "Key", 0  ' 設定データを0に書き換える

' -----------------------------------
' アプリの起動設定
' -----------------------------------
objWS.Run "アプリのフルパス", 1, True ' 終了待ちでアプリを起動する

' -----------------------------------
' バックアップを元に戻す
' -----------------------------------
objFS.CopyFile fpth_backup, fpth_ini
objFS.DeleteFile fpth_backup


' -------------------------------------------------------------------------------
' データ名からデータフォルダを取得する
' -------------------------------------------------------------------------------
Function DataNameToDataFolder(DataName)
    DataNameToDataFolder = "データフォルダパス"
End Function

' ===============================================================================
' サーバソースの最新版取得＆ソース展開
' ===============================================================================
Private Function Include(FPath_Include)
    Const cServerIP = "127.0.0.1"
    
    Dim objWS: Set objWS = CreateObject("WScript.Shell")
    Dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
    
    Dim fpth_t: fpth_t = FPath_Include
    Dim fname : fname  = objFS.GetFileName(fpth_t)
    Dim fpth_f: fpth_f = "\\" & cServerIP & "\vbs\" & fname
::::Do
    ' ---------------------------------------------------------------------------
    ' スクリプトホストチェック
    If InStr(LCase(WScript.FullName), "wscript") = 0 Then Exit Do ' wscript実行でない
    ' ---------------------------------------------------------------------------
    ' サーバ通信チェック
    If objWS.Run("cmd /c ping " & cServerIP & " -w 500 -n 1", 0, True) <> 0 Then Exit Do    ' 通信できない
    ' ---------------------------------------------------------------------------
    ' サーバ上の管理フォルダ存在チェック
    If Not objFS.FolderExists(objFS.GetParentFolderName(fpth_f)) Then Exit Do ' 管理フォルダがない
    ' ---------------------------------------------------------------------------
    ' サーバ上の管理ファイル存在チェック
    If Not objFS.FileExists(fpth_f) Then Exit Do    ' 管理ファイルがない
    ' ---------------------------------------------------------------------------
    ' 更新日時チェック
    If objFS.FileExists(fpth_t) Then
        If objFS.GetFile(fpth_f).DateLastModified <= objFS.GetFile(fpth_t).DateLastModified Then Exit Do    ' 更新日時が同じ・古い
    End If
    ' ---------------------------------------------------------------------------
    ' サーバファイルをコピー準備
    objWS.Run "cmd /c md """ & objFS.GetParentFolderName(fpth_t) & """", 0, True    ' コピー先フォルダを階層ごと作成
       
    ' サーバファイルをコピー実行
    On Error Resume Next
    objFS.CopyFile fpth_f, fpth_t, True
    
    If Err Then
        ' サーバファイルをコピー実行（実行スクリプトと同じ位置）
        objFS.CopyFile fpth_f, objFS.GetParentFolderName(WScript.ScriptFullName) & "\" & fname, True
    End If
    On Error Goto 0
    
::::Loop Until 1
    
    ' 指定フォルダ・カレントフォルダのチェック
    If Not objFS.FileExists(fpth_t) Then
        ' VBS保存フォルダパスへ変更
        fpth_t = objFS.GetParentFolderName(WScript.ScriptFullName) & "\" & fname   ' ドロップではカレントが変わるためフルパスを指定
    End If
    If Not objFS.FileExists(fpth_t) Then WScript.Quit MsgBox(fname & "がありません", vbCritical, cTitle)
    
    Include = objFS.OpenTextFile(fpth_t).ReadAll()
End Function
' -------------------------------------------------------------------------------

この記事での気付き

この処理を書いた時、ネットワーク上のiniファイルの書き換えに10秒前かかっていることに気付いた。
この10数秒の処理時間は、数kBのテキストファイルとしては長すぎる。
まずはトラブル対応を優先すべく、ローカルにコピーして編集したものをアップロードさせることで時短した。

トラブル対応後に時間がかかる原因を調べると、TIniFileやTListクラスのファイル更新処理が一行ずつになっていたので、
一気に書きだすように変更。ネットワーク上のiniファイルも瞬時に更新できるようになった。

この変更はvbCommonにも反映済み。

10数秒程度なら問題ならないのでは？と考える人の方が多いかもしれないが、データ数が増えるとこの数秒の差が大きな時間差になる。



Set file = FobjFS.OpenTextFile(FPath, 2, True)
For i = 0 To UBound(FItems)
    file.WriteLine FItems(i)
Next
file.Close

↓こう変えた↓


Set file = FobjFS.OpenTextFile(FPath, 2, True)
file.Write Join(FItems, vbCrLf)
file.Close

にほんブログ村