Как устроить такой фокус: строка как байтовый массив

[arthur2]

Возможно ли, и как, если возможно, проделать такой фокус: чтобы некая переменная-строка и некая переменная - массив байтов ссылались на один и тот же участок памяти? Чтобы изменение байтового массива было бы одновременно и изменением строки?

На сколько я понимаю, такое должно получиться, если та и другая переменная будут пользоваться одним и тем же указателем... Я правильно понимаю?

[Хакер]

Да.
Об этом можно прочитать в моей статье [ МануAll ] Об указателях в VB6.
Об этом также следует прочитать статью GSerg'a о работе с SAFEARRAY.

[arthur2]

Хакер
Да, спасибо - именно с этих статей и появилась сама идея. Но, к сожалению, обе они сложны для моего понимания. Тем не менее, сделат такой эксперемент:

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

Public Sub test()
    Dim s As String, t As String, stab As Long
   
   s = "траляля"
   stab = VarPtr(stab)
   
   GetMem4 stab + 8, stab + 4
   s = "шушушу"
   Debug.Print t
   Debug.Print s
End Sub



Получился очень странный, по-моему, результат. Строка s полностью скопировалась в t, но именно скопировалась - её изменение на t не сказывается. Значит, вышло всё же две независимые строки?

Не понятно, как такое получилось: реально ведь я скопировал только 4 байта?

Если t объявить t() as byte, код вообще не срабатывает. Выходит, строки и массивы байт всё же устроены по-разному?

[alibek]

arthur2, если уж тебя не устраивает управляемая память, то без понимания, что такое указатели, тебе лучше не спешить.
Когда ты выполняешь строку s = "шушушу", то ты выделяешь новую область памяти и создаешь новый указатель на эту область. Естественно, изменения в новой области памяти никак не будут сказываться на первоначальной.
Выполни вместо этой строки строку Mid$(s,2,3)="123".

[arthur2]

alibek
Спасибо, понял! Работает... Но не работает после компиляции. В смысле, t остаётся пустой. В экзешнике указатели идут не подряд?

[alibek]

Если ты хочешь сопоставить строку и байтовый массив, то тебе не VarPtr нужен, а StrPtr.

[alibek]

stab = VarPtr(stab)

Что ты хотел этим сказать?

[arthur2]

Переписан на вот так:

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

test 0, "", ""

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

Private Sub test(ByVal stub As Long, t As String, s As String)
   
   s = "траляля"
   stub = VarPtr(stub)
   
   GetMem4 stub + 8, stub + 4
   MsgBox t
'   Mid$(s, 1) = "шушушу"
   s = "шушушу"
   MsgBox t
   MsgBox s
   
End Sub


Стало работать и после компиляции. Причём, можно уже строку менять и без mid (я так понял, это потому, что бейсик уже не может выделять другой адрес, ведь вернуть-то нужно тот же самый аргумент? Позже: нет, не поэтому - на выходе у строк должны быть уже другие адреса, иначе внутри test их бы не удалось вычислить, прибавлением по 4. Значит, адреса у аргументов временные?)

Осталось понять, как проделать тот же фокус, но чтобы сопоставить строку не строке, а массиву байт.

Что ты хотел этим сказать?

Что просто считаю адреса переменых от адреса заглушки, прибавляя по 4.

[arthur2]

В общем, совмесными усилиями вот здесь:
http://forum.sources.ru/index.php?showtopic=241951
насочинялся такой код:

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

Option Explicit

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (ByRef pArr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long)
Public Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long

Public Function stringIsBytes(s As String, b() As Byte) As Long 'функция будет возвращать адрес
                                                                'данных массива до подмены
                                                                '(или ноль, если массив уже привязан к строке)

    Dim pSa As Long
    GetMem4 ArrPtr(b), VarPtr(pSa) 'в pSa получить адрес на SAFEARRAY массива
   
    If pSa = 0 Then 'массив ещё не проредимлен
      ReDim b(0) As Byte
      b(0) = 98 'чтобы проверить перед уничтожением, а вернулись ли данные на место.
      GetMem4 ArrPtr(b), VarPtr(pSa)
     
      Dim pOld As Long
      GetMem4 (pSa + 12), VarPtr(pOld) 'запоминаем данные по этому адресу (потому что мы их сейчас перепишем)
      stringIsBytes = pOld 'функция возвращает адрес старых данных
    End If
   
   
    Dim pStr As Long
    pStr = StrPtr(s) ' адрес данных строки

    GetMem4 VarPtr(pStr), (pSa + 12) 'подмена данных массива данными строки
   
    PutMem4 pSa + 16, LenB(s) 'записать длинну массива в SAFEARRAY.rgsabound.cElements
   
End Function


Public Sub KillBytes(b() As Byte, pOld As Long) 'нельзя просто Erase массив, иначе будет утечка памяти
      Dim pSa As Long
      GetMem4 ArrPtr(b), VarPtr(pSa) 'получаем адрес SAFEARRAY
      If pSa Then
        GetMem4 VarPtr(pOld), (pSa + 12)  ' записываем старые данные на место
        PutMem4 pSa + 16, 1 ' записываем старую длинну (у нас был там всего один меченый байт)
        Debug.Print b(0) 'проверяем, вернулись ли старые данные на место (должно быть 98)
        Erase b
      End If
End Sub


Гляньте, кому не лень - есть косяки?

Специально пометил неприкаянный байт перед подменой, чтобы проверить, вернётся ли он на место перед уничтожением. Вернулся.

[Viper]

А с функциями SAFEARRAY работать было бы не проще? Тем более, что и ДВА кирпича для работы с этой структурой лежат.

[arthur2]

Пока не понятно - не проще (копипаст не в счёт). А то, чего я тут нагородил, мне понятно.

Впрочем, теперь (кстати, именно благодаря этим самостоятельным ковыряниям), стали понятнее и SAFEARRAY-и. Переписал на вот так:

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

Public Sub stringIsBytes(s As String, b() As Byte)

    Dim psa As Long, pAr As Long
    pAr = ArrPtr(b)'адрес массива
    GetMem4 pAr, VarPtr(psa) 'адрес SAFEARRAY массива
   
    If psa = 0 Then 'массив ещё не проредимлен
       SafeArrayAllocDescriptor 1, ByVal pAr 'выделяем новый дескриптор массива и память под него
       GetMem4 pAr, VarPtr(psa) 'получаем дескриптор SAFEARRAY
       PutMem4 psa + 4, 1 'записываем размер элемента массива (массив байтовый, так что 1)
    End If
   
    Dim pStr As Long
    pStr = StrPtr(s) ' адрес данных строки

    GetMem4 VarPtr(pStr), (psa + 12) 'подмена данных массива данными строки
   
    PutMem4 psa + 16, LenB(s) 'записать длинну массива в SAFEARRAY.rgsabound.cElements
   
End Function

Public Sub DestroySAFEARRAY(b() As Byte)
  Dim psa As Long, pAr As Long
  pAr = ArrPtr(b)
  GetMem4 pAr, VarPtr(psa)
  If psa Then
    SafeArrayDestroyDescriptor ByVal psa
    PutMem4 pAr, 0
  End If
End Sub