Дмитрий77Кажется понял еще задницу.
Ф-ция
1.
2.
Public Declare Function OpalSendMessageRegistration Lib "opal.dll" Alias "OpalSendMessage" _
(ByVal opal As Long, ByRef Message As OpalMessageRegistration) As Long
на вход принимает ByRef Message As OpalMessageRegistration
где параметры вложенных структур должны быть
As String
А на выходе
As Long -это указатель на такой же As OpalMessageRegistration со вложенным OpalParamRegistration,
но предварительные игры с CopyMemory наталкивают на мысль, что возвращаемая структура уже будет с указателями, а не с as String, т.е.
Это что, получается теперь
...
2) И на выходе делать сначала CopyMemory чтобы
получить структуру в том числе с указателями по
указателю на структуру что возвращает ф-ция
3) Потом CopyMemory в String
для каждого параметра который суть указатель
скукотищаДмитрий77,
1.
2.
3.
Public Type OpalParamRegistration
m_protocol As Long
m_identifier As Long
1.
NewMes.m_param.m_protocol = StrPtr("sip" & vbNullChar & vbNullChar)
То что вы предлагаете передает на вход "s" вместо "sip".
Почему я ХЗ не знаю.
Но то что я решил делать вчера и что вроде как работает, т.е.
"As String"
1) Глючит если структура содержит структуру второго/третьего подуровня, в кот. тоже есть as String.
2) Не имеет обратной совместимости с возвращаемыми структурами с указателями.
Думаю не стоит VB доверять конвертацию String-ов в указатели на них при передаче в API.
Я короче сделал все таки с указателями "на пальцах" (хотя пришлось думать) и мой вариант работает:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
Public Type StringToChar
ByteStr() As Byte
End Type
Function StringToMas(str As String) As StringToChar
Dim data As StringToChar
Dim temp As String
Dim LN As Long
Dim i As Integer
Dim ptr As Long
temp = str
LN = Len(temp)
ReDim data.ByteStr(0 To LN)
If LN > 0 Then
For i = 0 To LN - 1
data.ByteStr(i) = Asc(Mid(temp, i + 1, 1))
Next i
End If
data.ByteStr(LN) = 0
StringToMas = data
End Function
Public Type OpalParamRegistration
m_protocol As Long 'IntPtr
m_identifier As Long 'IntPtr
...
Private Sub CommandRegister_Click()
Dim NewMes As OpalMessageRegistration
Dim BackMesPtr As Long
Dim MesType As OpalMessageType
NewMes.m_type = OpalCmdRegistration
NewMes.m_param.m_protocol = VarPtr(StringToMas("sip").ByteStr(0))
NewMes.m_param.m_identifier = VarPtr(StringToMas("100@192.168.1.3").ByteStr(0))
NewMes.m_param.m_password = VarPtr(StringToMas("100").ByteStr(0))
NewMes.m_param.m_timeToLive = 180
BackMesPtr = OpalSendMessage_Registration(L, NewMes)
MsgBox BackMesPtr
If BackMesPtr = 0 Then Exit Sub
CopyMemory MesType, ByVal BackMesPtr, 4
If MesType = OpalIndCommandError Then
Dim p As Long
CopyMemory p, ByVal BackMesPtr + 4, 4
MsgBox "Error: " & PtrToString(p)
ElseIf MesType = OpalCmdRegistration Then
Dim s_Registration As OpalParamRegistration
CopyMemory ByVal VarPtr(s_Registration), ByVal BackMesPtr + 4, LenB(s_Registration)
MsgBox "m_protocol: " & PtrToString(s_Registration.m_protocol) & vbCrLf & _
"m_identifier: " & PtrToString(s_Registration.m_identifier) & vbCrLf & _
"m_hostName: " & PtrToString(s_Registration.m_hostName) & vbCrLf & _
"m_authUserName: " & PtrToString(s_Registration.m_authUserName) & vbCrLf & _
"m_password: " & PtrToString(s_Registration.m_password) & vbCrLf & _
"m_adminEntity: " & PtrToString(s_Registration.m_adminEntity) & vbCrLf & _
"m_timeToLive: " & s_Registration.m_timeToLive & vbCrLf & _
"m_restoreTime: " & s_Registration.m_restoreTime & vbCrLf & _
"m_eventPackage: " & PtrToString(s_Registration.m_eventPackage)
End If
End Sub
Не растранжирить бы память всеми этими махинациями. Переживаю слегка.
VB.NET (то же самое)
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
Private Sub ButtonRegister_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonRegister.Click
Dim NewMes As OpalDotNET.Opal_API.OpalMessage
Dim ptrMessage As IntPtr
Dim BackMes As OpalDotNET.Opal_API.OpalMessage
NewMes.m_type = OpalDotNET.Opal_API.OpalMessageType.OpalCmdRegistration
NewMes.m_param.m_registrationInfo.m_protocol = Runtime.InteropServices.Marshal.StringToCoTaskMemAnsi("sip")
NewMes.m_param.m_registrationInfo.m_identifier = Runtime.InteropServices.Marshal.StringToCoTaskMemAnsi("100@192.168.1.3")
NewMes.m_param.m_registrationInfo.m_password = Runtime.InteropServices.Marshal.StringToCoTaskMemAnsi("100")
NewMes.m_param.m_registrationInfo.m_timeToLive = 180
ptrMessage = OpalDotNET.Opal_API.OpalSendMessage(L, NewMes)
MsgBox(ptrMessage)
If (ptrMessage = IntPtr.Zero) Then
MsgBox("Invalid message")
Else
BackMes = CType(Runtime.InteropServices.Marshal.PtrToStructure(ptrMessage, GetType(OpalDotNET.Opal_API.OpalMessage)), OpalDotNET.Opal_API.OpalMessage)
If (BackMes.m_type = OpalDotNET.Opal_API.OpalMessageType.OpalIndCommandError) Then
MsgBox("Error: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_commandError))
ElseIf (BackMes.m_type = OpalDotNET.Opal_API.OpalMessageType.OpalCmdRegistration) Then
MsgBox("m_protocol: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_protocol) & vbCrLf & _
"m_identifier: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_identifier) & vbCrLf & _
"m_hostName: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_hostName) & vbCrLf & _
"m_authUserName: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_authUserName) & vbCrLf & _
"m_password: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_password) & vbCrLf & _
"m_adminEntity: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_adminEntity) & vbCrLf & _
"m_timeToLive: " & BackMes.m_param.m_registrationInfo.m_timeToLive.ToString & vbCrLf & _
"m_restoreTime: " & BackMes.m_param.m_registrationInfo.m_restoreTime.ToString & vbCrLf & _
"m_eventPackage: " & Runtime.InteropServices.Marshal.PtrToStringAnsi(BackMes.m_param.m_registrationInfo.m_eventPackage))
End If
End If
End Sub
