Batch file to VBScript file (13)		at 1999.Dec.04
3.10 文法拡張のあがき
　ごちゃごちゃ書いてきましたが、実はVBScriptをもっともっと使おうとすると
　ほとんど致命的とも言える問題が見えてくる。
　今回が「13」だから、つまりキリスト教徒には不幸な数字である。ということは
　さておいて(偶然です)。

　VBSって、html(というかdhtml)に貼りつけないとどうにもならないみたい。
　例えば、スクリプトコンポーネントにすると、VBSレベルでCOMが作れて、つまり
　任意のテキストファイルからクラッキングしてあくどい事が何でもできる……？
　ごほごほ。

　そーぢゃなくて。Windows の癌、レジストリを太らすようなことをしないとダメって
　のはあたしゃ生理的に受けつけないので却下として(^^;;

　(忘れている人がいると困るが、この連載はVBSをバッチの代わりに使うというのが
　 主眼であって、Excelを制御しようとか、HTMLで利用しようというかいう観点は
　 微塵もないのだ)

　…ではどうするか。

　仕掛けを考えた。要するにプリプロセッサである。#include "hogehoge.vbs"と
　ソースに書いておけば、実行時にhogehoge.vbsをその行に挿入して実行する。
　というもの(あたしはCな人なのです。実は)。

　こうすれば汎用サブルーチン群は使い回しができる！メンテナンスも簡単。
　って訳。

------- WSH V2.0での拡張 -------
Windows 2000だと、WSH V2.0ってのが使えて、それだと例えば：
<package>
<job id="test">
<script language="JScript">
	WScript.Echo("This is JScript"); 
</script>
</job>
</package>
というような*.wsfファイルをそのまま実行できるんで、include fileをどうするか、
という問題は解消されるみたい。この例だけだと良く分からないですが、要するにhtmlを
そのまま実行できると思えば良いような(すっげーはしょった言い方だけど)。
＃要するに、<script src='./hogehoge.vbs'></script>とかでincludeできる
-------

・小細工の仕組み
　1. ソースのどこかに行頭*1から「#include "hogehoge.vbs"」と書いて共用サブルーチン
　　 の使用を宣言しておく(例としてfoo.vbsとする)
　2. foo.vbsを実行する時は必ずショートカットから実行するものと自分で決めておく
　3. ショートカット自体はプリプロセッサ(vbpp.vbs)を起動し、その引数としてfoo.vbs
　　 を与えるようにする
　4. 起動したプリプロセッサはfoo.vbsファイルにある「#include」を見つける度に指定
　　 のファイルを「#include」の行に挿入する。ちなみに、hogehoge.vbsはプリプロセッサ
　　 が存在するフォルダの下にあるlib*2というサブフォルダの中に格納されていると仮定
　5. プリプロセッサは挿入後の新foo.vbsをWindowsのテンポラリフォルダ内に生成する
　　 (名前はOSに決めさせるので、foo.vbsという名前にはならないけど*3)
　6. プリプロセッサは自分が作成したその.vbsを実行する
　7. 実行終了後、プリプロセッサは作成した.vbsを消去し、証拠隠滅する

*1 何故行頭なのか、は単に手抜きが理由です。妙な所に凝っても意義ないですから
*2 フォルダ名をlibにしたのは気分です。深い意味はありません。また、共用なのか
　 ローカルなのかで「#include <foo.vbs>」と「#include "bar.vbs"」を区別
　 する、という案も却下しました。いや、面倒なので(^^;;
*3 テンポラリフォルダに「foo.vbs」を生成させる案は却下。ランダムにOSが決める名前の
　 ままにしておかないと、foo.vbsを(プリプロセッサを使用して)多重起動した時に破綻
　 しますから

　プリプロセッサはvbpp.vbsという名前で作りました。結構苦労したけど(^^;;
　…この苦労もWSH V2.0を使うと上にちょっと書いたように無意味のようですが(;_;)、
　Win9xにWSH V2.0ってのは未だなようなので暫くは個人的にこの方法を使うんでしょう。

　…できたテンポラリなVBS内でエラーがあると、とってもデバッグに苦労するん
　だけど、これ以上の解決策は思いつきませんでした。

　・プリプロセッサはこんな感じです。下の[Show full]ボタンを押してくださいね。
(押すと、意味もなくテイル・リカージョン*1をしている純JavaScript*2でPritty-Print
します。NC 4.6以降の方はCtrl-Rで再描画させると吉です。IE4以降の方、表示が遅いのは
IEだからです。そしてNCとは異なり、F5で再描画させると不幸になるかもです。IE3以下や
NN3以下はだめでした。またJavaScriptが動かない、禁止している方は御免なさい。
後、NCでは行が長くなると強制的に改行が挿入されるので、表示がおかしくなります。)

*1 テイル・リカージョンってのは、まずいプログラムの見本の一つ(^^;; lispコンパイラ
　なら勝手にこれを判定して自動的にループに書き直したりします(lisp以外のコンパイラ
　でも今時分のはやってたりして……)。
*2 …嘘ではないけど、実はこのhtmlがtextareaのNetscape拡張である、wrap=hardを指定
　してたりする(IEでも動作するが、標準のhtmlではありません)

　　　→ すげー手抜きがあります。が、そこをケアするようなコーディングに意味が
　　　　 あるとは思えないので……(開き直り。かも)

　で、共通ルーチンとしてどんなサブルーチンを作ったかというと：
　・例えば.iniの読み書きを行うものはこんな感じです

　inictrl.vbs 

' =====================================================================
'  .INI Read/Write Controls
'
' Exports definitions
'Function readIni(
'	sSection As String,	' '[', ']' not needs
'	sValue As String,
'	sDefault As String
') As String
'
'Function writeIni(
'	sSection As Stinrg,
'	sValue As String,
'	sData As String
') As Boolean
'
' Note:
'	- INIPATH is the full path of .ini file
'	- Section or Value names are not case sensitive
'	- Value comments will be remain
'	- Comments: tab or ';'
'
' Cautions (bugs):
'	- 例えば読み取った値を整数として使いたいならCInt()をかませる
'	　こと。さもないとIf 7 = 7 でElseの方に分岐するぞ！
'	- 真っ当な.INIを食わせればそれなりの結果が得られるが、そうでない
'	　場合は何がどうなっても知らない。パーザ部が手抜きだからね。
'	　基本的に理解できない行は無視。コメントとみなすという方針
'	- セクションやバリューを消す機能がない(^^;
'
' History:
'  V1.0 99.Jun.09 Create
'  V1.1 99.Jun.28 .INIが存在しなかった場合でもエラーにならないようにした
'  V1.2 99.Jun.30 setIniPath()で設定されていたパスを戻すようにした

' ---------------------------------------------------------------------
Private Const GINIPATH = "C:\Program Files\usr.ini"	' Default
Dim INIPATH
INIPATH = GINIPATH

' ---------------------------------------------------------------------
'  Set .INI pathname
'
Function setIniPath(sPath)
  setIniPath = INIPATH
  If sPath = "" Then INIPATH = GINIPATH Else INIPATH = sPath
End Function

' ---------------------------------------------------------------------
'  Generate section name
'
Private Function getSect(sSect)
  getSect = "[" & Trim(sSect) & "]"
End Function

' ---------------------------------------------------------------------
'  Given line is the start line of my section?
'
Private Function isMySection(ByVal s, sSection)
  isMySection = False

  s = Left(s, InStr(2, s, "]"))
  'If s = "" Then MsgBox "']' expected!": Wscript.Quit
  If StrComp(LCase(s), LCase(sSection)) = 0 Then
    isMySection = True
  End If
End Function

' ---------------------------------------------------------------------
'  Truncate trailing comment
'
'  in: s ; Read Line
'      c ; comment delimiter
'  ret:Headling Read Line
'
Private Function trtrComm(ByVal s, c)
  Dim i

  i = InStr(1, s, c)
  If i <> 0 Then s = Left(s, i-1)
  trtrComm = s
End Function

' ---------------------------------------------------------------------
'  Get commects
'
'  in: s	; "foobar ; comments"
'  ret:comments	; "; comments"
'
Private Function getComm(ByVal s)
  Dim i, j

  i = InStr(1, s, ";"): j = InStr(1, s, vbTab)
  If i = 0 Then i = j
  If (i <> 0) And (j <> 0) Then If i > j Then i = j
  If i <> 0 Then s = Mid(s, i) Else s = ""
  getComm = s
End Function

' ---------------------------------------------------------------------
'  Truncate trailing comments from value
'
'  in: s	; "foobar ; comments"
'  ret:data	; "foobar"
'
Private Function trunkTrail(ByVal s)
  s = trtrComm(s, vbTab): s = trtrComm(s, ";")
  trunkTrail = RTrim(s)
End Function

' ---------------------------------------------------------------------
'  Given line is my value?
'  in: s      ; Read Line
'      sValue ; Value name
'  out:ss     ; String after '='
'  ret:True = MyValue, False = Other
'
Private Function isMyValue(s, sValue, ss)
  Dim t, i
  isMyValue = False

  i = InStr(2, s, "=")
  If i = 0 Then Exit Function
  t = Trim(Left(s, i-1))
  If StrComp(LCase(t), LCase(sValue)) = 0 Then
    isMyValue = True
    ss = LTrim(Mid(s, i+1))
  End If
End Function

' =====================================================================
'　初期化ファイルからデータを読む
'　in: sSection	; セクション名
'　　　sValue	; バリュー名
'　　　sDefault	; データが読めなかった場合のデフォルト値
'　ret:バリュー値
'
'  Note: Read data as follows
'    [sSection]
'    sValue = sDefault
'
Function readIni(ByVal sSection, ByVal sValue, sDefault)
  Dim fso, fs

  If sSection = "" Or sValue = "" Then Exit Function

  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set fs = fso.OpenTextFile(INIPATH, 1)
  If Err = 53 Then readIni = sDefault: Exit Function	' File not found
  'Call errTrap(FILEOPEN, INIPATH)

  sSection = getSect(sSection)
  sValue = Trim(sValue)

  readIni = sDefault
  Dim s, ss
  Do Until fs.AtEndOfStream
    s = fs.ReadLine
    If Left(s, 1) = "[" Then
      If isMySection(s, sSection) Then
        Do Until fs.AtEndOfStream
          s = fs.ReadLine
          If Left(s, 1) = "[" Then Exit Do ' Value not found
          If isMyValue(s, sValue, ss) Then
            readIni = trunkTrail(ss): Exit Do
          End If
        Loop
        Exit Do
      End If
    End If
  Loop
  fs.Close
End Function

' =====================================================================
'　初期化ファイルにデータを書く
'　in: sSection	; セクション名
'　　　sValue	; バリュー名
'　out:sData	; バリュー値
'　ret:TRUE: 書き込み成功、FALSE: 書き込み失敗
'
'  Note: write data as follows
'    [sSection]
'    sValue = sData
'
Function writeIni(ByVal sSection, ByVal sValue, sData)
  Dim fso, fs, bOld
  writeIni = False

  If sSection = "" Or sValue = "" Or sData = "" Then Exit Function

  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next: bOld = True
  Set fs = fso.OpenTextFile(INIPATH, 1)
  If Err = 53 Then bOld = False	' File not found
  'Call errTrap(FILEOPEN, INIPATH)

  sSection = getSect(sSection)
  sValue = Trim(sValue)
  sData = Trim(sData)

' Create temp file
  Const TemporaryFolder = 2
  Dim tfolder, tname, tfile
  Dim tFullPath

  Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
  tname = fso.GetTempName

  Set tfile = tfolder.CreateTextFile(tname)
  tFullPath = tfolder.ShortPath & "\" & tname

' Read and Write Loop
  writeIni = False
  Dim s, ss, sWr
  sWr = sValue & " = " & sData	' Create write data
  If bOld Then
    Do Until fs.AtEndOfStream
      s = fs.ReadLine
      If Left(s, 1) = "[" Then	' Some [Section] found
        tfile.WriteLine(s)
        If isMySection(s, sSection) Then	' My [Section] found
          Do Until fs.AtEndOfStream
            s = fs.ReadLine
            If Left(s, 1) = "[" Then
              If sWr <> "" Then	' Not yet write data
                tfile.WriteLine(sWr): sWr = ""	' Adds last of section
              End If
              tfile.WriteLine(s)
              Exit Do ' Value not found
            End If
            If isMyValue(s, sValue, ss) Then
              ss = sWr & getComm(ss)
              tfile.WriteLine(ss): sWr = ""	' Replace line
            Else
              tfile.WriteLine(s)
            End If
          Loop
          If sWr <> "" Then		' Not yet write data
            tfile.WriteLine(sWr): sWr = ""	' Adds last of file
          End If
          ' Resume to simple copy
        End If	  ' My [Section] found
      Else
        tfile.WriteLine(s)
      End If	' Some [Section] found
    Loop
  End If
  If sWr <> "" Then	' Not yet write data
    tfile.WriteLine(vbCrLf & sSection)	' Adds last of .ini file
    tfile.WriteLine(sWr): sWr = ""
  End If
  If bOld Then fs.Close
  tfile.Close

  ' Copy it
  Set tfile = fso.GetFile(tFullPath)
  tfile.Copy INIPATH, True
  ' Del Old
  tfile.Delete

  If sWr = "" Then writeIni = True
End Function

'(EOF)

　　　→ 実はセクションやバリューの削除ができません。まぁその。所詮は.iniなんて
　　　　 テキストなので、メモ帳辺りで適当にメンテして欲しい。ってこと。
　　　　 レジストリをここまでして使わない理由？
　　　　 レジストリって、メモリに常駐するし消しても消えない「削除マークが付く
　　　　 だけだ」し、余り太るとOS (NTは大丈夫らしいが)が起動しなくなる。という
　　　　 『あに考えてんだ？この悲惨な仕様は！？』って代物なので、できる限り
　　　　 レジストリとはお付き合いしたくないのです

　・で、実際に「#include」を使った例が下です。(プリプロセッサで処理しないと動きません)
　ちなみにこれは毎日の残業時間を日々入力し、月末の残業時間が幾つになるかを予想するってものです。
　＃限度を越えてしまうと色々と申請書とか出さないとヤバイし(^^;;

　zcal.vbs 

'
'  Overtime calculator
'	Copyright (C) 1999.6,7 by BD&ASS
'
Option Explicit

'Globals
Const ZSECTION = "zcalc"
Const sTitle = "残業時間の積算"

#include "inictrl.vbs"
' ---------------------------------------------------------------------
Private Function predOT(ByVal iDay, ByVal fZ)
  Dim i

  i = iDay \ 7
  If iDay Mod 7 > 4 Then iDay = iDay - 1	' Wed
  If i <> 0 Then iDay = iDay - i * 3	' Sat, Sun, Wed
  If iDay <> 0 Then predOT = fZ / iDay Else predOT = fZ
End Function

' ---------------------------------------------------------------------
Private Function predOTAll(fZ)
  predOTAll = CInt((fZ * 20) / .25) * .25
End Function

' =====================================================================
Dim iCurM, iIniM, sAddM, fZOld, fZNow, fZ, iIDay, s, iDOfst

fZOld = CSng(readIni(ZSECTION, "PrevOTT", 0))
fZNow = CSng(readIni(ZSECTION, "CurrOTT", 0))
iCurM = Month(Date)
iIniM = CInt(readIni(ZSECTION, "CurMonth", iCurM))
iIDay = CInt(readIni(ZSECTION, "PrevInput", 0))

sAddM = "前就業日の残業時間？" & vbCrLf
If iIniM <> iCurM Then
  fZOld = fZNow: fZNow = 0: iIniM = iCurM: iIDay = 0
  sAddM = "月が変わったので残業合計はクリアされました" & vbCrLf
End If

iDOfst = -1	' Date offset, 0: include today, -1: not include today
If iIDay = 0 Then
  s = "今月最初の入力です"
Else
  If iIDay = Day(Date) Then
    s = "本日(" & Month(Date) & "/" & Day(Date) & ")、既に入力済みです"
    iDOfst = 0
  Else
    s = "前回の入力は"
    Select Case Day(Date) - iIDay
      Case 1
        s = s & "昨日"
      Case 2
        s = s & "一昨日"
      Case 3
        s = s & "一昨々日"
      Case Else
        s = s & iIDay & "日"
    End Select
    s = s & "でした"
  End If
End If

sAddM = sAddM & s & vbCrLf & vbCrLf &_
  "先月(" & Month(DateAdd("m", -1, Date)) & "月): " & fZOld & "h" & vbCrLf &_
  "今月(" & iCurM & "月): " & fZNow & "h" & vbCrLf & vbCrLf
If iIDay = 0 Then s = fZOld Else s = predOTAll(predOT(Day(Date) + iDOfst, fZNow))
sAddM = sAddM & "月末の予想残業時間: " & s & "h" & "?"

If iIDay = 0 Then s = fZOld / 20 Else s = predOT(Day(Date), fZNow)
fZ = InputBox(sAddM, sTitle, CInt(s + 0.5))
If fZ = "" Then Wscript.Quit	' End
fZNow = fZNow + fZ

If iDOfst = 0 Then
  If MsgBox("本日は既に入力済みですが、この値も加算しますか？",_
    vbYesNo + vbQuestion + vbDefaultButton2, sTitle) <> vbYes Then
    Wscript.Quit
  End If
End If

sAddM = "今月の予想残業時間合計：" & predOTAll(predOT(Day(Date), fZNow)) & "h" &_
  vbCrLf & "…ぐらいかな？"
Call MsgBox(sAddM, vbInformation, "大まかに予想すると……")
Call writeIni(ZSECTION, "CurMonth", iIniM)
iIDay = Day(Date)
Call writeIni(ZSECTION, "PrevInput", iIDay)
Call writeIni(ZSECTION, "PrevOTT", fZOld)
Call writeIni(ZSECTION, "CurrOTT", fZNow)

'(EOF)

　　　→ まぁその。特殊といえば特殊なものですが、例ということで(^^;;
　　　　 ちなみに、動かすのに苦労するかもです。本来はちゃんとInstallerまで
　　　　 あるものだったのですが、ここではあくまでサンプルとして提供します。
　　　　 ちょっと社内用途に特化したInstallerなのでして(^^;;

　＃ん〜。こんなことまでする奴は余りいねぇだろうなぁ……


PS. 追記(at 9.Feb.2K), 良く考えたら、実行時にVBScriptの色分けをやるんぢゃ
　なくて、色分けをやった奴を貼っ付けておく方が良かったよーな……(^^;A
PS2.ちなみに、適当なVBScriptのソースをTextAreaにCopy&Pasteして[Show full]って
　やると、それを清書してくれますよ(On-lineでやる人は余りいないと思うけど)

(EOF)