作成者	カテゴリ	返答の対象		公開
あいこ 07/26/2006 09:21 AM		エージェントログ内容のメール送信について

教えていただいたキャッシュを基に２点手を加えエージェントログの取得ができました。
１バグ修正
２微修正
少し大きな文書となりますが、以下ご報告いたします。
お助けありがとうございました。



'Option *** 暗黙の宣言を禁止
Option Explicit



'Declarations *** 定数の読み込み
%INCLUDE "LSCONST.LSS"

Dim s_sMessage As String

' *** TIMEDATE構造体
Type TIMEDATE
lLnnards(0 To 1) As Long
End Type


' *** BLOCKID構造体
Type BLOCKID
' *** プールハンドル
pool As Long

' *** ブロックハンドル
block As Long
End Type

' *** OBJECT_DESCRIPTOR構造体
Type OBJECT_DESCRIPTOR
' *** オブジェクト種類
ObjectType As Integer
' *** オブジェクトID
RRV As Long
End Type

' *** ODS_ASSISTRUNOBJECTHEADER構造体
Type ODS_ASSISTRUNOBJECTHEADER
dwFlags As Long
wEntries As Integer
wSpare As Integer
End Type

' *** ODS_ASSISTRUNOBJECTENTRY構造体
Type ODS_ASSISTRUNOBJECTENTRY
dwLength As Long
dwFlags As Long
End Type

' *** ODS_ASSISTRUNINFO構造体
Type ODS_ASSISTRUNINFO
' *** エージェントが最後に実行された日時
LastRun As TIMEDATE
' *** 最後の実行で処理された文書数
dwProcessed As Long
' *** アシスタントが最後に変更された日時
AssistMod As TIMEDATE
' *** アシスタントが最後に実行されたDBID
DbID As TIMEDATE
' *** アシスタントが最後に実行されたときの終了コード
dwExitCode As Long
dwSpare( 0 To 3 ) As Long
End Type


' *** ノーツAPIの定義
Declare Function OSPathNetConstruct Lib "nnotes.dll" ( PortName As Any, Byval ServerName As String, Byval FileName As String, Byval retPathName As String ) As Integer
Declare Function OSTranslate Lib "nnotes.dll" ( Byval TranslateMode As Integer, Byval InData As String, Byval InLength As Integer, Byval OutData As String, Byval OutLength As Integer ) As Integer
Declare Function OSLoadString Lib "nnotes.dll" ( Byval hModule As Long, Byval StringCode As Long, Byval retBuffer As String, Byval BufferLength As Integer ) As Integer
Declare Function OSLockObject Lib "nnotes.dll" ( Byval Handle As Long ) As Long
Declare Function OSUnlockObject Lib "nnotes.dll" ( Byval Handle As Long ) As Integer
Declare Function OSMemFree Lib "nnotes.dll" ( Byval Handle As Long ) As Integer
Declare Sub ODSReadMemory Lib "nnotes.dll" ( ppSrc As Long, Byval wtype As Integer, pDest As Any, Byval iterations As Integer )
Declare Function ODSLength Lib "nnotes.dll" ( Byval ODStype As Integer ) As Integer
Declare Function ConvertTIMEDATEToText Lib "nnotes.dll" ( IntlFormat As Any, TextFormat As Any, InputTime As TIMEDATE, Byval retTextBuffer As String, Byval TextBufferLength As Integer, retTextLength As Integer ) As Integer
Declare Function NSFDbOpen Lib "nnotes.dll" ( Byval PathName As String, rethDB As Long ) As Integer
Declare Function NSFDbClose Lib "nnotes.dll" ( Byval hDB As Long ) As Integer
Declare Public Function NSFDbReadObject Lib "nnotes.dll" ( Byval hDB As Long, Byval ObjectID As Long, Byval Offset As Long, Byval Length As Long, rethBuffer As Long ) As Integer
Declare Function NIFFindDesignNote Lib "nnotes.dll" ( Byval hFile As Long, Byval DesignName As String, Byval ClassKbn As Integer, retNoteID As Long ) As Integer
Declare Function NSFNoteOpen Lib "nnotes.dll" ( Byval db_handle As Long, Byval note_id As Long, Byval open_flags As Integer, note_handle As Long ) As Integer
Declare Function NSFNoteClose Lib "nnotes.dll" ( Byval note_handle As Long ) As Integer
Declare Function NSFItemInfo Lib "nnotes.dll" ( Byval note_handle As Long, Byval item_name As String, Byval name_len As Integer, item_blockid As Any, value_datatype As Integer, value_blockid As BLOCKID, value_len As Long ) As Integer



' *** WIndowsAPIの定義
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( Destination As Any, Source As Any, Byval Length As Long )
Declare Sub MoveMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( Byval Destination As String, Source As Any, Byval Length As Long )



Sub Initialize

' *** 変数の宣言
Dim iErrorCode As Integer

' *** データベースのパスを作成
Const MAXPATH = 256
Dim sFullPathName As String
sFullPathName = Space$( MAXPATH )
iErrorCode = OSPathNetConstruct( Byval &h0, "severID","dir\test.nsf", sFullPathName )

' *** データベースのオープン
Dim hDb As Long
iErrorCode = NSFDbOpen( sFullPathName, hDb )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** エージェントのオープン
Call openAgent( hDb )
End If

' *** データベースのクローズ
If ( hDb <> 0 ) Then iErrorCode = NSFDbClose( hDb )

' *** エージェントの実行結果を表示
If ( s_sMessage = "" ) Then
Msgbox "エージェントは実行されたことがありません", MB_OK + MB_ICONINFORMATION, "エージェントログ送信"
Else
Msgbox s_sMessage, MB_OK + MB_ICONINFORMATION, "エージェントログ送信"
End If
End Sub



Sub openAgent( p_hDb As Long )

' *** 変数の宣言
Dim iErrorCode As Integer

' *** エージェントの文書IDを取得
Dim lAgentNoteID As Long
Const NOTE_CLASS_FILTER = &h0200
iErrorCode = NIFFindDesignNote( p_hDb, toLMBCS( "TestAgent" ),NOTE_CLASS_FILTER, lAgentNoteID )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** エージェントのオープン
Dim hAgentNote As Long
iErrorCode = NSFNoteOpen( p_hDb, lAgentNoteID, 0, hAgentNote )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** エージェントの実行情報オブジェクトを取得
Call getObjInfo( p_hDb, hAgentNote )
End If

' *** エージェントをクローズ
If ( hAgentNote <> 0 ) Then iErrorCode = NSFNoteClose( hAgentNote )
End If
End Sub



Sub getObjInfo( p_hDb As Long, p_hAgentNote As Long )

' *** 変数の宣言
Dim iErrorCode As Integer

' *** エージェントの実行情報オブジェクトを取得
Dim iDataType As Integer
Dim stValueBlockID As BLOCKID
Dim lValueLen As Long
Const ASSIST_RUNINFO_ITEM = "$AssistRunInfo"
iErrorCode = NSFItemInfo( p_hAgentNote, ASSIST_RUNINFO_ITEM ,Len( ASSIST_RUNINFO_ITEM ), Byval &h0, iDataType, stValueBlockID, lValueLen )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** 実行情報オブジェクトの先頭アドレスを取得
Dim lObjectAddress As Long
lObjectAddress = OSLockObject( stValueBlockID.pool ) + stValueBlockID.block
Const ODS_TYPE_WORD = 0
lObjectAddress = lObjectAddress + ODSLength( ODS_TYPE_WORD )

' *** 実行情報オブジェクトの読み込み
Dim stObjInfo As OBJECT_DESCRIPTOR
Call MoveMemory( stObjInfo.ObjectType, Byval lObjectAddress, 2 )
Call MoveMemory( stObjInfo.RRV, Byval lObjectAddress + 2, 4 )

' *** エージェントのオブジェクトヘッダを取得
Call getRunHeader( p_hDb, stObjInfo )

' *** 実行情報オブジェクトのアンロック
iErrorCode = OSUnlockObject( stValueBlockID.pool )
End If
End Sub



Sub getRunHeader( p_hDb As Long, p_stObjInfo As OBJECT_DESCRIPTOR )

' *** 変数の宣言
Dim iErrorCode As Integer

' *** エージェントにより追加されるオブジェクトのヘッダーを取得
Dim lOffset As Long
lOffset = 0
Const ODS_TYPE_ASSISTRUNOBJECTHEADER = 374
Dim hBuffer As Long
iErrorCode = NSFDbReadObject( p_hDb, p_stObjInfo.RRV, lOffset, ODSLength( ODS_TYPE_ASSISTRUNOBJECTHEADER ), hBuffer )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** レコードの先頭アドレスを取得
Dim lObjectAddress As Long
lObjectAddress = OSLockObject( hBuffer )

' *** レコードより情報の取得
Dim stRunHeader As ODS_ASSISTRUNOBJECTHEADER
Call MoveMemory( stRunHeader.dwFlags, Byval lObjectAddress, 4 )
Call MoveMemory( stRunHeader.wEntries, Byval lObjectAddress + 4, 2 )
Call MoveMemory( stRunHeader.wSpare, Byval lObjectAddress + 6, 2 )

' *** レコードのアンロック
iErrorCode = OSUnlockObject( hBuffer )

' *** レコードの解放
iErrorCode = OSMemFree( hBuffer )

' *** エージェントにより追加されたオブジェクトの長さを含むレコードを取得
lOffset = lOffset + ODSLength( ODS_TYPE_ASSISTRUNOBJECTHEADER )
Call getRunEntries( p_hDb, p_stObjInfo, stRunHeader, lOffset )
End If
End Sub



Function toLMBCS( p_sInBuffer As String ) As String

' *** 変数の宣言
Dim sOutBuffer As String

' *** ロータスマルチバイト文字セットに文字列を変換
sOutBuffer = Space$( Lenbp( p_sInBuffer ) * 3 + 1 )
Const OS_TRANSLATE_NATIVE_TO_LMBCS = 0
Call OSTranslate( OS_TRANSLATE_NATIVE_TO_LMBCS, p_sInBuffer,Lenbp( p_sInBuffer ), sOutBuffer, Lenbp( sOutBuffer ) )

' *** 変換した文字列を返す
toLMBCS = Left$( sOutBuffer, Instr( sOutBuffer, Chr$( 0 ) ) -1 )

End Function



Function toNATIVE( p_sInBuffer As String ) As String

' *** 変数の宣言
Dim sOutBuffer As String

' *** ネイティブ文字セットに文字列を変換
sOutBuffer = Space$( Lenbp( p_sInBuffer ) + 1 )
Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1
Call OSTranslate( OS_TRANSLATE_LMBCS_TO_NATIVE, p_sInBuffer, Lenbp( p_sInBuffer ), sOutBuffer, Lenbp( sOutBuffer ) )

' *** 変換した文字列を返す
toNATIVE = Left$( sOutBuffer, Instr( sOutBuffer, Chr$( 0 ) ) -1 )

End Function



Function getErrorMessage( p_iErrorCode As Integer ) As String

' *** 変数の宣言
Dim iErrorCode As Integer
Dim sErrorMessageIn As String
Dim sErrorMessageOut As String

' *** 初期値の設定
sErrorMessageIn = Space$( 255 )
sErrorMessageOut = Space$( 255 )

' *** リソースファイルから文字列をロード
iErrorCode = p_iErrorCode And &h3fff
Call OSLoadString( 0, iErrorCode, sErrorMessageIn, Len( sErrorMessageIn ) - 1 )

' *** ネイティブ文字セットに文字列を変換
Const OS_TRANSLATE_LMBCS_TO_NATIVE = 1
Call OSTranslate( OS_TRANSLATE_LMBCS_TO_NATIVE, sErrorMessageIn,Len( sErrorMessageIn ) - 1, sErrorMessageOut, Len( sErrorMessageOut ) - 1 )

' *** 変換した文字列を返す
sErrorMessageOut = Left$( sErrorMessageOut, Instr( sErrorMessageOut, Chr$( 0 ) ) -1 )

' *** エラーメッセージを返す
getErrorMessage = sErrorMessageOut

End Function



Sub getRunEntries( p_hDb As Long, p_stObjInfo As OBJECT_DESCRIPTOR, p_stRunHeader As ODS_ASSISTRUNOBJECTHEADER, p_lOffset As Long )

' *** 変数の宣言
Dim iErrorCode As Integer

' *** エージェントにより追加されたオブジェクトの長さを含むレコードを取得
Dim hBuffer As Long
Const ODS_TYPE_ASSISTRUNOBJECTENTRY = 375
iErrorCode = NSFDbReadObject( p_hDb, p_stObjInfo.RRV, p_lOffset, ODSLength( ODS_TYPE_ASSISTRUNOBJECTENTRY ) * p_stRunHeader.wEntries, hBuffer )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else
' *** レコードの先頭アドレスを取得
Dim lObjectAddress As Long
lObjectAddress = OSLockObject( hBuffer )

' *** レコードより情報の取得
Redim stRunEntry( 0 To p_stRunHeader.wEntries - 1 ) As ODS_ASSISTRUNOBJECTENTRY
Dim iIndex As Integer

For iIndex = 0 To ( p_stRunHeader.wEntries - 1 ) Step 1
Call MoveMemory( stRunEntry( iIndex ).dwLength, Byval lObjectAddress, 4 )
Call MoveMemory( stRunEntry( iIndex ).dwFlags, Byval lObjectAddress + 4, 4 )
lObjectAddress = lObjectAddress + 8
Next iIndex

' *** レコードのアンロック
iErrorCode = OSUnlockObject( hBuffer )

' *** レコードの解放
iErrorCode = OSMemFree( hBuffer )

' *** エージェント実行レコードの取得
p_lOffset = p_lOffset + ODSLength( ODS_TYPE_ASSISTRUNOBJECTENTRY ) * p_stRunHeader.wEntries
Call getRunInfo( p_hDb, p_stObjInfo, p_lOffset )

' *** ログを取得
p_lOffset = p_lOffset + stRunEntry( 0 ).dwLength
For iIndex = 1 To p_stRunHeader.wEntries - 1 Step 1

If ( stRunEntry( iIndex ).dwLength <> 0 ) Then
iErrorCode = NSFDbReadObject( p_hDb, p_stObjInfo.RRV, p_lOffset, stRunEntry( iIndex ).dwLength, hBuffer )
lObjectAddress = OSLockObject( hBuffer )

If ( iIndex = 2 ) Then
' *** ログの退避
Dim sLog As String
sLog = String$( stRunEntry( iIndex ).dwLength + 1, Chr$( 0 ) )
Call MoveMemory2( sLog, Byval lObjectAddress, stRunEntry( iIndex ).dwLength )
sLog = Left$( sLog, Instr( sLog, Chr$( 0 ) ) -1 )
s_sMessage = s_sMessage + Chr$( 13 ) + toNATIVE( sLog )
End If
p_lOffset = p_lOffset + stRunEntry( iIndex ).dwLength
iErrorCode = OSUnlockObject( hBuffer )
iErrorCode = OSMemFree( hBuffer )
End If
Next iIndex
End If
End Sub



Sub getRunInfo( p_hDb As Long, p_stObjInfo As OBJECT_DESCRIPTOR, p_lOffset As Long )

' *** 変数の宣言
Dim iErrorCode As Integer
' *** エージェント実行レコードの取得
Dim hBuffer As Long
Const ODS_TYPE_ASSISTRUNINFO = 326
iErrorCode = NSFDbReadObject( p_hDb, p_stObjInfo.RRV, p_lOffset, ODSLength( ODS_TYPE_ASSISTRUNINFO ), hBuffer )

If ( iErrorCode <> 0 ) Then
' *** エラーメッセージの表示
Messagebox getErrorMessage( iErrorCode ), MB_OK + MB_ICONSTOP
Else

' *** レコードの先頭アドレスを取得
Dim lObjectAddress As Long
lObjectAddress = OSLockObject( hBuffer )

' *** レコードより情報の取得
Dim stRunInfo As ODS_ASSISTRUNINFO
Call MoveMemory( stRunInfo.LastRun, Byval lObjectAddress, 8 )
Call MoveMemory( stRunInfo.dwProcessed, Byval lObjectAddress + 8, 4 )
Call MoveMemory( stRunInfo.AssistMod, Byval lObjectAddress + 12, 8 )
Call MoveMemory( stRunInfo.DbID, Byval lObjectAddress + 20, 8 )
Call MoveMemory( stRunInfo.dwExitCode, Byval lObjectAddress + 28, 4 )

' *** レコードのアンロック
iErrorCode = OSUnlockObject( hBuffer )

' *** レコードの解放
iErrorCode = OSMemFree( hBuffer )

' *** エージェントが最後に実行された日時を取得
Const MAXALPHATIMEDATE = 80
Dim sLastRun As String
sLastRun = String$( MAXALPHATIMEDATE + 1, Chr$( 0 ) )
Dim iTextLength As Integer
Call ConvertTIMEDATEToText( Byval &h0, Byval &h0, stRunInfo.LastRun, sLastRun, MAXALPHATIMEDATE, iTextLength )
sLastRun = Left$( sLastRun, Instr( sLastRun, Chr$( 0 ) ) -1 )

' *** 最後に実行された日時、最後の実行で処理された文書数の退避
If ( sLastRun <> "" ) Then
s_sMessage = s_sMessage + "最後に実行された日時：" + sLastRun + Chr$( 13 )
s_sMessage = s_sMessage + "最後の実行で処理された文書数：" + Cstr( stRunInfo.dwProcessed ) + Chr$( 13 )
End If
End If
End Sub