test

Option Explicit

' 呼び出し監査＆完全な呼び出し表。t01a の TrimCode を一から機械パース。VBA(Dictionary+RegExp+DAO)のみ。
' 定数直値: dbOpenSnapshot=4, dbOpenDynaset=2, dbAppendOnly=8, dbFailOnError=128
' RunCallAudit  … 既存 呼出先プロシージャID と突合し z_呼出監査 に差分＋分類を出力。
' BuildCallTable … 分類=内部呼び だけを呼元→呼先の辺として z_呼出表 に出力（潜り駆動用・既存ID非依存）。
' 2026/07/11 拡張4：識別子に日本語を許可／名前照合は大文字小文字無視／連鎖末尾メソッド a.b.c(...) を名前一意で解決。
' 識別子文字クラス IDC は BuildRe で ChrW により明示コードポイントで組み立てる（範囲逆転・文字化けの根絶）。

Private mByName As Object
Private mByModName As Object
Private mModuleSet As Object
Private mInitOf As Object
Private mNameOf As Object
Private mModOf As Object
Private mStop As Object
Private mVarType As Object
Private mVarExt As Object
Private mModVarType As Object
Private mModVarExt As Object
Private mKindOf As Object

Private reStr As Object, reDecl As Object, reNew As Object, reQual As Object
Private reCall As Object, reParen As Object, reAddr As Object, reAppRun As Object, reCbn As Object, reLead As Object
Private reAsType As Object, reSetNew As Object, reSetCreate As Object, reDeclKind As Object, reAnyDecl As Object, reDotCall As Object

Private mDb As Object
Private mOut As Object

Public Sub BuildCallTable()
    Set mDb = CurrentDb
    BuildRe
    BuildSym
    BuildVarTypes
    BuildStop
    EnsureCallTable
    Dim tOut As Object
    Set tOut = mDb.OpenRecordset("z_呼出表", 2, 8)
    Dim rs As Object
    Set rs = mDb.OpenRecordset( _
      "SELECT プロシージャID, コードラインID, TrimCode FROM t01a_コード " & _
      "WHERE コメント行=False AND 空白行=False ORDER BY プロシージャID, CLng(コードラインID)", 4)
    Do While Not rs.EOF
        CollectCalls tOut, NzL(rs.Fields("プロシージャID").Value), NzL(rs.Fields("コードラインID").Value), _
                     SS(rs.Fields("TrimCode").Value)
        rs.MoveNext
    Loop
    rs.Close
    tOut.Close
    WriteCallTableSummary
End Sub

Private Sub CollectCalls(ByRef tOut As Object, ByVal pid As Long, ByVal cid As Long, ByVal raw As String)
    Dim curName As String: curName = "": If mNameOf.exists(pid) Then curName = mNameOf(pid)
    Dim curMod As String: curMod = "": If mModOf.exists(pid) Then curMod = mModOf(pid)
    Dim clean As String: clean = StripStr(raw)
    If reDecl.Test(clean) Then Exit Sub

    Dim resolved As Object: Set resolved = CreateObject("Scripting.Dictionary")
    Dim ambig As Object: Set ambig = CreateObject("Scripting.Dictionary")
    Dim ambCls As Object: Set ambCls = CreateObject("Scripting.Dictionary")
    DetectLine pid, curMod, curName, clean, raw, resolved, ambig, ambCls

    Dim emitted As Object: Set emitted = CreateObject("Scripting.Dictionary")
    Dim k As Variant, callee As Long, kc As String
    For Each k In resolved.keys
        callee = CLng(k)
        If Not emitted.exists(callee) Then
            kc = KindClass(callee)
            If kc = "内部呼び" Then
                WriteEdge tOut, pid, curMod, curName, cid, callee, CStr(resolved(k)), "呼び"
                emitted(callee) = True
            ElseIf kc = "参照" Then
                WriteEdge tOut, pid, curMod, curName, cid, callee, CStr(resolved(k)), "Property"
                emitted(callee) = True
            End If
        End If
    Next
    For Each k In ambig.keys
        If ambCls.exists(k) Then
            If CLng(ambig(k)) = 1 And (ambCls(k) = "要判定" Or ambCls(k) = "参照") Then
                Dim arr() As String: arr = Split(CStr(mByName(LK(CStr(k)))(1)), "|")
                callee = CLng(arr(0))
                If Not emitted.exists(callee) Then
                    kc = KindClass(callee)
                    If kc = "内部呼び" And ambCls(k) = "要判定" Then
                        WriteEdge tOut, pid, curMod, curName, cid, callee, "名前一意", "呼び"
                        emitted(callee) = True
                    ElseIf kc = "参照" And ambCls(k) = "参照" Then
                        WriteEdge tOut, pid, curMod, curName, cid, callee, "名前一意", "Property"
                        emitted(callee) = True
                    End If
                End If
            End If
        End If
    Next
End Sub

Private Sub EnsureCallTable()
    On Error Resume Next
    mDb.TableDefs.Delete "z_呼出表"
    On Error GoTo 0
    mDb.Execute "CREATE TABLE z_呼出表 (" & _
      "呼元PrcID LONG, 呼元Mdl TEXT(120), 呼元Prc TEXT(120), コードラインID LONG, " & _
      "呼先PrcID LONG, 呼先Mdl TEXT(120), 呼先Prc TEXT(120), 検出パターン TEXT(30), " & _
      "呼先種別 TEXT(12), 潜り TEXT(8))", 128
End Sub

Private Sub WriteEdge(ByRef tOut As Object, ByVal srcPid As Long, ByVal srcMod As String, ByVal srcPrc As String, _
                      ByVal cid As Long, ByVal dstPid As Long, ByVal pat As String, ByVal kind As String)
    tOut.AddNew
    tOut.Fields("呼元PrcID").Value = srcPid
    tOut.Fields("呼元Mdl").Value = srcMod
    tOut.Fields("呼元Prc").Value = srcPrc
    tOut.Fields("コードラインID").Value = cid
    tOut.Fields("呼先PrcID").Value = dstPid
    tOut.Fields("呼先Mdl").Value = NameMod(dstPid)
    tOut.Fields("呼先Prc").Value = NameSafe(dstPid)
    tOut.Fields("検出パターン").Value = pat
    tOut.Fields("呼先種別").Value = kind
    tOut.Fields("潜り").Value = "潜る"
    tOut.Update
End Sub

Private Sub WriteCallTableSummary()
    On Error Resume Next
    mDb.Execute "DROP TABLE z_calltable_sum", 128
    On Error GoTo 0
    mDb.Execute "CREATE TABLE z_calltable_sum (item TEXT(30), val LONG)", 128
    PutCTSum "edges_total", DCount("*", "z_呼出表")
    PutCTSum "edges_call", DCount("*", "z_呼出表", "呼先種別='呼び'")
    PutCTSum "edges_prop", DCount("*", "z_呼出表", "呼先種別='Property'")
    PutCTSum "edges_dive", DCount("*", "z_呼出表", "潜り='潜る'")
    PutCTSum "edges_stop", DCount("*", "z_呼出表", "潜り='止め'")
End Sub

Private Sub PutCTSum(ByVal item As String, ByVal val As Long)
    mDb.Execute "INSERT INTO z_calltable_sum (item, val) VALUES ('" & item & "', " & val & ")", 128
End Sub

Public Function CmpPing() As String
    CmpPing = "pong"
End Function

Public Sub ClassifyProcsT03a(Optional ByVal doWrite As Boolean = False)
    On Error GoTo EH
    Set mDb = CurrentDb
    BuildRe
    BuildSym
    BuildVarTypes
    BuildStop

    Dim callSet As Object: Set callSet = CreateObject("Scripting.Dictionary")
    Dim resSet As Object: Set resSet = CreateObject("Scripting.Dictionary")
    Dim dynSet As Object: Set dynSet = CreateObject("Scripting.Dictionary")
    Dim fireSet As Object: Set fireSet = CreateObject("Scripting.Dictionary")
    Dim yoSet As Object: Set yoSet = CreateObject("Scripting.Dictionary")

    Dim reEval As Object: Set reEval = NewRe("Evaluate|Application\.Run|CallByName")

    Dim rslv As Object: Set rslv = CreateObject("Scripting.Dictionary")
    Dim amb As Object: Set amb = CreateObject("Scripting.Dictionary")
    Dim ambC As Object: Set ambC = CreateObject("Scripting.Dictionary")

    Dim rs As Object
    Set rs = mDb.OpenRecordset( _
       "SELECT プロシージャID, TrimCode FROM t01a_コード " & _
       "WHERE コメント行=False AND 空白行=False AND プロシージャID IS NOT NULL " & _
       "ORDER BY プロシージャID, CLng(コードラインID)", 4)
    Do While Not rs.EOF
        Dim ppid As Long: ppid = NzL(rs.Fields(0).Value)
        Dim raw As String: raw = SS(rs.Fields(1).Value)
        Dim clean As String: clean = StripStr(raw)
        If ppid > 0 And Len(clean) > 0 Then
            If reEval.Test(clean) Then dynSet(ppid) = True
            If reNew.Test(clean) Then
                Dim mn As Object, mt As Object
                Set mn = reNew.Execute(clean)
                For Each mt In mn
                    If mInitOf.exists(LK(mt.SubMatches(0))) Then fireSet(ppid) = True
                Next
            End If
            If Not reDecl.Test(clean) Then
                Dim cMod As String: cMod = "": If mModOf.exists(ppid) Then cMod = mModOf(ppid)
                Dim cName As String: cName = "": If mNameOf.exists(ppid) Then cName = mNameOf(ppid)
                rslv.RemoveAll: amb.RemoveAll: ambC.RemoveAll
                DetectLine ppid, cMod, cName, clean, raw, rslv, amb, ambC
                If rslv.Count > 0 Then resSet(ppid) = True
                Dim kk As Variant
                For Each kk In amb.keys
                    If ambC.exists(kk) Then
                        If ambC(kk) = "要判定" Then
                            yoSet(ppid) = True
                            If CLng(amb(kk)) = 1 Then
                                Dim arrc() As String: arrc = Split(CStr(mByName(LK(CStr(kk)))(1)), "|")
                                Dim cpid As Long: cpid = CLng(arrc(0))
                                If KindClass(cpid) = "内部呼び" Then callSet(ppid) = True
                            End If
                        End If
                    End If
                Next
            End If
        End If
        rs.MoveNext
    Loop
    rs.Close

    Dim cCall As Long, cLeaf As Long, cFire As Long, cUndef As Long, cConf As Long, cTotal As Long
    Dim wrs As Object
    Set wrs = mDb.OpenRecordset("SELECT PRC_ID, Prc名, 呼び出しあり, 呼び出しなし, 自動発火, 確認済み FROM t03a_プロシージャ名", 2)
    Do While Not wrs.EOF
        Dim pid As Long: pid = NzL(wrs.Fields("PRC_ID").Value)
        Dim pn As String: pn = SS(wrs.Fields("Prc名").Value)
        If pn <> "(モジュールレベル)" Then
            cTotal = cTotal + 1
            Dim conf As Boolean: conf = (wrs.Fields("確認済み").Value = True)
            If conf Then
                cConf = cConf + 1
                If wrs.Fields("呼び出しあり").Value = True Then cCall = cCall + 1 Else cLeaf = cLeaf + 1
                If wrs.Fields("自動発火").Value = True Then cFire = cFire + 1
            Else
                Dim isFire As Boolean: isFire = fireSet.exists(pid)
                Dim isCall As Boolean: isCall = (callSet.exists(pid) Or resSet.exists(pid) Or dynSet.exists(pid) Or isFire)
                Dim isUndef As Boolean: isUndef = ((Not isCall) And yoSet.exists(pid))
                If isCall Then
                    cCall = cCall + 1
                ElseIf isUndef Then
                    cUndef = cUndef + 1
                Else
                    cLeaf = cLeaf + 1
                End If
                If isFire Then cFire = cFire + 1
                If doWrite Then
                    wrs.Edit
                    wrs.Fields("呼び出しあり").Value = isCall
                    wrs.Fields("呼び出しなし").Value = ((Not isCall) And (Not isUndef))
                    wrs.Fields("自動発火").Value = isFire
                    wrs.Update
                End If
            End If
        End If
        wrs.MoveNext
    Loop
    wrs.Close

    On Error Resume Next
    mDb.Execute "DROP TABLE z_class_summary", 128
    On Error GoTo EH
    mDb.Execute "CREATE TABLE z_class_summary (item TEXT(30), val LONG)", 128
    PutSummary "call", cCall
    PutSummary "leaf", cLeaf
    PutSummary "fire", cFire
    PutSummary "undef", cUndef
    PutSummary "confirmed", cConf
    PutSummary "total_real", cTotal
    PutSummary "wrote", CLng(doWrite)

    PutSummary "v_call", DCount("*", "t03a_プロシージャ名", "呼び出しあり=True")
    PutSummary "v_leaf", DCount("*", "t03a_プロシージャ名", "呼び出しなし=True")
    PutSummary "v_fire", DCount("*", "t03a_プロシージャ名", "自動発火=True")
    PutSummary "v_contra", DCount("*", "t03a_プロシージャ名", "呼び出しあり=True AND 呼び出しなし=True")
    PutSummary "v_conf", DCount("*", "t03a_プロシージャ名", "確認済み=True")
    PutSummary "v_p737nashi", DCount("*", "t03a_プロシージャ名", "PRC_ID=737 AND 呼び出しなし=True")
    Exit Sub
EH:
    On Error Resume Next
    mDb.Execute "CREATE TABLE z_class_summary (item TEXT(30), val LONG)", 128
    PutSummary "error_num", Err.Number
End Sub

Private Sub PutSummary(ByVal item As String, ByVal val As Long)
    mDb.Execute "INSERT INTO z_class_summary (item, val) VALUES ('" & item & "', " & val & ")", 128
End Sub

Public Sub ClassifyProcsT03a_Dry()
    ClassifyProcsT03a False
End Sub
Public Sub ClassifyProcsT03a_Write()
    ClassifyProcsT03a True
End Sub

Public Sub DumpCallDiff()
    On Error GoTo EH
    Set mDb = CurrentDb
    BuildCallTable

    Dim callSet As Object: Set callSet = CreateObject("Scripting.Dictionary")
    Dim dynSet As Object: Set dynSet = CreateObject("Scripting.Dictionary")
    Dim fireSet As Object: Set fireSet = CreateObject("Scripting.Dictionary")
    Dim yoSet As Object: Set yoSet = CreateObject("Scripting.Dictionary")
    Dim rs As Object

    Set rs = mDb.OpenRecordset("SELECT DISTINCT 呼元PrcID FROM z_呼出表", 4)
    Do While Not rs.EOF: callSet(NzL(rs.Fields(0).Value)) = True: rs.MoveNext: Loop
    rs.Close
    Set rs = mDb.OpenRecordset("SELECT DISTINCT プロシージャID FROM z_呼出監査 WHERE 分類='要判定'", 4)
    Do While Not rs.EOF: yoSet(NzL(rs.Fields(0).Value)) = True: rs.MoveNext: Loop
    rs.Close

    Dim reEval As Object: Set reEval = NewRe("Evaluate|Application\.Run|CallByName")
    Set rs = mDb.OpenRecordset( _
       "SELECT プロシージャID, TrimCode FROM t01a_コード " & _
       "WHERE コメント行=False AND 空白行=False AND プロシージャID IS NOT NULL " & _
       "ORDER BY プロシージャID, CLng(コードラインID)", 4)
    Do While Not rs.EOF
        Dim ppid As Long: ppid = NzL(rs.Fields(0).Value)
        Dim clean As String: clean = StripStr(SS(rs.Fields(1).Value))
        If ppid > 0 And Len(clean) > 0 Then
            If reEval.Test(clean) Then dynSet(ppid) = True
            If reNew.Test(clean) Then
                Dim mn As Object, mt As Object
                Set mn = reNew.Execute(clean)
                For Each mt In mn
                    If mInitOf.exists(LK(mt.SubMatches(0))) Then fireSet(ppid) = True
                Next
            End If
        End If
        rs.MoveNext
    Loop
    rs.Close

    On Error Resume Next
    mDb.Execute "DROP TABLE z_call_diff", 128
    On Error GoTo EH
    mDb.Execute "CREATE TABLE z_call_diff (PRC_ID LONG, Mdl TEXT(120), Prc TEXT(120), " & _
                "ps_call LONG, edge LONG, dyn LONG, fire LONG, yo LONG, direction TEXT(20))", 128

    Dim wrs As Object
    Set wrs = mDb.OpenRecordset("SELECT PRC_ID, Mdl名, Prc名, 呼び出しあり, 確認済み FROM t03a_プロシージャ名", 4)
    Do While Not wrs.EOF
        Dim pid As Long: pid = NzL(wrs.Fields("PRC_ID").Value)
        Dim pn As String: pn = SS(wrs.Fields("Prc名").Value)
        Dim md As String: md = SS(wrs.Fields("Mdl名").Value)
        If pn <> "(モジュールレベル)" Then
            Dim psC As Boolean: psC = (wrs.Fields("呼び出しあり").Value = True)
            Dim eg As Boolean: eg = callSet.exists(pid)
            Dim dy As Boolean: dy = dynSet.exists(pid)
            Dim fr As Boolean: fr = fireSet.exists(pid)
            Dim yo As Boolean: yo = yoSet.exists(pid)
            Dim vbaC As Boolean: vbaC = (eg Or dy Or fr)
            If psC <> vbaC Then
                Dim dir As String
                If psC And Not vbaC Then dir = "PS呼び_VBA葉" Else dir = "PS葉_VBA呼び"
                mDb.Execute "INSERT INTO z_call_diff (PRC_ID, Mdl, Prc, ps_call, edge, dyn, fire, yo, direction) VALUES (" & _
                    pid & ", '" & Replace(md, "'", "''") & "', '" & Replace(pn, "'", "''") & "', " & _
                    Abs(psC) & ", " & Abs(eg) & ", " & Abs(dy) & ", " & Abs(fr) & ", " & Abs(yo) & ", '" & dir & "')", 128
            End If
        End If
        wrs.MoveNext
    Loop
    wrs.Close
    Exit Sub
EH:
End Sub

Public Sub RunCallAudit()
    On Error GoTo EH
    Set mDb = CurrentDb
    BuildRe
    BuildSym
    BuildVarTypes
    BuildStop
    EnsureAuditTable
    Set mOut = mDb.OpenRecordset("z_呼出監査", 2, 8)
    Dim rs As Object
    Set rs = mDb.OpenRecordset( _
      "SELECT プロシージャID, コードラインID, TrimCode, 呼出先プロシージャID FROM t01a_コード " & _
      "WHERE コメント行=False AND 空白行=False ORDER BY プロシージャID, CLng(コードラインID)", 4)
    Do While Not rs.EOF
        AuditLine NzL(rs.Fields("プロシージャID").Value), NzL(rs.Fields("コードラインID").Value), _
                  SS(rs.Fields("TrimCode").Value), NzL(rs.Fields("呼出先プロシージャID").Value)
        rs.MoveNext
    Loop
    rs.Close
    mOut.Close
    Set mOut = Nothing
    Exit Sub
EH:
    On Error Resume Next
    If Not mOut Is Nothing Then
        mOut.AddNew
        mOut.Fields("判定").Value = "エラー"
        mOut.Fields("TrimCode").Value = "実行時: " & Err.Number & " " & Err.Description
        mOut.Update
        mOut.Close
    End If
End Sub

Private Function LK(ByVal s As String) As String
    LK = LCase$(s)
End Function

Private Sub BuildRe()
    Dim IDC As String
    IDC = "A-Za-z0-9_" & ChrW(&H3041) & "-" & ChrW(&H3096) _
        & ChrW(&H30A1) & "-" & ChrW(&H30FA) & ChrW(&H30FC) & ChrW(&H3005) _
        & ChrW(&H4E00) & "-" & ChrW(&H9FFF)
    Set reStr = NewRe("""[^""]*""")
    Set reDecl = NewRe("^\s*(Public |Private |Friend )?(Static )?(Sub|Function|Property (Get|Let|Set))\b")
    Set reNew = NewRe("\bNew\s+([" & IDC & "]+)")
    Set reQual = NewRe("([" & IDC & "]+)\.([" & IDC & "]+)")
    Set reCall = NewRe("\bCall\s+([" & IDC & "]+)(\.([" & IDC & "]+))?")
    Set reParen = NewRe("(^|[^" & IDC & ".])([" & IDC & "]+)\s*\(")
    Set reAddr = NewRe("\bAddressOf\s+([" & IDC & "]+)")
    Set reAppRun = NewRe("Application\.Run\s*\(?\s*""([^""]+)""")
    Set reCbn = NewRe("CallByName\s*\(\s*[^,]+,\s*""([^""]+)""")
    Set reLead = NewRe("^\s*([" & IDC & "]+)\s*(.?)")
    Set reAsType = NewRe("([" & IDC & "]+)\s+As\s+(?:New\s+)?([" & IDC & "]+)")
    Set reSetNew = NewRe("\bSet\s+([" & IDC & "]+)\s*=\s*New\s+([" & IDC & "]+)")
    Set reSetCreate = NewRe("\bSet\s+([" & IDC & "]+)\s*=\s*CreateObject")
    Set reDeclKind = NewRe("^\s*(?:Public |Private |Friend )?(?:Static )?(Sub|Function|Property)\b")
    Set reAnyDecl = NewRe("^\s*(Public |Private |Global |Friend |Dim |Static )")
    Set reDotCall = NewRe("\.([" & IDC & "]+)\s*\(")
End Sub

Private Function NewRe(ByVal pat As String) As Object
    Set NewRe = CreateObject("VBScript.RegExp")
    NewRe.Global = True
    NewRe.IgnoreCase = False
    NewRe.Pattern = pat
End Function

Private Sub BuildSym()
    Set mByName = CreateObject("Scripting.Dictionary")
    Set mByModName = CreateObject("Scripting.Dictionary")
    Set mModuleSet = CreateObject("Scripting.Dictionary")
    Set mInitOf = CreateObject("Scripting.Dictionary")
    Set mNameOf = CreateObject("Scripting.Dictionary")
    Set mModOf = CreateObject("Scripting.Dictionary")
    Dim rs As Object
    Set rs = mDb.OpenRecordset("SELECT PRC_ID, Mdl名, Prc名 FROM t03a_プロシージャ名", 4)
    Do While Not rs.EOF
        Dim pid As Long: pid = NzL(rs.Fields("PRC_ID").Value)
        Dim m As String: m = SS(rs.Fields("Mdl名").Value)
        Dim pn As String: pn = SS(rs.Fields("Prc名").Value)
        mModuleSet(LK(m)) = True
        mNameOf(pid) = pn
        mModOf(pid) = m
        If LK(pn) = "class_initialize" Then mInitOf(LK(m)) = pid
        mByModName(LK(m) & "|" & LK(pn)) = pid
        If Len(pn) >= 3 Then
            If Not mByName.exists(LK(pn)) Then mByName.Add LK(pn), New Collection
            mByName(LK(pn)).Add pid & "|" & LK(m)
        End If
        rs.MoveNext
    Loop
    rs.Close
End Sub

Private Sub BuildVarTypes()
    Set mVarType = CreateObject("Scripting.Dictionary")
    Set mVarExt = CreateObject("Scripting.Dictionary")
    Set mModVarType = CreateObject("Scripting.Dictionary")
    Set mModVarExt = CreateObject("Scripting.Dictionary")
    Set mKindOf = CreateObject("Scripting.Dictionary")
    Dim rs As Object
    Set rs = mDb.OpenRecordset( _
      "SELECT プロシージャID, TrimCode FROM t01a_コード " & _
      "WHERE コメント行=False AND 空白行=False ORDER BY プロシージャID, CLng(コードラインID)", 4)
    Do While Not rs.EOF
        Dim pid As Long: pid = NzL(rs.Fields("プロシージャID").Value)
        Dim clean As String: clean = StripStr(SS(rs.Fields("TrimCode").Value))
        If pid > 0 And Len(clean) > 0 Then CollectDecls pid, clean
        rs.MoveNext
    Loop
    rs.Close
End Sub

Private Sub CollectDecls(ByVal pid As Long, ByVal clean As String)
    Dim mk As Object
    If reDeclKind.Test(clean) Then
        Set mk = reDeclKind.Execute(clean)
        If mk(0).SubMatches(0) = "Property" Then mKindOf(pid) = "P" Else mKindOf(pid) = "S"
    End If

    Dim pn As String: pn = "": If mNameOf.exists(pid) Then pn = mNameOf(pid)
    Dim mdl As String: mdl = "": If mModOf.exists(pid) Then mdl = mModOf(pid)
    Dim isModLevel As Boolean: isModLevel = (pn = "(モジュールレベル)")

    Dim mts As Object, mt As Object, vn As String, tp As String
    If isModLevel Or reAnyDecl.Test(clean) Or reDecl.Test(clean) Then
        Set mts = reAsType.Execute(clean)
        For Each mt In mts
            vn = LK(mt.SubMatches(0)): tp = mt.SubMatches(1)
            RegVar pid, mdl, isModLevel, vn, tp
        Next
    End If
    Set mts = reSetNew.Execute(clean)
    For Each mt In mts
        vn = LK(mt.SubMatches(0)): tp = mt.SubMatches(1)
        RegVar pid, mdl, isModLevel, vn, tp
    Next
    Set mts = reSetCreate.Execute(clean)
    For Each mt In mts
        vn = LK(mt.SubMatches(0))
        RegVarExt pid, mdl, isModLevel, vn, "CreateObject"
    Next
End Sub