Subject: code
actual usage:
Dim s as new NotesSession
Dim ai as new AgentInfo(s, Nothing, Nothing)
if (ai.IsWebQueryOpen() = False) Then
'print to screen
else
’ do it another way
end if
'some declares
Public Const NO_ERROR% = 0
Public Const OS_TRANSLATE_LMBCS_TO_UNICODE% = 20
Public Const OS_TRANSLATE_UNICODE_TO_LMBCS% = 23
Public Const wAPIModule$ = “NNOTES” ’ Windows/32
’ ++ CORE API CALLS ++
Declare Public Function W32_NSFDbOpen Lib wAPIModule Alias “NSFDbOpen” _
( Byval P As String, hDB As Long) As Integer
Declare Public Function W32_NSFDbClose Lib wAPIModule Alias “NSFDbClose” _
(Byval hDB As Long) As Integer
Declare Public Function W32_NSFDbIsLocallyEncrypted Lib wAPIModule Alias “NSFDbIsLocallyEncrypted” _
( Byval hDB As Long, _
pBool As Integer) As Integer
Declare Public Function W32_OSPathNetConstruct Lib wAPIModule Alias “OSPathNetConstruct” _
( Byval NullPort As Long, _
Byval Server As String, _
Byval FIle As String, _
Byval PathNet As String) As Integer
Declare Public Function W32_NSGetServerList Lib wAPIModule Alias “NSGetServerList” _
(Byval pPortName As Lmbcs String, _
retServerList As Long) As Integer
Declare Public Function W32_NSGetServerListAll Lib wAPIModule Alias “NSGetServerList” _
(Byval pPortNameNULL As Long, _
retServerList As Long) As Integer
Declare Public Function W32_NSPingServer Lib wAPIModule Alias “NSPingServer” _
(Byval ServerName As Lmbcs String, _
loadIndex As Long, _
hList As Long) As Integer
Declare Public Function W32_ListGetText Lib wAPIModule Alias “ListGetText” _
(Byval pList As Long, _
Byval fPrefixDataType As Integer, _
Byval EntryNumber As Integer, _
retTextPtr As Long, _
retTextLength As Integer) As Integer
Declare Public Function W32_ListGetNumEntries Lib wAPIModule Alias “ListGetNumEntries” _
(Byval pList As Long, _
Byval typeRepresent As Integer) As Integer
Declare Public Function W32_OSLockObject Lib wAPIModule Alias “OSLockObject” _
(Byval handle As Long) As Long
Declare Public Sub W32_OSUnlockObject Lib wAPIModule Alias “OSUnlockObject” _
(Byval handle As Long)
Declare Public Sub W32_OSMemFree Lib wAPIModule Alias “OSMemFree” _
(Byval handle As Long)
Declare Public Function W32_OSTranslateToStr Lib wAPIModule Alias “OSTranslate” _
(Byval TranslateMode As Integer, _
Byval pInString As Long, _
Byval InLength As Integer, _
Byval OutString As Unicode String, _
Byval OutLength As Integer) As Integer
Declare Public Sub W32_OSLoadString Lib wAPIModule Alias “OSLoadString” _
(Byval null1 As Long, _
Byval ErrorCode As Integer, _
Byval ErrorString As String, _
Byval ErrorStringLength As Integer)
Type BlockID
hPool As Long
Offset As Integer
End Type
Declare Function W32_NSFItemGetText Lib wAPIModule Alias “NSFItemGetText” _
(Byval hNote As Long, _
itemName As String, _
itemValue As String, _
itemLen As Integer) As Integer
Declare Function W32_NIFFindDesignNote Lib wAPIModule Alias “NIFFindDesignNote” _
(Byval dbHandle As Long, _
Byval ObjName As String, _
Byval NoteClass As Long, _
retNoteID As Long) As Integer
Declare Function W32_NSFItemInfo Lib wAPIModule Alias “NSFItemInfo” _
( Byval hNT As Long, Byval N As String, Byval nN As Integer, iB As BlockID, D As Integer, vB As BlockID, nV As Long) As Integer
Declare Function W32_NSFFormulaDecompile Lib wAPIModule Alias “NSFFormulaDecompile” _
( Byval P As Long, Byval S As Integer, hT As Long, N As Integer) As Integer
Const ODS_BYTE = 3
Public Type TIMEDATE
innards(1) As Long
End Type
Public Type DBREPLICAINFO
ID As TIMEDATE
Flags As Integer
CutoffInterval As Integer
Cutoff As TIMEDATE
End Type
Declare Function W32_NSFDbReplicaInfoGet Lib wAPIModule Alias “NSFDbReplicaInfoGet” _
(Byval hdb As Long, _
replInfoStruct As DBREPLICAINFO) As Integer
Declare Function W32_NSFDbReplicaInfoSet Lib wAPIModule Alias “NSFDbReplicaInfoSet” _
(Byval hdb As Long, _
replInfoStruct As DBREPLICAINFO) As Integer
Declare Function W32_ConvertTIMEDATEToText Lib wAPIModule Alias “ConvertTIMEDATEToText” _
(Byval nullFormat As Long, _
Byval textFormat As Long, _
td As Any, _
Byval Buff As String, _
Byval maxlen As Integer, _
textLength As Integer) As Integer
Declare Function W32_ConvertTextToTIMEDATE Lib wAPIModule Alias “ConvertTextToTIMEDATE” _
(Byval nullFormat As Long, _
Byval textFormat As Long, _
ptrTextBuff As Long, _
Byval maxlen As Integer, _
td As TIMEDATE) As Integer
Declare Function W32_OSMemAlloc Lib wAPIModule Alias “OSMemAlloc”(Byval flags As Integer, Byval length As Integer, handle As Long) As Integer
Declare Sub W32_OSMemoryFree Lib wAPIModule Alias “OSMemoryFree”(Byval h As Long)
Declare Function W32_OSMemoryUnlock Lib wAPIModule Alias “OSMemoryUnlock”(Byval h As Long) As Integer
Declare Function W32_OSMemoryLock Lib wAPIModule Alias “OSMemoryLock”(Byval h As Long) As Long
Declare Function W32_OSMemoryAllocate Lib wAPIModule Alias “OSMemoryAllocate”(Byval t As Long, Byval size As Long, handle As Long) As Integer
Declare Sub W32_ODSWriteMemoryStr Lib wAPIModule Alias “ODSWriteMemory” (pDest As Long, Byval typeODS As Integer, Byval pSource As String, Byval Iterations As Integer)
Declare Sub W32_ODSWriteMemoryByVal Lib wAPIModule Alias “ODSWriteMemory” (pDest As Long, Byval typeODS As Integer, Byval ppSource As Any, Byval Iterations As Integer)
'code
Declare Private Sub PeekString Lib “MSVCRT” Alias “memcpy” _
( Byval D As String, Byval P As Long, Byval N As Long)
Public Const FIELD_WQO$ = “$WEBQueryOpen”
Public Const FIELD_WQS$ = “$WEBQuerySave”
'=-=-=-=-=-=-=-=-=-=-=-=-=-=–=-=-=-=-=-=-=-=-=
Public Class AgentInfo
Private m_s As NotesSession
Private m_dbH As Long
Private m_agtCtx As NotesAgent
Private m_dbCtx As NotesDatabase
Private m_docCtx As NotesDocument
Private m_errors As String
Private m_formName As String
'-------------------------------------------------------
Sub New(sess As NotesSession, agent As NotesAgent, doc As NotesDocument)
Dim stat As Integer
Set m_s = sess
Set m_dbCtx = sess.CurrentDatabase
If (agent Is Nothing) Then
Set m_agtCtx = sess.CurrentAgent
Else
Set m_agtCtx = agent
End If
If (doc Is Nothing) Then
Set m_docCtx = sess.DocumentContext
Else
Set m_docCtx = doc
End If
' it is now possible docCtx is not available. Use the FormName property to set a value if this is the case!
If (Not (m_docCtx Is Nothing)) Then
If (m_docCtx.HasItem("Form")) Then
m_formName = m_docCtx.form(0)
End If
End If
End Sub
Sub Delete()
End Sub
'-------------------------------------------------------
Public Property Get IsWebQueryOpen() As Boolean
Dim capiHandle As Integer
Dim fDoc As NotesDocument
Dim sFormula As String
Set fDoc = Me.FormDocument
If (fDoc Is Nothing) Then
' no form context with this agent
IsWebQueryOpen = False
Exit Property
End If
If (Not (fDoc.HasItem(FIELD_WQO))) Then
IsWebQueryOpen = False
Exit Property
End If
capiHandle = fDoc.Handle ' this is an undocumented property of the NotesDocument class. IBM has promised to not let it go away.
sFormula = DecompileValue(fDoc, capiHandle, FIELD_WQO)
IsWebQueryOpen = parseCompare(sFormula)
End Property
'-------------------------------------------------------
Public Property Get IsWebQuerySave() As Boolean
Dim capiHandle As Integer
Dim fDoc As NotesDocument
Dim sFormula As String
Set fDoc = Me.FormDocument
If (fDoc Is Nothing) Then
' no form context with this agent
IsWebQuerySave = False
Exit Property
End If
If (Not (fDoc.HasItem(FIELD_WQS))) Then
IsWebQuerySave = False
Exit Property
End If
capiHandle = fDoc.Handle ' this is an undocumented property of the NotesDocument class. IBM has promised to not let it go away.
sFormula = DecompileValue(fDoc, capiHandle, FIELD_WQS)
IsWebQuerySave = parseCompare(sFormula)
End Property
'-------------------------------------------------------
Public Property Get IsValid() As Boolean
IsValid = (Len(m_errors) = 0)
End Property
'-------------------------------------------------------
Public Property Get ErrorString() As String
ErrorString = m_errors
End Property
'-------------------------------------------------------
Public Property Get ErrorArray() As Variant
ErrorArray = Fulltrim(Split(m_errors, ";"))
End Property
'-------------------------------------------------------
Public Property Set FormName() As String
m_FormName = FormName
End Property
'-------------------------------------------------------
Public Property Get FormName() As String
FormName = m_formName
End Property
'-------------------------------------------------------
Public Property Set AgentName() As String
Set m_agtCtx =m_s.CurrentDatabase.GetAgent(AgentName)
End Property
'-------------------------------------------------------
Public Property Get AgentName() As String
AgentName = m_agtCtx.Name
End Property
'-------------------------------------------------------
Private Sub logError(lsFunction As String, sErrorMsg As String)
m_errors = m_errors & lsFunction & ": " & sErrorMsg & ";"
End Sub
'-------------------------------------------------------
Private Sub logCAPIError(cAPIFunction As String, errorCode As Integer)
m_errors = m_errors & cAPIFunction & ": " & getCAPIError(errorCode) & ";"
End Sub
'-------------------------------------------------------
Private Function getCAPIError(ErrorNum As Integer) As String
Dim retError As String * 256
Call W32_OSLoadString(0, ErrorNum And &h03ffffff, retError, 256)
getCAPIError = Strleft(retError, Chr(0))
End Function
'-------------------------------------------------------
Private Property Get DecompileValue(Form_Handle As NotesDocument, CAPI_Handle As Integer, sItemName As String) As String
Dim iB As BlockID, vB As BlockID
Dim p As Long, nV As Long, hT As Long
Dim itemName As String
Dim dt As Integer, stat As Integer
Dim sFormula As String
stat = W32_NSFItemInfo(CAPI_Handle, sItemName, Len(sItemName), iB, dt%, vB, nV&)
If (stat <> 0) Then
Call logCAPIError("W32_NSFItemInfo", stat)
DecompileValue = ""
Exit Property
End If
If (Not (vB.hPool = 0)) Then
p& = W32_OSLockObject(vB.hPool) + vB.Offset
stat = W32_NSFFormulaDecompile(p& + 2, 0, hT, CAPI_Handle)
If (stat <> 0) Then
Call logCAPIError("W32_NSFFormulaDecompile", stat)
Call W32_OSUnlockObject(vB.hPool)
DecompileValue = ""
Exit Property
End If
Call W32_OSUnlockObject(vB.hPool)
If (hT = 0) Then
Call logError("AgentInfo::DecompileValue()", "Can't decompile formula: " & Form_Handle.~$Title(0) & " -> " & itemName)
DecompileValue = ""
Exit Property
End If
sFormula$ = String(256, " ")
p& = W32_OSLockObject(hT)
If (p <> 0) Then
Call PeekString(sFormula$, p&, Len(sFormula$))
End If
Call W32_OSUnlockObject(hT)
Call W32_OSMemFree(hT)
DecompileValue = sFormula$
End If
End Property
'-------------------------------------------------------
Private Property Get FormDocument() As NotesDocument
Dim formName As String
Dim noteid As Long
Dim stat As Integer
Dim beFormDoc As NotesDocument
Dim capiHandle As Integer
Dim retPath As String*255
stat = W32_OSPathNetConstruct(0&, m_dbCtx.Server, m_dbCtx.FilePath, retPath)
If (stat <> 0) Then
Call logCAPIError("W32_OSPathNetConstruct", stat)
Exit Property
End If
stat = W32_NSFDbOpen(retPath, m_dbH)
If (stat <> 0) Then
Call logCAPIError("W32_NSFDbOpen", stat)
Exit Property
End If
stat = W32_NIFFindDesignNote(m_dbH, m_formName, &H0004 , noteid)
If (stat <> 0) Then
Call logCAPIError("FormDocument::W32_NIFFindDesignNote() [m_dbH: " & m_dbH & ", m_formName: " & m_formName & "]", stat)
Goto Finally
End If
Set beFormDoc = m_dbCtx.GetDocumentByID(Hex$(noteid))
If (beFormDoc Is Nothing) Then
Call logError("AgentInfo::FormDocument() [noteid: " & Hex$(noteid) & "]", "Unable to find a back-end handle to the design form: " & m_formName)
Goto Finally
End If
Finally:
stat = W32_NSFDbClose(m_dbH)
If (stat <> 0) Then Call logCAPIError("W32_NSFDbClose", stat)
Set FormDocument = beFormDoc
End Property
'-------------------------------------------------------
Private Function parseCompare(sFormula As String) As Boolean
Dim vStuff As Variant
Dim sFormAgent As String
Dim pos As Integer
Dim bFound As Boolean
Dim strAgentFormulaCompare As String
Dim strAgentNameCompare As String
Dim agentName As String
If (Len(sFormula) = 0) Then
parseCompare = False
Exit Function
End If
vStuff = Fulltrim(Split(sFormula, ";"))
sFormAgent = Mid$(Strleftback(vstuff(Ubound(vstuff)), {"}), 2)
If (Left$(sFormAgent, 1) = "(" And Right$(sFormAgent, 1) = ")") Then
strAgentFormulaCompare = Mid$(sFormAgent, 2, Len(sFormAgent)-2)
Else
strAgentFormulaCompare = sFormAgent
End If
If (m_agtCtx Is Nothing) Then
Call logError("AgentInfo::parseCompare()", "There is no agent context. It is possible an agent name was assigned to AgentInfo that does not actually exist in this database")
parseCompare = False
Exit Function
End If
agentName = m_agtCtx.Name
If (Len(agentName) = 0) Then
Call logError("AgentInfo::parseCompare()", "There is no agent name. It is possible an agent name was assigned to AgentInfo that does not actually exist in this database")
parseCompare = False
Exit Function
End If
pos = Instr(agentName, "|")
If (pos > 0) Then
vStuff = Fulltrim(Split(agentName, "|"))
bFound = False
Forall a In vStuff
If (Left$(a, 1) = "(" And Right$(a, 1) = ")") Then
strAgentNameCompare = Mid$(a, 2, Len(a)-2)
Else
strAgentNameCompare = a
End If
bFound = (Strcompare(strAgentFormulaCompare, strAgentNameCompare, 1) = 0)
If (bFound) Then Exit Forall
End Forall
parseCompare = bFound
Else
If (Left$(agentName, 1) = "(" And Right$(agentName, 1) = ")") Then
strAgentNameCompare = Mid$(agentName, 2, Len(agentName)-2)
Else
strAgentNameCompare = agentName
End If
parseCompare = (Strcompare(strAgentFormulaCompare, strAgentNameCompare, 1) = 0)
End If
End Function
End Class