PutMemVar PutMemStr PutMemObj GetMemVar GetMemStr GetMemObj

[nouyana]

Возвращаюсь к теме об указателях. В Популярных вопросах эта тема, вроде как, освещена уже *дцать лет тому назад, однако у меня пользоваться функциями PutMemVar, PutMemStr, PutMemObj, GetMemVar, GetMemStr и GetMemObj не получается. Собственно, листинг с комментариями:

Код: Выделить всё

Declare Function PutMemVar Lib "msvbvm60" _
   (ByVal pDst As Long, ByRef NewVar As Variant) As Long
Declare Function PutMemStr Lib "msvbvm60" _
   (ByVal pDst As Long, ByRef NewStr As String) As Long
Declare Function PutMemObj Lib "msvbvm60" _
   (ByVal pDst As Long, ByRef NewObj As Object) As Long
Declare Function GetMemVar Lib "msvbvm60" _
   (ByVal pSrc As Long, ByRef MyVar As Variant) As Long
Declare Function GetMemStr Lib "msvbvm60" _
   (ByVal pSrc As Long, ByRef MyStr As String) As Long
Declare Function GetMemObj Lib "msvbvm60" _
   (ByVal pSrc As Long, ByRef MyObj As Object) As Long

Sub Main()
   Dim var     As Variant
   Dim new_var As Variant
   Dim str     As String
   Dim new_str As String
   Dim obj     As Object
   Dim new_obj As Object
   
   var = 1
   new_var = 2
   PutMemVar VarPtr(var), new_var
   Debug.Print var           'Работает. Вернул 2
   
   Set obj = New Collection
   Set new_obj = New StdPicture
   PutMemObj ObjPtr(obj), new_obj
   Debug.Print TypeName(obj) 'Не работает. Вернул "Collection"
                             'вместо "StdPicture"
   Set obj = Nothing
   Set new_obj = Nothing
   
'   str = "A"
'   new_str = "B"
'                             'Дальше Run-time error '0'
'   PutMemStr StrPtr(str), new_str
'   Debug.Print str           'Хочу получить "B"
   
   var = 1
   new_var = 2
   GetMemVar VarPtr(new_var), var
   Debug.Print var           'Работает. Вернул 2
   
'   Set obj = New Collection
'   Set new_obj = New StdPicture
'                             'Дальше Run-time error '0'
'   GetMemObj ObjPtr(new_obj), obj
'   Debug.Print TypeName(obj) 'Хочу получить "StdPicture"
'   Set obj = Nothing
'   Set new_obj = Nothing
   
'   str = "A"
'   new_str = "B"
'                             'Дальше Run-time error '0'
'   GetMemStr StrPtr(new_str), str
'   Debug.Print str           'Хочу получить "B"
End Sub

Как заставить эти функции работать?

PS
Если кому-то известно как работать с SetMemObj, SetMemVar, SetMemEvent, GetMemEvent, PutMemEvent, GetMemNewObj, PutMemNewObj, SetMemNewObj, о которых упоминал Viper, пишите сюда же.

[Хакер]

Тут требуется целая статья, я думаю.

[nouyana]

Тут требуется целая статья, я думаю.

В интернете на эту тему не нашёл ни слова, поэтому такая статья, если она будет, будет первой. Если же тебе время не позволяет писать статью, то можешь просто подправить код из первого поста так чтобы он работал - это тоже будет полезно многим.

[nouyana]

С функцией GetMemStr разобрался. Указатель на строку надо было получать не при помощи StrPtr, а при помощи VarPtr:

Код: Выделить всё

Declare Function GetMemStr Lib "msvbvm50" _
   (ByVal pSrc As Long, ByRef MyStr As String) As Long
Sub Main()
   Dim str     As String
   Dim new_str As String
   str = "A"
   new_str = "B"
   GetMemStr VarPtr(new_str), str
   Debug.Print str           'Получаем "B"
End Sub

[nouyana]

С PutMemStr тоже разобрался. Помимо того, что указатель, как и в случае с GetMemStr, должен быть получен при помощи VarPtr, необходимо помнить, что строки, переданные во внешние библиотеки всегда преобразуются из Unicode в ANSI:

Код: Выделить всё

Declare Function PutMemStr Lib "msvbvm60" _
   (ByVal pDst As Long, ByVal NewStr As String) As Long
Sub Main()
   Dim str     As String
   Dim new_str As String
   str = "A"
   new_str = "B"
   'В следующей строке new_str будет передана ByVal
   'во внешнюю библиотеку и по дороге преобразована
   'из Unicode в ANSI. После этого, преобразованная
   'ANSI-строка будет присвоена переменной str по
   'указателю, полученному с помощью VarPtr:
   PutMemStr VarPtr(str), new_str
   'Перед дальнейшим использованием строку снова надо
   'сделать юникодной:
   str = StrConv(str, vbUnicode)
   Debug.Print str 'Получаем "B"
End Sub

[nouyana]

С GetMemObj была та же проблема, что и с GetMemStr - необходимо использовать VarPtr вместо ObjPtr:

Код: Выделить всё

Declare Function GetMemObj Lib "msvbvm60" _
   (ByVal pSrc As Long, ByRef MyObj As Object) As Long
Sub Main()
   Dim obj     As Object
   Dim new_obj As Object
   Set obj = New Collection
   Set new_obj = New StdPicture
   GetMemObj VarPtr(new_obj), obj
   Debug.Print TypeName(obj) 'Получаем "Picture"
   Set obj = Nothing
   Set new_obj = Nothing
End Sub

[nouyana]

Итого: пока не работает только PutMemObj. Плюс нужно разобраться с тем, что такое SetMemObj, SetMemVar, SetMemEvent, GetMemEvent, PutMemEvent, GetMemNewObj, PutMemNewObj, SetMemNewObj