Тема: Классики, клетка №1: передача инф. между окнами\фреймами в LN, без использования js,notes.ini,docs,profiles

Создан:Dmitry Akulov 11/28/2004 02:33 AM
Модифицирован:Dmitry Akulov 11/28/2004 02:45 AM
Папка:
05. Notes APIs (C/DXL/etc), 06. Разработка Notes-приложений		Тип сообщения:
Идея
Сообщение:

%rem Библиотека MQ, версия 1.1
Мне тут понадобился передать из одного окна (документа и вьюхи) другому, довольно большой и сложноструктурированный объем инфы.
И я вспомнил про очереди сообщений , один из базовых лотусовых серверных механизмов, который работает и в клиенте ( им , например, пользуется многими любимый демон подписки nhldaemn). Я свои гадкие потребности удовлетворил, и вот решил поделиться с коллегами результатами своего ночного опыта. Любопытным, но еще не знающим про группу функций CAPI MQxxx, рекомендую познакомиться с ними здесь:
http://www-12.lotus.com/ldd/doc/tools/c/6.5/api65ug.nsf/0/05faf7d6737bf1d085256368005a7b9d?OpenDocument
Кратко, очереди сообщений - это межтредовый (т.е в пределах одного инстанса клиента или сервера) асинхронный механизм передачи коротких, до 240 байт строковых сообщений.
Перезагрузка клиента или сервера закрывает и убивает все очереди и сообщения. это очень кратко.
В коде встречается еще одна смешная фишка, правда, отлаживаться с ней довольно трудно, это редкоземельный класс NotesTimer. Фишка, собственно в том, как NotesTimer можно использовать для симулирования событий в пользовательских ui классах LScript.

Предлагаемые два класса LScript'а реализуют (инкапсулируют) достаточный, но не полный набор MQxxx апишных функций. Отлаживались они только под win32- R5, но в R6 , думаю, должны работать, т.к. никаких противопоказаний нет.
Первый, базовый класс NotesMessageQueue
Свойства:
QueueName ro String название очереди
isOwner ro Integer флаг, что очередь создана этим объектом
AutoClose rw Integer флаг, очередь закрывает владелец, в деструкторе
Messages ro Integer число сообщений в очереди
Message rw String запись и чтение сообщений из очереди, чтение удаляет сообщение, чтение из пустой очереди вызывает rt ошибку
Конструктор:
set mq=New NotesMessageQueue("QueueName") - создает или открывает уже существующую очередь, выставляет свойство-флаг isOwner

Второй, derived класс NotesUIMessageQueue, отличается от базового, тем, что может работать только на клиенте, т.к создает\использует NotesTimer.
Объект этого класса создавать не имеет смысла, его надо наследовать и переписать его конструктор и метод OnMessageAction.
Конструктор:
set mq=New NotesUIMessageQueue("QueueName",CheckIntervalInSeconds) - второй параметр конструктора это интервал проверки сообщений в секундах.
Свойства:
MessageList ro Variant список (list as string) принятых сообщений
MessageListCount ro Integer число сообщений в списке MessageList
Методы:
OnMessageAction - метод, который надо переписать в наследуемом классе, для каких-либо осознанных действий с сообщениями.
В коде, наверняка есть ошибки, его можно улучшать и улучшать, но для прототипа\идеи он сгодится
%end rem
'ДА (с) 2004. копирайт ест, их двое мальчик и девочка, они всегда хотят есть...
' за бубликацию ссылка обязательна
' использовать данный код можно везде, где вам позволит совесть.
Private Const MQ_MAX_MSGSIZE = &HF0 '(MAXONESEGSIZE - 0x40)
Private Const NOPRIORITY = &HFFFF ' MAXWORD
'Private Const ERR_MQ_POOLFULL = 1024 + 94 '"Insufficient memory - Message Queue pool is full."
'Private Const ERR_MQ_TIMEOUT = 1024 + 95 '"Timeout occurred waiting for message.")
'Private Const ERR_MQSCAN_ABORT = 1024 + 96 'Message Queue scan was aborted.")
Private Const ERR_DUPLICATE_MQ = 1024 + 97 '"Message Queue name already in use.")
'Private Const ERR_NO_SUCH_MQ = 1024 + 98 '"No Message Queue with that name.")
'Private Const ERR_MQ_EXCEEDED_QUOTA = 1024 + 99 '"Message Queue is full.")
Private Const ERR_MQ_EMPTY = 1024 + 100 '"Message Queue is empty.")
'Private Const ERR_MQ_BFR_TOO_SMALL = 1024 + 101 '"Message is larger than the buffer provided.")
Private Const ERR_MQ_QUITTING = 1024 + 102 '"Quit is pending on the Message Queue")


' Routine definitions

Declare Function apiMQCreate Lib "nnotes.dll" Alias "MQCreate" (Byval QueueName As String, Byval Quota As Integer, Byval Options As Long) As Integer
Declare Function apiMQOpen Lib "nnotes.dll" Alias "MQOpen" (Byval QueueName As String, Byval Options As Long, RetQueue As Long) As Integer
Declare Function apiMQClose Lib "nnotes.dll" Alias "MQClose" (Byval Queue As Long, Byval Options As Long) As Integer
Declare Function apiMQPut Lib "nnotes.dll" Alias "MQPut" (Byval Queue As Long, Byval Priority As Integer, Byval Buffer As Lmbcs String, Byval Length As Integer, Byval Options As Long) As Integer
Declare Function apiMQGet Lib "nnotes.dll" Alias "MQGet" (Byval Queue As Long, Byval Buffer As Lmbcs String, Byval BufLength As Integer, Byval Options As Long, Byval timeout As Long, retMsgLength As Integer) As Integer
'Private Declare Function apiMQPutQuitMsg Lib "nnotes.dll" Alias "MQPutQuitMsg" (ByVal Queue As Long)
'Private Declare Function apiMQIsQuitPending Lib "nnotes.dll" Alias "MQIsQuitPending" (ByVal Queue As Long) As Integer
Declare Function apiMQGetCount Lib "nnotes.dll" Alias "MQGetCount" (Byval Queue As Long) As Integer
'
Declare Function apiOSLoadString Lib "nnotes.dll" Alias "OSLoadString" (Byval hModule As Long, Byval StringCode As Integer, Byval retBuffer As Lmbcs String, Byval BufferLength As Integer) As Integer


Public Class NotesMessageQueue
Private hMQ As Long
Private mName As String
Private misOwner As Integer
Private mAutoClose As Integer
Public Property Get QueueName As String
QueueName = mName
End Property
Public Property Get isOwner As Integer
isOwner = misOwner
End Property
Public Property Get AutoClose As Integer
AutoClose = mAutoClose
End Property
Public Property Set AutoClose As Integer
mAutoClose = AutoClose
End Property
Public Property Get Messages As Integer
If hMQ<>0 Then Messages=apiMQGetCount(hMQ)
End Property
Public Property Get Message As String
Dim msg As String
Dim ret As Integer
Dim status As Integer
msg = Space(MQ_MAX_MSGSIZE-1) + Chr(0)
apiCall "MQGet:"+mName, apiMQGet(hMQ, msg, MQ_MAX_MSGSIZE, 0, 0, ret)
Message=Left(msg,ret)
End Property
Public Property Set Message As String
If Message<>"" Then apiCall "MQPut:"+mName, apiMQPut(hMQ, NOPRIORITY, Message, Lenb(Message), 0 )
End Property
Sub New(MQName As String)
Dim status As Integer
misOwner=True
mAutoClose=True
mName=Trim( mqName)
If Len(mName)>0 Then
status= apiMQCreate(mName,NOPRIORITY,0)
If status=ERR_DUPLICATE_MQ Then misOwner=False
apiCall "MQOpen", apiMQOpen(mName,0,hMQ)
Else
Error 1024+110,"MessageQueue name is empty string…"
End If
End Sub
Sub Delete
If misOwner And mAutoClose And hMQ<>0 Then Call apiMQClose(hMQ,0)
End Sub
End Class

Public Class NotesUIMessageQueue As NotesMessageQueue
Private nTimer As NotesTimer
Private mList List As String
Private mListCount As Integer
Public Property Get Message As String
Dim msg As String
msg=NotesMessageQueue..Message
If msg<>"" Then
mList(Cstr(mListCount))=msg
mListCount=mListCount+1
End If
Message=msg
End Property
Public Property Get MessageList As Variant
MessageList=mList
End Property
Public Property Get MessageListCount As Integer
MessageListCount=mListCount
End Property
' Method for overloading
Public Sub OnMessageAction
Print mName+":", Me.Message
End Sub

Sub New(MQName As String, checkInterval As Integer) , NotesMessageQueue(MQName)
Set nTimer = New NotesTimer(checkInterval)
On Event Alarm From nTimer Call nAlarm
End Sub
Private Sub nAlarm(pTimer As NotesTimer)
pTimer.Enabled=False
If NotesMessageQueue..Messages>0 Then Call Me.OnMessageAction
' While NotesMessageQueue..Messages>0
' mList(Cstr(mListCount))=NotesMessageQueue..Message
' mListCount=mListCount+1
' Wend

pTimer.Enabled=True
End Sub
End Class
' функция обработки ошибок CAPI, содрана и переделана у D. Katz
Private Sub apiCall(apiCallName As String, Status As Integer)
'This function takes the 16-bit status value (set by returning from most api function calls), and returns the "english" version of the error.

Dim Err_Mask As Integer
Dim errorStr As String
If Status = 0 Then Exit Sub
'Strip the two highest-order bits from status (remember, status is only 16 bits total). Those two bits show location of the error (local or remote server, etc.)
'They should be stripped so that the reference number of the error can be looked up appropriately.
Err_Mask = &H3FFF
Status = Status And Err_Mask

'We need to pass the C function a string it can overwrite (so that the memory for the string is already allocated when the OSLoadString is called)
errorStr =String(255,Clng(0))
Status = apiOSLoadString(0, Status, errorStr, Len(errorStr) - 1)
Error Status, apiCallName + "::"+errorStr
End Sub


Иерархия документов данной дискуссии:
Классики, клетка №1: передача инф. между окнами\фреймами в LN, без использования js,notes.ini,docs,profiles (Dmitry Akulov) (28.11.2004 2:33:06)
.... Классики от классика: гроссмейстер пошел e2-e4... Спасибо, Дим... тож, что ли, начать работать по ночам? (-) (Nick A Norkin; VIT Server B) (28.11.2004 14:56:17)
........ днем уже программировать некогда ;( (Dmitry Akulov) (28.11.2004 15:34:50)
.... Продолжение (при непосредственном участии автора темы) (Andrew S Golembiovskiy) (30.11.2004 13:44:16)
.... :) (Alexander A Kharin) (03.12.2004 8:53:17)
........ Судя по моим личным наблюдениям, он работает в основной нити клиента... :((( (Cherepanov; lawdb) (06.12.2004 10:19:07)


Разработчикам и администраторам: курсы, книги, сертификация