トークン化する

'--------------------------------------------------
'プロシージャの概要:
'処理名:コメントトークン化処理
'概要:t01ソースコードテーブルのコメント部分をトークンに置換してt02aコメントなしテーブルを作成
'--------------------------------------------------
Public Sub createコメントトークン化()
    Dim db As DAO.Database
    Dim rsSource As DAO.Recordset
    Dim rsTarget As DAO.Recordset
    Dim rsToken As DAO.Recordset
    Dim lngTokenCounter As Long
    Dim strSQL As String
    Dim strCode As String
    Dim strTokenizedCode As String
    
    ' カレントデータベースを取得
    Set db = CurrentDb
    
    ' トークンカウンターを初期化
    lngTokenCounter = 0
    
    ' 既存データをクリア
    db.Execute "DELETE FROM t02aコメントなし"
    db.Execute "DELETE FROM t02aコメントトークン管理"
    
    ' レコードセットを開く
    strSQL = "SELECT * FROM t01ソースコードテーブル ORDER BY コードラインID"
    Set rsSource = db.OpenRecordset(strSQL)
    
    Set rsTarget = db.OpenRecordset("t02aコメントなし")
    Set rsToken = db.OpenRecordset("t02aコメントトークン管理")
    
    ' 各レコードを処理
    Do While Not rsSource.EOF
        ' コードを取得
        strCode = Nz(rsSource!トリムコード, "")
        
        ' コメントトークン化処理
        strTokenizedCode = tokenizeコメント(strCode, rsSource!コードラインID, lngTokenCounter, rsToken)
        
        ' t02aコメントなしテーブルにレコード追加
        rsTarget.AddNew
        rsTarget!コードライン番号 = rsSource!コードラインID
        rsTarget!モジュール名 = rsSource!モジュール名
        rsTarget!プロシージャ名 = rsSource!プロシージャ名
        rsTarget!コード = strTokenizedCode
        rsTarget.Update
        
        rsSource.MoveNext
    Loop
    
    ' リソース解放
    rsSource.Close
    rsTarget.Close
    rsToken.Close
    Set rsSource = Nothing
    Set rsTarget = Nothing
    Set rsToken = Nothing
    Set db = Nothing
    
    MsgBox "コメントトークン化処理が完了しました。" & vbCrLf & _
           "トークン数: " & lngTokenCounter, vbInformation
End Sub

'--------------------------------------------------
'プロシージャの概要:
'処理名:コメントトークン化関数
'概要:1行のコードからコメント部分を検出してトークンに置換
'strCode:処理対象のコード行
'lngLineID:元のコードラインID
'lngTokenCounter:トークンカウンター（参照渡し）
'rsToken:トークン管理テーブルのレコードセット
'戻り値:トークン化されたコード
'--------------------------------------------------
Private Function tokenizeコメント(strCode As String, lngLineID As Long, _
                                ByRef lngTokenCounter As Long, _
                                ByRef rsToken As DAO.Recordset) As String
    Dim strResult As String
    Dim intCommentPos As Integer
    Dim strCommentPart As String
    Dim strCodePart As String
    Dim strTokenName As String
    Dim blnInString As Boolean
    Dim i As Integer
    
    strResult = strCode
    
    ' 文字列リテラル内のシングルクォートを考慮してコメント位置を検索
    blnInString = False
    For i = 1 To Len(strCode)
        If Mid(strCode, i, 1) = Chr(34) Then ' ダブルクォート
            blnInString = Not blnInString
        ElseIf Mid(strCode, i, 1) = "'" And Not blnInString Then
            intCommentPos = i
            Exit For
        End If
    Next i
    
    ' コメントが見つかった場合
    If intCommentPos > 0 Then
        ' コード部分とコメント部分を分離
        strCodePart = Trim(Left(strCode, intCommentPos - 1))
        strCommentPart = Mid(strCode, intCommentPos)
        
        ' トークン名を生成
        lngTokenCounter = lngTokenCounter + 1
        strTokenName = "@comment" & lngTokenCounter
        
        ' トークン管理テーブルにレコード追加
        rsToken.AddNew
        rsToken!トークンID = lngTokenCounter
        rsToken!元コードライン番号 = lngLineID
        rsToken!トークン文字列 = strTokenName
        rsToken!元コメント内容 = strCommentPart
        
        ' コメント種別を判定
        If Len(strCodePart) > 0 Then
            rsToken!コメント種別 = "行末コメント"
        Else
            rsToken!コメント種別 = "単独行コメント"
        End If
        
        rsToken.Update
        
        ' トークン化されたコードを作成
        If Len(strCodePart) > 0 Then
            strResult = strCodePart & " " & strTokenName
        Else
            strResult = strTokenName
        End If
    End If
    
    tokenizeコメント = strResult
End Function