【VBS】Format関数の@書式を作ってみた

  • 0
    Like
  • 0
    Comment

    はじめに

    現在、運用チームに属しているので.NETよりWSH(VBScript)や改修作業でレガシーASPで組むことが多いです。どうしてもPowerShellが馴染めないんですよね。

    VBScriptを使用していて不満点が多くあるけど、その中でもFormat関数が貧弱なところがとても不便です。
    下記のようにFormatXXXXXと機能ごとに分割されてしまっている。
    * FormatDateTime関数
    * FormatCurrency 関数
    * FormatNumber 関数
    * FormatPercent 関数

    FormatDateTime関数は日時を書式文字列化して返却する関数ですが、時刻が0埋めにならないなど使いにくい。また、地域のプロパティに影響してしまうので西暦が2桁になることもありえてしまう。

    まだ開発途中ですが、Format関数もどきを出来るだけ短くて使えるものにしようと思っています。

    経緯

    ファイル名などに区切りなしの日時を付けることはよくあります。
    下記のコードにすればいいですね。

    Dim strFormattedDate, strDate, dtNow
    
    'yyyy/MM/dd HH:mm:ss を yyyyMMddHHmmss に変換
    dtNow = Now
    strDate = FormatDateTime(dtNow, vbShortDate) & " " & Right("0" & FormatDateTime(dtNow, vbLongTime),8)
    strFormattedDate = Replace(Replace(Replace(strDate, "/", ""), ":", ""), " ", "")
    

    今回やりたいのは逆で、yyyyMMddHHmmss を yyyy/MM/dd HH: mm:ss に変換したい。もちろんMID関数などで分割すれば出来るのは分かっているのですが、どうせなら今後のためにも汎用的なFormat関数を作ってみようと思った次第です。
    ただあまり本格的なFormat関数を作成すると長くなってしまうので適度なものにしようと思ったところ、VB6 Format 関数の「@」書式を思い出しました。

    余談

    電子メールが広まって「@」がよく使用されるようになりましたが、それ以前はキーボードにあるけど入力することがほとんど無かったんです。そのようなことに疑問をもって以前書いてみましたので、よろしかったらご覧ください。
    @ アットマークにまつわるお話

    書式「@」と[は

    書式 意味
    @ 1つの文字またはスペースを表します。値の中で、@ (アットマーク)にる置に文字が存在する場合は、その文字が表示されます。文字がなければスペースが表示されます。@は、指定した書式の中に表示書式指定文字の ! (感嘆符) がない限り、右から左の順に埋められます。
    ! 文字を右から左ではなく、左から右の順に埋めていくように指定します。この文字を指定しない場合は、右から左の順に埋められます。
    result = Format( "ABC", "@@@@@" )    '→ "□□ABC" ※□は半角スペース
    result = Format( "ABC", "!@@@@@" )   '→ "ABC□□" ※□は半角スペース
    

    使用例

    あるプロセスが本来数分で処理が終わるのですが、何らかの原因でプロセスが残ったまま正常に処理が行われない現象が発生したので、プロセス監視として起動してから10分以上経っていたら警告のメールを送信するみたいなことがありました。

    '10分以上前のTest.exeが存在するか +540はグリニッジGMTから日本の場合+9時間
    sql = "Select * From Win32_Process Where Name = 'Test.exe'"
    sql = sql & " And CreationDate < '" & GetWMIDate(DateAdd("n", -10, Now),"+540") & "'"
    Set oClassSet = oService.ExecQuery(sql)
    
    result = 0 '存在なし
    'コレクションを解析する。
    logString = ""
    
    i = 0
    For Each oClass In oClassSet
        If Not IsNull(oClass.CreationDate) Then
            result = 1 '存在あり
            logString = logString & Now & " 開始時刻:" & FormatAt(oClass.CreationDate,"!@@@@/@@/@@ @@:@@:@@")
            logString = logString & ",プロセスID:" & oClass.ProcessId & ",コマンドライン:" & oClass.CommandLine & vbCrLf
            ReDim Preserve aryList(i)
            aryList(i) = oClass.ProcessId
            i = i + 1
        End If
    Next
    

    CreationDateではミリ秒+540とグリニッジGMTも含めた値を返してくるので、日時形式でログ出力させたい。「!」があるのは、デフォルトが右から左の順なので左から右の順にするためです。

    '2016/12/15 17:37:38 に変換
    MsgBox FormatAt("20161215173738.795112+540", "!@@@@/@@/@@ @@:@@:@@")
    

    ソースコード

    Function FormatAt(target, formatString)
        Const PlaceMark = "@"
        Dim pattern, str, place, i, j, flag, length, pad, value 
    
        FormatAt = target  
    
        pattern = ""
        replacement = ""
        flag = False
        If Instr(formatString, "!") = 1 Then
            flag = True
            formatString = Mid(formatString, 2) 
        End If
    
        j = 0
        For i = 1 To Len(formatString)
            place = Mid(formatString, i, 1)
            If place = PlaceMark Then
                j = j + 1 
                pattern = pattern & "(.)"
                replacement = replacement & "$" & j
            Else
                replacement = replacement & place
            End If
        Next
    
        If j > 0 Then
            length = Len(formatString)
            pad = Space(length)
            value = FormatRegex(target, pattern, replacement, False)
            If flag Then
                FormatAt = Left(value & pad, length)
            Else
                FormatAt = Right(pad & value, length)
            End If
        End If
    
    End Function
    
    Function FormatRegex(target, pattern, replacement, isGlobal)
        Dim reg, matches, match
    
        FormatRegex = target
    
        Set reg = CreateObject("VBScript.RegExp")
        reg.Global = isGlobal
        reg.IgnoreCase = True
    
        reg.Pattern = pattern
        Set matches = reg.Execute(target)
        If matches.Count > 0 Then
            FormatRegex = reg.Replace(target, replacement)
        End If
        Set matches = Nothing
    
        Set reg = Nothing
    End Function
    

    ライセンスっぽいこと

    コード改変や配布は自由です。
    このツールによる義務/責任を何ら負いません。

    最後に

    もう少し改良して、0埋めに対応したいと思っています。

    VBSのFormatもVal関数と組み合わせれば、もう少しマシになりそうです。
    【VBS】Val関数もどきを作ってみた

    This post is the No.15 article of Visual Basic Advent Calendar 2016