Takenoff Labs

Lotus Notes/Domino に関する Tips や、クラシックの名曲などを紹介します

[Notes/Domino] 設計解析講座: @関数式のデコンパイル

リッチテキストの本格的な説明に入る前に、基礎的なことをひとつ。今回は@関数式データの取得のお話です。

@関数式の格納形式

@関数式は、ノートにはコンパイルされてから格納されます。コンパイルする関数は、NSFNoteCompile です。(コンパイル方法については、面倒くさいので今回は扱いません。)

たとえば、ビューで「SELECT Form = "Test"」という選択式を入力した場合、以下のような感じで格納されます。

46 00 05 00 1A 00 15 00 02 00 F.........
09 00 04 00 24 43 6F 6E 66 6C ....$Confl
69 63 74 24 52 45 46 00 04 00 ict$REF...
04 00 00 00 18 00 05 00 04 00 ..........
46 6F 72 6D 01 00 04 00 54 65 Form....Te
73 74 0A 02 03 00 07 00 0E 00 st........
08 00 09 4C 31 53 32 53 33 53 ...L1S2S3S

見ておわかりのとおり、さっぱりわかりません(^^; まあ、知る必要もないですね。

デコンパイル

コンパイルされたデータを元のソースコードに戻す(デコンパイルする)には、NSFFormulaDecompile 関数を使います。関数の定義は以下のようになっています。

STATUS LNPUBLIC NSFFormulaDecompile(
char far *pFormulaBuffer,
BOOL fSelectionFormula,
DHANDLE far *rethFormulaText,
WORD far *retFormulaTextLength);

pFormulaBuffer に@関数式の先頭のアドレスを渡すと、rethFormulaText にデコンパイルされたコードへのハンドルが、retFormulaTextLength にその長さが返る、という感じになっています。

面白いのは fSelectionFormula 引数。これは、デコンパイルされたコードの先頭に「SELECT」を付けるかどうか、というものです。そう、選択式の「SELECT」って単なる飾りで、データとしては格納されていないんです。なので、選択式の場合は第2引数は True、それ以外は False としてください。

関数実行後は、rethFormulaText に文字列データへのハンドルが返るので、OSLockObject でメモリをロックしてから RtlMoveMemory でデータを読み取り、OSUnlockObject でロックを解除する、という手順で読み取ります。最後に、rethFormulaText は OSMemFree で解放する必要がある点は注意してください。

サンプルコード

前回、ビューのアクションボタンを解析するコードを書きましたが、今回はそれに付け加えてアクションボタンの非表示式も取得するコードにしました(追加したところはコメントしてあります)。APIFormulaDecompile 関数が今回のメインですので、そこを中心にご覧ください。

Const WORDLEN = 65534

Const OS_TRANSLATE_NATIVE_TO_LMBCS = 0
Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1

Const NOTESDLL = "nnotes.dll"

Const SIG_CD_ACTION = 190

Type BLOCKID
    hPool As Long
    Block As Integer
End Type

Declare Function NSFItemInfo Lib NOTESDLL (Byval hNote As Long, Byval ItemName As Any, _
Byval NameLen As Integer, ItemBlockid As BLOCKID, ValueDatatype As Integer, _
ValueBlockid As BLOCKID, ValueLen As Long) As Integer

Declare Function NSFItemInfoNext Lib NOTESDLL (Byval hNote As Long, Byval hPool As Long, _
Byval Block As Integer, Byval ItemName As Any, Byval NameLen As Integer, ItemBlockid As BLOCKID, _
ValueDatatype As Integer, ValueBlockid As BLOCKID, ValueLen As Long) As Integer

'↓*** 追加 ***
Declare Function NSFFormulaDecompile Lib NOTESDLL (Byval pFormulaBuffer As Long, _
Byval fSelectionFormula As Integer, rethFormulaText As Long, retFormulaTextLength As Long) As Integer
'↑*** 追加 ***

Declare Function OSLockObject Lib NOTESDLL (Byval hHandle As Long) As Long

Declare Function OSUnlockObject Lib NOTESDLL (Byval hHandle As Long) As Integer

Declare Function OSTranslate Lib NOTESDLL (Byval TranslateMode As Integer, _
Byval InData As String, Byval InLength As Long, Byval OutData As String, _
Byval OutLength As Long) As Integer

Declare Function OSLoadString Lib NOTESDLL (Byval hModule As Long, Byval StringCode As Long, _
Byval retBuffer As String, Byval BufferLength As Integer) As Integer

Declare Sub RtlMoveMemoryString Lib "kernel32" Alias "RtlMoveMemory" (Byval hpvDest As String, _
Byval hpvSource As Long, Byval cbCopy As Long)

Declare Sub RtlMoveMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, Byval hpvSource As Long, _
Byval cbCopy As Long)

'↓*** 追加 ***
Declare Sub OSMemFree Lib NOTESDLL (Byval hHandle As Long)
'↑*** 追加 ***

Sub Initialize
    Dim ss  As New NotesSession
    Dim db  As NotesDatabase
    Dim doc As NotesDocument
    
    Dim ItemBlockid  As BLOCKID
    Dim ValueBlockid As BLOCKID
    Dim strItemName  As String
    Dim lngLen       As Long
    Dim lngAddr      As Long
    Dim lngCnt       As Long
    Dim lngCDLen     As Long
    Dim intDataType  As Integer
    Dim intRet       As Integer
    Dim intSig       As Integer
    Dim intFlg       As Integer
    
    Set db  = ss.CurrentDatabase
    Set doc = db.GetDocumentByID("FFFF0008")
    
    If doc Is Nothing Then
        Msgbox "文書が見つかりません", 0, "エラー"
        Exit Sub
    End If
    
    strItemName = "$ACTIONS"
    
    intRet = NSFItemInfo(doc.handle, strItemName, Lenbp(strItemName), ItemBlockid, intDataType, ValueBlockid, lngLen)
    If intRet <> 0 Then
        Msgbox APIGetError(intRet), 0, "エラー"
        Exit Sub
    End If
    
    Do
        'メモリをロック
        lngAddr = OSLockObject(ValueBlockid.hPool) + Val("&B" & Right(Bin$(ValueBlockid.Block), 16) & "&")
        
        lngAddr = lngAddr + 2 '最初の2バイトはアイテムタイプなので読み飛ばす
        lngLen  = lngLen - 2  'アイテムタイプを除いた値のサイズ
        
        lngCnt = 0
        intFlg = 0
        Do
            Call RtlMoveMemory(intSig, lngAddr, 1)
            Call RtlMoveMemory(intFlg, lngAddr + 1, 1)
            
            Select Case intFlg
            Case &H00 'DWORD Signature
                If (lngCnt + 2 + 4) => lngLen Then Exit Do
                Call RtlMoveMemory(lngCDLen, lngAddr + 2, 4)
                
                '(↓ここに分析用の処理を記述)
                Select Case intSig
                Case SIG_CD_ACTION
                    Call ReadCDAction(lngAddr)
                End Select
                '(↑ここに分析用の処理を記述)
                
            Case &HFF 'WORD Signature
                If (lngCnt + 2 + 2) => lngLen Then Exit Do
                Call RtlMoveMemory(lngCDLen, lngAddr + 2, 2)
                
                '(↓ここに分析用の処理を記述)
                Select Case intSig
                Case SIG_CD_ACTION
                    Call ReadCDAction(lngAddr)
                End Select
                '(↑ここに分析用の処理を記述)
                
            Case Else 'BYTE Signature
                lngCDLen = intFlg
                
                '(↓ここに分析用の処理を記述)
                
                '(↑ここに分析用の処理を記述)
                
            End Select
            
            If intSig <= 0 Or lngCDLen <= 0 Then Exit Do '念のため
            
            'CDレコードのサイズ分足す
            lngAddr = lngAddr + lngCDLen
            lngCnt  = lngCnt  + lngCDLen
            
            '偶数アドレスにする
            lngAddr = lngAddr + (lngAddr And 1&)
            lngCnt  = lngCnt  + (lngCnt  And 1&)
            
        Loop While lngCnt < lngLen
        
        'メモリロックを解除
        Call OSUnlockObject(ValueBlockid.hPool)
        
        Loop While NSFItemInfoNext(doc.handle, ItemBlockid.hPool, ItemBlockid.Block, strItemName, Lenbp(strItemName), _
    ItemBlockid, intDataType, ValueBlockid, lngLen) = 0
End Sub

Function APITranslate(Byval intMode As Integer, Byval strBuf As String) As String
    Dim strOut As String
    
    strOut = Space$(WORDLEN)
    Call OSTranslate(intMode , strBuf, Lenbp(strBuf) - 1, strOut, WORDLEN - 1)
    APITranslate = Strleft(strOut & Chr(0), Chr(0))
End Function

Function APIGetError(Byval intErrCode As Integer) As String
    Dim strIn   As String
    Dim strOut  As String
    Dim intCode As Integer
    
    strIn  = Space$(255)
    strOut = Space$(255)
    
    intCode = intErrCode And &h3FFF
    Call OSLoadString(0, intCode, strIn, Lenbp(strIn) - 1)
    
    strOut = APITranslate(OS_TRANSLATE_LMBCS_TO_NATIVE, strIn)
    
    APIGetError = Trim(strOut)
End Function

Sub APIMoveMemory(varVal As Variant, lngAddr As Long, Byval lngLen As Long)
    Call RtlMoveMemory(varVal, lngAddr, lngLen)
    lngAddr = lngAddr + lngLen
End Sub

Sub APIMoveMemoryString(strVal As String, lngAddr As Long, Byval lngLen As Long)
    strVal = Space$(lngLen + 1)
    Call RtlMoveMemoryString(strVal, lngAddr, lngLen)
    lngAddr = lngAddr + lngLen
End Sub

'↓*** 追加 ***
Public Function APIFormulaDecompile(Byval lngAddr As Long, Byval intFlag As Integer) As String
    Dim strRet As String    
    Dim hText  As Long
    Dim lngLen As Long
    Dim lngRet As Long
    Dim intRet As Integer
    
    strRet = ""
    intRet = NSFFormulaDecompile(lngAddr, intFlag, hText, lngLen)
    
    If hText <> 0 And intRet = 0 Then
        lngRet = OSLockObject(hText)
        
        strRet = Space$(lngLen + 1)
        Call APIMoveMemoryString(strRet, lngRet, lngLen)
        strRet = APITranslate(OS_TRANSLATE_LMBCS_TO_NATIVE, strRet)
        
        Call OSUnlockObject(hText)
    End If
    Call OSMemFree(hText)
    
    APIFormulaDecompile = strRet
End Function
'↑*** 追加 ***

Sub ReadCDAction(Byval lngAddr As Long)
    Dim strName As String
    Dim strHideFormula As String
    Dim intSig As Integer
    Dim lngLen As Long
    Dim intType As Integer
    Dim intIconIndex As Integer
    Dim lngFlags As Long
    Dim lngTitleLen As Long
    Dim lngFormulaLen As Long
    Dim lngShareId As Long
    
    On Error Goto ERR_CASE
    
    Call APIMoveMemory(intSig, lngAddr, 2)
    Call APIMoveMemory(lngLen, lngAddr, 4)
    Call APIMoveMemory(intType, lngAddr, 2)
    Call APIMoveMemory(intIconIndex, lngAddr, 2)
    Call APIMoveMemory(lngFlags, lngAddr, 4)
    Call APIMoveMemory(lngTitleLen, lngAddr, 2)
    Call APIMoveMemory(lngFormulaLen, lngAddr, 2)
    Call APIMoveMemory(lngShareId, lngAddr, 4)
    
    'アクション名
    If lngTitleLen > 0 Then
        Call APIMoveMemoryString(strName, lngAddr, lngTitleLen)
        strName = APITranslate(OS_TRANSLATE_LMBCS_TO_NATIVE, strName) '変更
    End If
    
    '↓*** 追加 ***
    
    'アクション内容(読み飛ばす)
    If (lngLen - lngTitleLen - lngFormulaLen - 22) > 0 Then '22は構造体のサイズ
        lngAddr = lngAddr + (lngLen - lngTitleLen - lngFormulaLen - 22)
    End If
    
    '非表示式
    If lngFormulaLen > 0 Then
        strHideFormula = APIFormulaDecompile(lngAddr, False)
    End If
    
    '表示
    Msgbox strHideFormula, 0, strName
    
    '↑*** 追加 ***
    
    Exit Sub
    
ERR_CASE:
    Msgbox "Error - " & Getthreadinfo(1) & " Line:" & Cstr(Erl) & " Msg:" & Error$, 0, "Error"
    Exit Sub
End Sub

この連載も今回で18回目になりますが、ここまでの知識で NotesPeek みたいなツールが作れちゃいます。まあ、LotusScript で作ると、NotesPeek みたいな UI は到底不可能ですが、最近はフリーソフトをインストールできない会社だらけになっちゃいましたから、LotusScript で作る意味は多少あるかと。管理人が作ったツールを近々アップする予定ですので、(欲しい人は(いるのか?(^^; ))ご期待くださいませ。

※ アップするカテゴリは「Notes/Domino > ソフトウエア」になります。
※ 間に小ネタを挟む予定なので、次々回~次々々回くらいになると思います。
※ 去年の初めにアップすると言ったことは気にしない方向でお願いします(汗

1 Star2 Stars3 Stars4 Stars5 Stars (No Ratings Yet)
読み込み中...

トラックバック

トラックバックはありません

コメント

コメントはありません

※コメントは承認制となっております。管理者が承認するまで表示されません。申し訳ありませんが、投稿が表示されるまでしばらくお待ちください。





(以下のタグが使えます)
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

For spam filtering purposes, please copy the number 8645 to the field below:

^
×