VBA レキシカルアナライザ

昔作った VBE(Visual Basic Editor:VBAを記述する実行環境)アドイン、VBAtoHTML というプログラムが著しく貧弱であるので、その心臓部であるレキシカルアナライザ(字句解析器)から作り直すことにしました。レキシカルアナライザがどういうものなのかはコチラをご覧ください。切り出すトークンの属性は18種と、わりと細かく分類します。相変わらずVB系の文字列リテラルは、中にあるダブルクォーテーションが分かり難くて、悶々と考えさせられます。

今回は使っていない RegExp ですが、それなりに理由があります。このソースで使うように、「ある1文字がリストの中にあるかどうか」を確認するには、 Like の方が断然速かったりします。リストの選択肢が少なければ、Dictionary よりも速いんです。Like 侮りがたし。ネイティブコンパイルした後はどうなのかわかりませんが、VBA で使うなら Like 一択です。あ、そういえば、条件コンパイルの項目忘れてた!　使うことないし、また今度ということで。

このソースを元に上記 VBAtoHTML を作り直したところ、下記600行(空行含む)のソースを0.05秒 (47msec/Multimedia Timer)で HTML に変換しました。以前と比べ残念ながら、2倍程度の時間がかかっていますが、分類にちょっと凝ってみたり、メンテナンスが幾分容易になったので良しとします。ちなみに18種に分けましたが、色分けは似たものがあるので13種にしました。GoToの行先と着地が色違いになると何のための色分けかわからなくなるので。

以下のソースコードについて、シンタックスハイライト/プロシージャ領域分割/リンク生成/埋め込みは、新生 VBAtoHTML が上記 VBE(VBIDE) から情報を取得して自動生成したものです。

vbLexer.bas　参照設定:Microsoft Forms2.0 / scripting runtime

   1: '====================================vbaLexer===================================
   2: '|USAGE |:VB/VBA/VBS用 レキシカルアナライザ
   3: '|  OF  |:frm/bas/cls/vbs 等のファイルを字句解析し、結果をクリップボード出力
   4: '| THIS |:
   5: '|MODULE|:参照設定 > Forms 2.0 / scripting runtime
   6: '|Number|Knd|Procedure Name |:-----Summary Description-----
   7: '|No.1  |Sub|main_lex       |:メイン関数　(vblex() テスト用)
   8: '|No.2  |Fnc|vbLex          |:VB/VBA/VBS用レキシカルアナライザ本体
   9: '|No.3  |Sub|LexDicsInit    |:連想配列辞書 各オブジェクトを初期化
  10: '|No.4  |Sub|LexDicsFree    |:オブジェクト変数への割り当てを解除
  11: '|No.5  |Sub|DicTokeRemove  |:解析結果である トークンと属性を初期化
  12: '|No.6  |Fnc|Tab2Space      |:水平タブを半角スペースに変換 Sift_JIS
  13: '|No.7  |Fnc|FileReadLine   |:ファイルを1行ずつ読んでコレクションで返す
  14: '|No.8  |Sub|SendClip       |:テキストデータをクリップボードに渡す
  15: Option Explicit
  16: Public gDicToke As Dictionary   '外部では READ_ONLY (cls_vblex)
  17: Public gDicAttr As Dictionary   '外部では READ_ONLY (cls_vblex)
  18: Private mDicIdtT As Dictionary
  19: Private mDicIdtF As Dictionary
  20: Private mDicLabl As Dictionary
  21: Private mDicNumT As Dictionary
  22: Private mDicNumF As Dictionary
  23: Private mDicOpeT As Dictionary
  24: Private mDicOpeF As Dictionary
  25: Private mDicCtrs As Dictionary
  26: Private mDicLgOp As Dictionary
  27: Private mDicKeyw As Dictionary
  28: Private mDicBltf As Dictionary
  29: Private mDicBltv As Dictionary

  30: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  31: '|概  要|:メイン関数　(vblex() テスト用)
  32: '|依  存|:
  33: '|解  説|:本来VBIDEを用いてVBEから直読(VBE Addin VBAtoHTML)
  34: '|      |:辞書大小文字区別 cPath に対象ファイルの絶対パス クリップボード出力
  35: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:2019/05/26 15:22:38
  36: Sub main_lex()
  37:     Const cPath = "D:\VBA_FILES\test00.bas"
  38:     Dim line As Integer
  39:     Dim i As Integer
  40:     Dim ct As Integer
  41:     Dim buf As String
  42:     Dim satt As String
  43:     Dim colfread As Collection
  44:     Dim var As Variant
  45:     
  46:     Call LexDicsInit    '各種辞書を初期化
  47:     
  48:     Set colfread = FileReadLine(cPath)  'ファイルを一行ずつ取り込み
  49:     line = 0
  50:     
  51:     For Each var In colfread    '1行ずつ取り出してレキシカルアナライズ
  52:         line = line + 1
  53:         ct = vbLex(Tab2Space(var))  'vbTab/space変換後に解析(直読時不要)
  54:         buf = buf & vbCrLf & line & "行目" & vbCrLf
  55:         '結果を buf に書き込む
  56:         For i = 1 To ct
  57:             buf = buf & gDicAttr.Item(i) & " :" & gDicToke.Item(i) & vbCrLf
  58:         Next i
  59:     Next
  60:    
  61:     Call SendClip(buf)  'クリップボードに送る
  62:     Call LexDicsFree    '辞書を開放する
  63: 
  64: End Sub

  65: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  66: '|概  要|:VB/VBA/VBS用レキシカルアナライザ本体
  67: '|戻り値|:型 Integer :解析トークンの個数
  68: '|ﾊﾟﾗﾒｰﾀ| 仮引数名            |I/O| 型                  | 説明
  69: '| No.1 | str                 |I  | String              |:ByValで受ける
  70: '|依  存|:
  71: '|解  説|:strを解析し、連想配列の値に gDicAttr 属性  gDicToke トークン を格納
  72: '|      |:2つのkeyは同期  日本語変数不可 Shift_JIS
  73: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:2019/05/26 15:22:51
  74: Public Function vbLex(ByVal str As String) As Integer
  75: '
  76: '@補足:以下の属性にトークンを分類する
  77: 'ctrst:制御文キーワード     numer:数値                  opera:演算子
  78: 'keywd:一般キーワード       liter:文字列リテラル        lgope:論理演算子
  79: 'bltfn:組み込み関数         comme:コメント              signm:単項演算子-
  80: 'bltvc:組み込み定数         label:ラベル                space:半角スペース
  81: 'ident:一般識別子           golbl:Goto側ラベル          panct:句読記号
  82: 'membr:クラスメンバ等       prmop:メソッドparam(:=)     nline:行番号(コロン有無)
  83: '
  84:     Dim i As Integer, ib As Integer, ct As Integer
  85:     Dim spct As Integer, ctmp As Integer, strlen As Integer
  86:     Dim ch As String, tch As String
  87:     Dim ret As String, att As String
  88: 
  89: On Error GoTo PROC_ERR
  90: 
  91:     ct = 0
  92:     spct = 0
  93:     i = 1
  94:     'トークン連想配列初期化
  95:     Call DicTokeRemove
  96:     strlen = Len(str)
  97:     
  98:     While i <= strlen
  99:         ch = Mid$(str, i, 1)
 100:         ib = i
 101:         ret = ""
 102:         att = ""
 103:         '空白 (1つずつだと圧倒的に手数が増えるのでまとめる)
 104:         '※ テキストファイルを読む場合 Tab は lex 以前に要スペース変換)
 105:         If ch = " " Then
 106:             att = "space"
 107:             tch = Mid$(str, i + 1, 1)   '次の文字を調べる
 108:             If tch = ch Then
 109:                 For i = i + 2 To strlen
 110:                     tch = Mid$(str, i, 1)
 111:                     If tch = ch Then
 112:                         spct = spct + 1 'カウントのみ
 113:                     Else
 114:                         Exit For
 115:                     End If
 116:                 Next i      'カウンタ i は連続スペースの次の文字
 117:                 ret = Space(spct + 2)   '最初の2個
 118:                 spct = 0                '初期化
 119:             Else
 120:                 i = i + 1   'カウンタを1つ進める
 121:                 ret = ch
 122:             End If
 123:         '文字列
 124:         ElseIf mDicIdtT.Exists(ch) = True Then  'Like の方が若干速い
 125:             For i = i + 1 To strlen
 126:                 If mDicIdtF.Exists(Mid$(str, i, 1)) = False Then
 127:                     Exit For
 128:                 End If
 129:             Next i
 130:             '文字列取り出し
 131:             ret = Mid$(str, ib, i - ib)
 132:             '直前文字を取得
 133:             If ib = 1 Then
 134:                 tch = ""
 135:             Else
 136:                 tch = Mid$(str, ib - 1, 1)
 137:             End If
 138:             'クラス/構造体　メンバ名
 139:             If tch = "." Then
 140:                 att = "membr"
 141:             '下記辞書は大文字小文字が区別される
 142:             'ステートメントコントローラ(If For Do 等　GoTo 系除く)
 143:             ElseIf mDicCtrs.Exists(ret) = True Then
 144:                 att = "ctrst"
 145:             '一般キーワード
 146:             ElseIf mDicKeyw.Exists(ret) = True Then
 147:                 att = "keywd"
 148:                 '同名関数 String
 149:                 If ret = "String" Then
 150:                     If Mid$(str, i, 1) = "(" Then
 151:                         att = "bltfn"
 152:                     End If
 153:                 End If
 154:             '組み込み関数
 155:             ElseIf mDicBltf.Exists(ret) = True Then
 156:                 att = "bltfn"
 157:             '論理演算子
 158:             ElseIf mDicLgOp.Exists(ret) = True Then
 159:                 att = "lgope"
 160:             '組み込み定数/変数
 161:             ElseIf mDicBltv.Exists(ret) = True Then
 162:                 att = "bltvc"
 163:             'GoTo/GoSub/Resume と行先ラベル 1行記述前提 改行→失敗
 164:             ElseIf mDicLabl.Exists(ret) = True Then
 165:                 ct = ct + 1
 166:                 gDicToke.Add ct, ret
 167:                 gDicAttr.Add ct, "ctrst"
 168:                 ct = ct + 1                 '以下強制
 169:                 gDicToke.Add ct, " "
 170:                 gDicAttr.Add ct, "space"
 171:                 ib = i + 1
 172:                 For i = i + 1 To strlen
 173:                     tch = Mid$(str, i, 1)
 174:                     If tch = " " Then
 175:                         Exit For
 176:                     End If
 177:                 Next i
 178:                 ret = Mid$(str, ib, i - ib)
 179:                 att = "golbl"
 180:                 ct = ct + 1
 181:                 gDicToke.Add ct, ret
 182:                 gDicAttr.Add ct, att
 183:                 GoTo WEND_POS
 184:             '剰余演算子
 185:             ElseIf ret = "Mod" Then
 186:                 att = "opera"
 187:             'それ以外の識別子
 188:             Else
 189:                 att = "ident"
 190:             End If
 191:         '数値 &H &O含む
 192:         ElseIf mDicNumT.Exists(ch) = True Then
 193:             '文字結合 & を除外
 194:             If ch = "&" Then
 195:                 If Mid$(str, i + 1, 1) = " " Then
 196:                     i = i + 1   '1つしか進めない
 197:                     ct = ct + 1
 198:                     gDicToke.Add ct, ch
 199:                     gDicAttr.Add ct, "opera"
 200:                     GoTo WEND_POS
 201:                 End If
 202:             End If
 203:             For i = i + 1 To strlen
 204:                 If mDicNumF.Exists(Mid$(str, i, 1)) = False Then
 205:                     Exit For
 206:                 End If
 207:             Next i
 208:             ret = Mid$(str, ib, i - ib)
 209:             att = "numer"
 210:             '行番号
 211:             If ct = 0 Then
 212:                 att = "nline"
 213:             End If
 214:         '文字列リテラル
 215:         ElseIf ch = """" Then
 216:             ctmp = 0    'ダブルクォート カウンタ
 217:             ' ch" の次から 偶数の塊は無視 奇数の塊の最後尾または単独
 218:             For i = i + 1 To strlen
 219:                 If Mid$(str, i, 1) = """" Then
 220:                     ctmp = ctmp + 1
 221:                 Else
 222:                     If ctmp Mod 2 = 1 Then
 223:                         Exit For
 224:                     Else
 225:                         ctmp = 0
 226:                     End If
 227:                 End If
 228:             Next i
 229:             '最後尾の " が見つからない→最後尾まで取得
 230:             ret = Mid$(str, ib, i - ib)
 231:             att = "liter"
 232:         'コメント
 233:         ElseIf ch = "'" Then
 234:             ret = Mid$(str, i)
 235:             att = "comme"
 236:             i = strlen + 1      'ループ強制終了
 237:         '演算子 ※( Mod は文字列で)
 238:         ElseIf mDicOpeT.Exists(ch) = True Then
 239:             ret = ch
 240:             att = "opera"
 241:             '「<= >= <>」があるため次の文字を検査
 242:             tch = Mid$(str, i + 1, 1)
 243:             If mDicOpeF.Exists(tch) = False Then
 244:                 i = i + 1
 245:                 '単項演算子マイナスチェック
 246:                 If ch = "-" And tch <> " " Then
 247:                     att = "signm"
 248:                 End If
 249:             Else
 250:                 i = i + 2   'カウンタを2文字分進める
 251:                 ret = ch & tch
 252:             End If
 253:         '句読記号
 254:         Else
 255:             i = i + 1   'カウンタを1つ進める
 256:             ret = ch
 257:             att = "panct"
 258:             'コロンの処理(1行まとめ書きは panct)
 259:             If ret = ":" Then
 260:                 ' := メソッドパラメータ代入
 261:                 tch = Mid$(str, i, 1)
 262:                 If tch = "=" Then
 263:                     i = i + 1
 264:                     ret = ":="
 265:                     att = "prmop"
 266:                 'ラベル
 267:                 ElseIf ct = 1 Then
 268:                     '1つ前に辞書登録した内容を書き換える
 269:                     ret = gDicToke.Item(ct)
 270:                     att = gDicAttr.Item(ct)
 271:                     If att <> "nline" Then
 272:                         att = "label"
 273:                     End If
 274:                     gDicToke(ct) = ret & ch
 275:                     gDicAttr(ct) = att
 276:                     GoTo WEND_POS
 277:                 End If
 278:             End If
 279:         End If
 280:     ct = ct + 1
 281:     gDicToke.Add ct, ret
 282:     gDicAttr.Add ct, att
 283: 
 284: WEND_POS:
 285:     Wend
 286:     vbLex = ct
 287: 
 288: PROC_EXIT:
 289:     Exit Function
 290: 
 291: PROC_ERR:
 292:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 293:     "vbaLexer" & "." & "vbLex"
 294:     Resume PROC_EXIT
 295: 
 296: End Function

 297: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 298: '|概  要|:連想配列辞書 各オブジェクトを初期化
 299: '|依  存|:
 300: '|解  説|:VBE Addin ではフォームロード時に実行、アンロードまで辞書を保持する
 301: '|      |:事前バインディングにて
 302: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:2019/05/26 15:23:04
 303: Public Sub LexDicsInit()
 304:     Dim sidtT As String, aidtT() As String
 305:     Dim sidtf As String, aidtf() As String
 306:     Dim snumT As String, anumT() As String
 307:     Dim snumF As String, anumF() As String
 308:     Dim sopeT As String, aopeT() As String
 309:     Dim sopeF As String, aopeF() As String
 310:     Dim sctrs As String, actrs() As String
 311:     Dim slgop As String, algop() As String
 312:     Dim skeyw As String, akeyw() As String
 313:     Dim sbltf As String, abltf() As String
 314:     Dim sbltv As String, abltv() As String
 315:     Dim ct As Integer
 316: 
 317: On Error GoTo PROC_ERR
 318: 
 319:     '解析結果入力用連想配列
 320:     Set gDicToke = New Scripting.Dictionary
 321:     Set gDicAttr = New Scripting.Dictionary
 322:     
 323:     'トークン文字列参照辞書(RegExpをつかわない)
 324:     Set mDicLabl = New Scripting.Dictionary
 325:     Set mDicIdtT = New Scripting.Dictionary
 326:     Set mDicIdtF = New Scripting.Dictionary
 327:     Set mDicNumT = New Scripting.Dictionary
 328:     Set mDicNumF = New Scripting.Dictionary
 329:     Set mDicOpeT = New Scripting.Dictionary
 330:     Set mDicOpeF = New Scripting.Dictionary
 331:     Set mDicCtrs = New Scripting.Dictionary
 332:     Set mDicLgOp = New Scripting.Dictionary
 333:     Set mDicKeyw = New Scripting.Dictionary
 334:     Set mDicBltf = New Scripting.Dictionary
 335:     Set mDicBltv = New Scripting.Dictionary
 336:     
 337:     sidtT = "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z," & _
 338: "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
 339:     
 340:     sidtf = "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z," & _
 341: "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,_,$," & _
 342: "0,1,2,3,4,5,6,7,8,9"
 343:     
 344:     snumT = "0,1,2,3,4,5,6,7,8,9,&"
 345:     
 346:     snumF = "0,1,2,3,4,5,6,7,8,9,.,a,b,c,d,e,f,h,o,A,B,C,D,E,F,H,O"
 347:     
 348:     sopeT = "=,<,>,+,*,.,-,^,\"  'Mod IFblock   & Numerblock
 349:     
 350:     sopeF = "=,<,>"
 351:     
 352:     sctrs = "Case,Do,Each,Else,ElseIf,End,Exit,For,Function," & _
 353: "If,In,Loop,Next,Property,Select,Step,Sub,Then,To,Until,Wend," & _
 354: "While,With"    'Goto/GoSub/Resume  Dictionary
 355: 
 356:     slgop = "And,Or,Not,Eqv,Imp,Xor"
 357: 
 358:     skeyw = "Access,AddressOf,Alias,Any,Append,As,Assert,Base,Begin," & _
 359: "Binary,Boolean,ByRef,Byte,ByVal,Call,Close,Compare,Const,Currency," & _
 360: "Date,Debug,Declare,Dim,Double,Enum,Erase,Error,Event,Explicit," & _
 361: "Friend,Get,Global,Implements,Integer,Is,Let,Lib,Like,Line,Lock," & _
 362: "Long,LSet,Me,New,Nothing,Null,Object,On,Open,Option,Optional," & _
 363: "Output,ParamArray,Preserve,Print,Private,PSet,Public,Put,RaiseEvent," & _
 364: "Random,Read,ReDim,RSet,Scale,Set,Shared,Single,Static,String,Type," & _
 365: "TypeOf,Unlock,Variant,WithEvents,Write"
 366:     
 367:     sbltf = "Abs,Array,Asc,Ascb,Ascw,Atn,CBool,CByte,CCur,CDate,CDbl,CDec," & _
 368: "CInt,CLng,CSng,CStr,CVerr,CVar,CallByName,Choose,Chr,Chr$,Chrb,ChrB$," & _
 369: "Chrw,Command,Command$,Cos,CreateObject,CurDir,CurDir$,DDB,Date,Date$," & _
 370: "DateAdd,DateDiff,DatePart,DateSerial,DateValue,Day,Dir,Dir$,DoEvents,EOF," & _
 371: "Environ,Error,Error$,Exp,FV,FileAttr,FileDateTime,FileLen,Filter,Fix," & _
 372: "Format,Format$,FormatCurrency,FormatNumber,FormatPercent," & _
 373: "FreeFile,GetAllSettings,GetAttr,GetObject,GetSetting,Hex,Hex$,Hour,IIf," & _
 374: "IMESstatus,IPmt,IRR,InStr,InStrRev,Input,Input$,InputB,InputB$,InputBox," & _
 375: "Int,IsArray,IsDate,IsEmpty,IsError,IsMissing,IsNull,IsNumeric,IsObject," & _
 376: "Join,LBound,LCase,LCase$,LCaseB,LCaseB$,Lof,LTrim,LTrim$,Left,Left$,LeftB," & _
 377: "LeftB$,Len,LenB,Loc,Log,MIRR,MacId,MacScript,Mid,Mid$,MidB,MidB$,Minute," & _
 378: "Month,MonthName,MsgBox,NPV,NPer,Now,Oct,Oct$,PPmt,PV,Partition,Pmt," & _
 379: "QBColor,RGB,RTrim,RTrim$,Rate,Replace,Right,Right$,RightB,RightB$,Rnd," & _
 380: "Round,SLN,SYD,Second,Seek,Sgn,Shell,Sin,Space,Space$,Spc,Split,Sqr,Str," & _
 381: "Str$,StrComp,StrConv,StrReverse,String,String$,Switch,Tab,Tan,Time,Time$," & _
 382: "TimeSerial,TimeValue,Timer,Trim,Trim$,TypeName,UBound,UCase,Val,VarType," & _
 383: "WeekDay,WeekDayName,Year"
 384:     
 385:     sbltv = "False,True,vbDataObject,vbMenuText,vbButtonText,vbYellow," & _
 386: "vbHighLight,vbOKCancel,vbInteger,vbCyan,vbString,vbAlias,vbEmpty,vbYesNo," & _
 387: "vbCR,vbMsgBoxRtlReading,vbHidden,vb3DLight,vbByte,vbOK,vbMsgBoxHelpButton," & _
 388: "vbScrollBars,vbReadOnly,vbInfoText,vbYes,vbObject,vbInfoBackground," & _
 389: "vbError,vbGrayText,vbInactiveBorder,vbDecimal,vbInactiveCaptionText," & _
 390: "vbKatakana,vbQuestion,vbYesNoCancel,vbArchive,vbInactiveTitleBar," & _
 391: "vbButtonShadow,vbFormFeed,vbSystem,vbTitleBarText,vbHighLightText," & _
 392: "vbArray,vbAbortRetryIgnore,vbCrLf,vbNullChar,vbMagenta,vbDefaultButton1," & _
 393: "vbDefaultButton2,vbDefaultButton3,vbDefaultButton4,vbExclamation,vbBlack," & _
 394: "vbOKOnly,vbLong,vbActiveTitleBar,vbNarrow,vbWide,vbDirectory,vbGreen," & _
 395: "vbMsgBoxSetForeground,vb3DDKShadow,vbRed,vbUpperCase,vbIgnore,vbRetry," & _
 396: "vb3DHighLight,vbApplicationModal,vbVariant,vbFromUnicode,vbBoolean," & _
 397: "vbRetryCancel,vbUnicode,vbNull,vbApplicationWorkspace,vbCritical,vbDate," & _
 398: "vbNormal,vbNullString,vbButtonFace,vbAbort,vbUserDefinedType,vbCancel," & _
 399: "vbInformation,vbWindowText,vbSingle,vbSystemModal,vbLf,vbLongLong," & _
 400: "vbWindowBackground,vbVolume,vbVerticalTab,vbBlue,vbProperCase,vbDouble," & _
 401: "vbTab,vbHiragana,vbMenuBar,vbNewLine,vbActiveBorder,vbNo,vbCurrency," & _
 402: "vbBack,vbMsgBoxRight,vbLowerCase,vbDesktop,vbWhite,vbWindowFrame"
 403:     
 404:     aidtT = Split(sidtT, ",")
 405:     aidtf = Split(sidtf, ",")
 406:     anumT = Split(snumT, ",")
 407:     anumF = Split(snumF, ",")
 408:     aopeT = Split(sopeT, ",")
 409:     aopeF = Split(sopeF, ",")
 410:     actrs = Split(sctrs, ",")
 411:     algop = Split(slgop, ",")
 412:     akeyw = Split(skeyw, ",")
 413:     abltf = Split(sbltf, ",")
 414:     abltv = Split(sbltv, ",")
 415:     
 416:     mDicLabl.Add "GoTo", 1
 417:     mDicLabl.Add "GoSub", 1
 418:     mDicLabl.Add "Resume", 1
 419:     For ct = 0 To UBound(aidtT)
 420:         mDicIdtT.Add aidtT(ct), 1
 421:     Next ct
 422:     For ct = 0 To UBound(aidtf)
 423:         mDicIdtF.Add aidtf(ct), 1
 424:     Next ct
 425:     For ct = 0 To UBound(anumT)
 426:         mDicNumT.Add anumT(ct), 1
 427:     Next ct
 428:     For ct = 0 To UBound(anumF)
 429:         mDicNumF.Add anumF(ct), 1
 430:     Next ct
 431:     For ct = 0 To UBound(aopeT)
 432:         mDicOpeT.Add aopeT(ct), 1
 433:     Next ct
 434:     For ct = 0 To UBound(aopeF)
 435:         mDicOpeF.Add aopeF(ct), 1
 436:     Next ct
 437:     For ct = 0 To UBound(actrs)
 438:         mDicCtrs.Add actrs(ct), 1
 439:     Next ct
 440:     For ct = 0 To UBound(algop)
 441:         mDicLgOp.Add algop(ct), 1
 442:     Next ct
 443:     For ct = 0 To UBound(akeyw)
 444:         mDicKeyw.Add akeyw(ct), 1
 445:     Next ct
 446:     For ct = 0 To UBound(abltf)
 447:         mDicBltf.Add abltf(ct), 1
 448:     Next ct
 449:     For ct = 0 To UBound(abltv)
 450:         mDicBltv.Add abltv(ct), 1
 451:     Next ct
 452: 
 453: PROC_EXIT:
 454:     Exit Sub
 455: 
 456: PROC_ERR:
 457:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 458:     "vbaLexer" & "." & "LexDicsInit"
 459:     Resume PROC_EXIT
 460: 
 461: End Sub

 462: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 463: '|概  要|:オブジェクト変数への割り当てを解除
 464: '|依  存|:
 465: '|解  説|:フォーム アンロード時に実行
 466: '|      |:
 467: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:2019/05/23 16:31:18
 468: Public Sub LexDicsFree()
 469: 
 470: On Error GoTo PROC_ERR
 471: 
 472:     Set gDicToke = Nothing
 473:     Set gDicAttr = Nothing
 474:     Set mDicLabl = Nothing
 475:     Set mDicIdtT = Nothing
 476:     Set mDicIdtF = Nothing
 477:     Set mDicNumT = Nothing
 478:     Set mDicNumF = Nothing
 479:     Set mDicOpeT = Nothing
 480:     Set mDicOpeF = Nothing
 481:     Set mDicCtrs = Nothing
 482:     Set mDicLgOp = Nothing
 483:     Set mDicKeyw = Nothing
 484:     Set mDicBltf = Nothing
 485:     Set mDicBltv = Nothing
 486: 
 487: PROC_EXIT:
 488:     Exit Sub
 489: 
 490: PROC_ERR:
 491:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 492:     "vbaLexer" & "." & "LexDicsFree"
 493:     Resume PROC_EXIT
 494: 
 495: End Sub

 496: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 497: '|概  要|:解析結果である トークンと属性を初期化
 498: '|依  存|:
 499: '|解  説|:全削除
 500: '|      |:
 501: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:未更新
 502: Private Sub DicTokeRemove()
 503: 
 504: On Error GoTo PROC_ERR
 505: 
 506:   gDicToke.RemoveAll
 507:   gDicAttr.RemoveAll
 508: 
 509: PROC_EXIT:
 510:     Exit Sub
 511: 
 512: PROC_ERR:
 513:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 514:     "vbaLexer" & "." & "DicTokeRemove"
 515:     Resume PROC_EXIT
 516: 
 517: End Sub

 518: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 519: '|概  要|:水平タブを半角スペースに変換 Sift_JIS
 520: '|戻り値|:型 String :
 521: '|ﾊﾟﾗﾒｰﾀ| 仮引数名            |I/O| 型                  | 説明
 522: '| No.1 | str                 |I  | String              |:Byval必須,Shift_JIS
 523: '| No.2 | [tablen]            |I  | [Integer]           |[Def=4]:
 524: '|依  存|:
 525: '|解  説|:引数が Variant データ(実態 String)でも読めるようにByValで受ける
 526: '|      |:ByRefでVariantは読めない LenB()を使用するのでShift_JIS専用
 527: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:2019/05/23 16:30:08
 528: Private Function Tab2Space(ByVal str As String, _
 529:                     Optional tablen As Integer = 4) As String
 530:     Dim tstr As String
 531:     Dim pos As Integer
 532: 
 533: On Error GoTo PROC_ERR
 534: 
 535:     Do
 536:         pos = InStr(str, vbTab)
 537:         If pos <> 0 Then
 538:             tstr = tstr & Mid$(str, 1, pos - 1)
 539:             tstr = tstr & Space(tablen - (LenB(tstr) Mod tablen))
 540:             str = Mid$(str, pos + 1)    '既読部を削除
 541:         Else
 542:             tstr = tstr & str
 543:         End If
 544:     Loop Until pos = 0
 545:     
 546:     Tab2Space = tstr
 547:     
 548: PROC_EXIT:
 549:     Exit Function
 550: 
 551: PROC_ERR:
 552:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 553:     "vbaLexer" & "." & "Tab2Space"
 554:     Resume PROC_EXIT
 555: 
 556: End Function

 557: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 558: '|概  要|:ファイルを1行ずつ読んでコレクションで返す
 559: '|戻り値|:型 Collection :
 560: '|ﾊﾟﾗﾒｰﾀ| 仮引数名            |I/O| 型                  | 説明
 561: '| No.1 | fpath               |I  | String              |:ファイルパス
 562: '|依  存|:
 563: '|解  説|:
 564: '|      |:
 565: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:未更新
 566: Private Function FileReadLine(fpath As String) As Collection
 567:   Dim colret As New Collection
 568:   Dim fso As Object
 569:   Dim fileo As Object
 570: 
 571: On Error GoTo PROC_ERR
 572: 
 573:   Set fso = CreateObject("Scripting.FileSystemObject")
 574:   Set fileo = fso.OpenTextFile(fpath, 1, False, 0)
 575:  
 576:   Do Until fileo.AtEndOfStream
 577:     colret.Add fileo.ReadLine
 578:   Loop
 579:  
 580:   fileo.Close
 581:   Set fileo = Nothing
 582:   Set fso = Nothing
 583:  
 584:   Set FileReadLine = colret
 585: 
 586: PROC_EXIT:
 587:     Exit Function
 588: 
 589: PROC_ERR:
 590:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 591:     "vbaLexer" & "." & "FileReadLine"
 592:     Resume PROC_EXIT
 593: 
 594: End Function

 595: '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 596: '|概  要|:テキストデータをクリップボードに渡す
 597: '|ﾊﾟﾗﾒｰﾀ| 仮引数名            |I/O| 型                  | 説明
 598: '| No.1 | buf                 |I  | String              |:
 599: '|依  存|:参照設定 > Microsoft Forms 2.0 Object Library
 600: '|解  説|:もしくはフォームモジュールを１つ作る
 601: '|      |:
 602: '|作  者|:mfi.sub.jp: 作成日:2019/05/23: 更新:未更新
 603: Private Sub SendClip(buf As String)
 604:     Dim sc As Object
 605: 
 606: On Error GoTo PROC_ERR
 607: 
 608:     Set sc = New DataObject
 609:     With sc
 610:       .SetText buf
 611:       .PutInClipboard
 612:     End With
 613: 
 614: PROC_EXIT:
 615:     Exit Sub
 616: 
 617: PROC_ERR:
 618:     MsgBox "Error_Number: " & Err.Number & ".  : " & Err.Description, , _
 619:     "vbaLexer" & "." & "SendClip"
 620:     Resume PROC_EXIT
 621: 
 622: End Sub

GAWK のすすめ

VB系のソースを字句解析するスクリプトを GAWK で書けば、登録するキーワードによりますが、およそ 300行 + α くらいで済みます。VBIDEみたいに自己のソース情報を管理するためには、プラス100行あれば、モジュールレベルのソース解析もできます。さらにプラス30行で HTML 化できるでしょう。

今回の VBA による字句解析で、ファイルを開く/読む/連想配列(ハッシュ)をたくさん使うための準備、オブジェクトの解放などその関連作業で、軽く100行くらいは使っています。対してGAWK の配列は元々連想配列しかありませんから、Scripting.Dictionary が標準の配列になっているようなものです。しかも、配列の宣言なんてできませんから、いきなり使い始めることになります。ファイルもコマンドラインにファイル名を引数として与えるだけで、これもいきなり読めてしまいます。特にコマンドは要りません。データドリブンという概念だそうで、イベントドリブンにどっぷり浸かった VBA/VB に慣れた人からすると、ナニコレってなります。筆者も十数年前そうでした。つまり、すぐに肝要な部分の製作に取り掛かれるということです。ちなみに、表計算としては MicrosoftExcel のよきパートナーとなり得るほど柔軟に csv ファイルを扱えたりもします。

GAWK は CUI ですし、C や他のスクリプト言語に比べると、いろいろな観点から「おもちゃ」呼ばわりされることもあります。そもそもこのご時世にキャラクタベースの言語で何作るの? という感じかもしれません。プログラミング言語として GAWK / AWK 言語を採用し、真面目に取り組む人は稀有な存在なのでしょう。上の例で行くと、クリップボードにデータを送ることも単独ではできないくらいですから。つつましい限りです。しかし、今回のようにテキスト処理を中心にプログラミングを行う場合、初めに GAWK でプロトタイプを作り、その骨子に納得がいったら、C や C++ 及び VBA/VB に移植し、ディテールを固めるという工程でいくと問題が起こりにくくなります。(あくまでも筆者の場合)

CUI だからコマンドプロンプトやパワーシェルとにらめっこなんだろ、と思われたそこのあなた。マクロとアウトプットを備えたエディタがあれば、それはもう VBA の使い勝手と同じなんです。実行ボタンを押したら、書いたコードが実行されて、結果を表示する。だからなにって感じですが、使ってみればわかります。GAWK 楽で楽しいですよ。

VBA レキシカルアナライザ

vbLexer.bas 参照設定:Microsoft Forms2.0 / scripting runtime

GAWK のすすめ

GAWK サクラエディタで快適に使う

vbLexer.bas　参照設定:Microsoft Forms2.0 / scripting runtime