У меня есть объект(Variant). Мне надо , с помошью очереди сообщений , передать указатель на него из одного окна в другое. Я написал библиотеку с следующими обертками и классом:
Обработчик ошибок:
Set вроде бы проходит, Variat в очередь пихается, а вот когда пытаюсь сделать Get система вылетает. На простых текстовых сообщениях эта штука работает нормально. Подскажите, что не так?
Код:
'(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 SubSet вроде бы проходит, Variat в очередь пихается, а вот когда пытаюсь сделать Get система вылетает. На простых текстовых сообщениях эта штука работает нормально. Подскажите, что не так?