Реализация передачи указателя на объект через очередь сообщений

(MAXONESEGSIZE - 0x40)
Private Const MQ_MAX_MSGSIZE = &HF0
MAXWORD
Private Const NOPRIORITY = &HFFFF
"Message Queue name already in use.")
Private Const ERR_DUPLICATE_MQ = 1024 + 97
"Message Queue is empty.")
Private Const ERR_MQ_EMPTY = 1024 + 100
"Quit is pending on the Message Queue")
Private Const ERR_MQ_QUITTING = 1024 + 102
Размер константы Variant в байтах
Private Const VARIANT_SIZE = 16
Имя очереди сообщений
Private Const mName = "C_Queue"
 
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 Variant, 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 Variant, Byval BufLength As Integer, Byval Options As Long, Byval timeout As Long, retMsgLength As Integer) 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 C_Queue
Хендл на очередь сообщений
Private hMQ As Long
Имя дескриптора очереди
Private misOwner As Integer
Private mAutoClose As Integer
 
Sub New
Dim status As Integer
 
misOwner=True
mAutoClose=True
 
If Len(mName)>0 Then
Если имя непустое, пытаемся создать очередь сообщений с этим именем
status= apiMQCreate(mName,NOPRIORITY,0)
Если очередь сообщений с таким именем уже есть,
то выставляем, что владелец - не эта форма
If status=ERR_DUPLICATE_MQ Then
Msgbox "SCAPI Q allready exist"
misOwner=False
Else
Msgbox "New SCAPI Q"
End If
Открываем очередь сообщений
apiCall "MQOpen", apiMQOpen(mName,0,hMQ)
End If
End Sub
 
 
Sub Delete
If misOwner And mAutoClose And hMQ<>0 Then Call apiMQClose(hMQ,0)
End Sub
 
Public Property Set Message As Variant
apiCall "MQPut:"+mName, apiMQPut(hMQ, NOPRIORITY, Message, VARIANT_SIZE, 0 )
End Property
 
Public Property Get Message As Variant
Dim msg As Variant
Dim ret As Integer
 
apiCall "MQGet:"+mName, apiMQGet(hMQ, msg, MQ_MAX_MSGSIZE, 0, 0, ret)
 
Message = msg
End Property
 
End Class
 
----------------------------------------------------------------------------

Private Sub apiCall(apiCallName As String, Status As Integer)
Dim Err_Mask As Integer
Dim errorStr As String
If Status = 0 Then Exit Sub
Err_Mask = &H3FFF
Status = Status And Err_Mask
 
errorStr =String(255,Clng(0))
Status = apiOSLoadString(0, Status, errorStr, Len(errorStr) - 1)
Error Status, apiCallName + "::"+errorStr
End Sub

Set Message = msg