Нативный CopyMemory

@testuser2 · Регистрация: 08.02.2017

Натолкнуло на рассуждения, уже ранее упомянутое.. В общем то уже ранее слышал, про замедление работы апишных функций в современных реалиях. Собственно вопрос, возможно ли копирование блока/участка с динамически меняющимся (настраиваемым) значением(?). Собственно копирование то возможно блоков разного размера, есл говорить о больших - замапив на оба блока массивы и выполнив присвоения в цикле с одного массива в другой. Тесты показывают, что блок одинакового размера копируется в 4 раза быстрей с помощью массива long, нежели битового и также в других случаях - чем меньше итераций, тем кратно быстрей. Можно копировать и большие блоки за одну операцию средствами VB. Если создать тип, с фиксированным массивом внутри, то один экземпляр типа (фактически массив) можно присвоить другому экземпляру типа. С динамическими массивами так не получится, блок перезаписывается, также как и у строк. С другой стороны у фиксированого массива свои недостатки, его нельзя замапить изменить его заголовочную структуру и даже поменять указатель на нее

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Public Type tpArr
    arr(1000) As Integer
End Type
 
Sub ffsff
    Dim ta1 As tpArr, ta2 As tpArr
    
    Debug.Print VarPtr(ta1.arr(0))
    ta1 = ta2
    Debug.Print VarPtr(ta1.arr(0))  
End Sub

@HackerVlad · 24.09.2023, 14:53

А через присвоение можно и без LSet же копировать любые блоки любой длинны, CopyMemory вообще не надо тогда. Просто присвоение и всё.

Добавлено через 42 секунды

Сообщение от testuser2

А вот интересно Java нативная?

Нет.

Добавлено через 22 секунды

Сообщение от testuser2

Node.js

Часто встречал.

@The trick · 24.09.2023, 15:05

Сообщение от HackerVlad

А через присвоение можно и без LSet же копировать любые блоки любой длинны, CopyMemory вообще не надо тогда. Просто присвоение и всё.

Покажи как в том примере скопировать без LSet.

@HackerVlad · 24.09.2023, 15:08

Сообщение от The trick

Покажи как в том примере скопировать без LSet.

Надо чтобы типы совпадали. Иначе несовпадение типов. Ну и ладно.

@The trick · 24.09.2023, 15:10

Сообщение от HackerVlad

Надо чтобы типы совпадали. Иначе несовпадение типов. Ну и ладно

Ну в этом и смысл был чтобы разные типы по аналогии CopyMemory копировать.

@HackerVlad · 24.09.2023, 15:13

The trick, спасибо, что сказал про LSet, я тоже не знал.

@testuser2 · 24.09.2023, 16:24 **[ТС]**

Вообще, я думаю, левый Mid во много может заменить CopyMemory, с условием конечно, что копируемые данные должны быть размером, кратным 2 байта, и условием, что блок данных, в кторый производится копировние должен быть размеще на предварительно выделеной памяти со смещение 4 байта под размер строки, чтобы можно было мапить строку на этот блок. + есть еще одна плюшка со строками у них свободное присвоение с байтовыми массивами (в обе стороны) и c Mid-ом это тоже работает. Т.о. строку можно замапить на нужный блок (с 4мя байтами в начале), а байтовый массив можно замапить на все, что угодно и выполнять копирование блока произвольного размера таким способом.

Visual Basic
1
2
3
4
5
    Dim s$, b() As Byte
    
    s = "aaaaaaa"
    b = "zzz"    
    Mid$(s1, 4) = b

@HackerVlad · 24.09.2023, 16:28

testuser2, есть ещё MidB$ не забывай. Там уже можно не париться, что должно быть кратно двум байтам.

Добавлено через 1 минуту

Сообщение от testuser2

есть еще одна плюшка со строками у них свободное присвоение с байтовыми массивами (в обе стороны)

Строка и байтовый массив – одно и то же? только не в VB6! http://www.vbstreets.ru/VB/Articles/66364.aspx

Добавлено через 39 секунд
Я эту статью давно уже прочитал, очень интересная и полезная.

@testuser2 · 24.09.2023, 16:35 **[ТС]**

Сообщение от HackerVlad

есть ещё MidB$

Позволял бы он еще в байтовый массив писать, был бы вообще красавец

@testuser2 · 24.09.2023, 16:42 **[ТС]**

Если задекларить, может наверное еще быстрее. rtcMidBstr это наверное MidB, а с Char который под 2 байта

@HackerVlad · 24.09.2023, 16:47

Сообщение от testuser2

Позволял бы он еще в байтовый массив писать, был бы вообще красавец

А чем не позволяет? Вот пример. Всё позволяет.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub Command1_Click()
    Dim bytes(1) As Byte
    Dim str As String
    
    str = ChrW(&HFEFF) ' Например будут тут служебные символы для записи BOM в UTF16 кодировке
    
    bytes(0) = AscB(MidB$(str, 1, 1))
    bytes(1) = AscB(MidB$(str, 2, 1))
    
    Debug.Print bytes(0), bytes(1)
End Sub

Добавлено через 1 минуту

Сообщение от testuser2

а с Char который под 2 байта

Есть же ещё ChrB не забывай

Добавлено через 1 минуту
Байтовых функций много есть хороших. Единственное чего мне не хватало это InStrRevB. Жалко что такой функции нету.

@testuser2 · 24.09.2023, 16:51 **[ТС]**

Сообщение от HackerVlad

А чем не позволяет?

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

@HackerVlad · 24.09.2023, 16:52

testuser2, да не парься ты из-за этого)

@testuser2 · 24.09.2023, 16:56 **[ТС]**

Надо будет еще проверить задекларированный вариант, может быть там просто указатель можно кидать и не обязательно настроку.

@HackerVlad · 24.09.2023, 17:03

testuser2, лучше бы мне с картинкой помог

Dragokas · 30.09.2023, 22:39

Не по теме:

Сообщение от I can

Я тебе больше скажу - все АПИ функции в винде нативные

Если рассматривать в качестве устоявшегося понятия, то Native API называют функции, экспортируемые ntdll.dll
Это идинственная dll, доступная на раннем этапе загрузки ОС, до загрузки подсистемы Win32, а также драйверам.
Если интересно окунуться, можете ещё посмотреть, что такое Native Application: https://www.youtube.com/watch?v=EKBvLTuI2Mo

@testuser2 · 01.10.2023, 11:20 **[ТС]**

Потестировал немножк разные способы копирования. Не очень люблю с этим особо заморачиваться, составлять таблицы там и т.д. Кому интересно может проверить и раскомментировать нужное. Общие выводы: комманда LSet очень быстрая, скорость аналогичная базовому(нативному)) присвоению. Работа CopyMemory также близка к этой скорости, и что примечательно, использование ли заранее подготовленных указателей или StrPtr в вызове функции не вносят особой разницы. Mid медленный (порядка 10 раз). Кроме LSet еще есть RSet пишущий справа. Не хватает еще MSet-а )

Visual Basic
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
Option Explicit
 
Private Const Size = 3072 '1024 'размер копируемого/зануляемого буфера
Private Type byteArray
    arr(Size - 1) As Byte
End Type
Private Type fixArray
'    arr(Size - 1) As Byte
    arr(Size \ 2 - 1) As Integer
'    arr(Size \ 4 - 1) As Long
'    arr(Size \ 8 - 1) As Currency
End Type
 
Sub testCopySpeed()
    Dim i&, t!, sIn$, sOut$, sEmp$ ', sz&
    Dim pIn&, pOut&, pEmp&
    Dim byteArr As byteArray
    Dim fxArrIn  As fixArray
    Dim fxArrOut As fixArray
    Dim fxArrEmp As fixArray
        
    Randomize         'подготавливаем блок случайных данных
    For i = 0 To Size - 1
        byteArr.arr(i) = Rnd * 255
    Next
    
'    LSet fxArrOut = byteArr
    sOut = byteArr.arr
    sIn = String(Size \ 2, vbNullChar)
    sEmp = sIn
    
    t = Timer
'    pIn = StrPtr(sIn): pOut = StrPtr(sOut): pEmp = StrPtr(sEmp)
    For i = 0 To 10000000
'        fxArrIn = fxArrOut    'копируем блок
'        fxArrIn = fxArrEmp    'зануляем блок
        LSet sIn = sOut
        LSet sIn = sEmp
'        Mid$(sIn, 1) = sOut
'        Mid$(sIn, 1) = sEmp
'        CopyMemory ByVal StrPtr(sIn), ByVal StrPtr(sOut), Size
'        CopyMemory ByVal StrPtr(sIn), ByVal StrPtr(sEmp), Size
'        CopyMemory ByVal pIn, ByVal pOut, Size
'        CopyMemory ByVal pIn, ByVal pEmp, Size
    Next
    t = Timer - t
    Debug.Print t
End Sub

Добавлено через 9 минут
Удивительный такой факт, за время теста при копировании блока 3022 байта (1 кб) за 10000000 итераций фактически копируется и зануляется ~28 гб., если я не ошибаюсь и это происходит за считанные секунды.

@HackerVlad · 01.10.2023, 12:16

Сообщение от testuser2

3022 байта (1 кб)

С каких это пор 3022 байта это один килобайт??? 3022 / 1024 = 2,951171875

@testuser2 · 01.10.2023, 12:31 **[ТС]**

Сообщение от HackerVlad

С каких это пор 3022

Опечатка )

@testuser2 · 02.10.2023, 19:06 **[ТС]**

Задрючнился сегодня с такой темой, турбоускоренным MemCopy4/8/16/**. Не знаю есть ли смысл в сих гениальных изобретениях, но, пусть пока будет.

Кликните здесь для просмотра всего текста

Visual Basic
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Option Explicit
'Module
'///TurboMemCopy///
Public Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Src() As Any) As Long
 
Private Type PtDat
    Prv1 As Long
    Prv2 As Long
End Type
Private Type tpPrev
    Src As PtDat
    Dst As PtDat
End Type
Private Type PtrPtr
    Src() As Long
    Dst() As Long
End Type
Private Type initFlags
    b2 As Boolean
    b4 As Boolean
    b8 As Boolean
    b16 As Boolean
End Type
Private Type tp16Bytes
    c1 As Currency
    c2 As Currency
End Type
Public Enum PtrVarOrder
    PtrToPtr = 0 'копируем с указателя на указатель
    PtrToVar = 1 'с указателя на переменную
    VarToPtr = 2 'с переменной на указатель
End Enum
 
Private b2src%(), b4src&(), b8src@(), b16src() As tp16Bytes
Private b2dst%(), b4dst&(), b8dst@(), b16dst() As tp16Bytes
Private p2 As PtrPtr, p4 As PtrPtr, p8 As PtrPtr, p16 As PtrPtr
Private prev2 As tpPrev, prev4 As tpPrev, prev8 As tpPrev, prev16 As tpPrev
Public init As initFlags
'################################################################################
Public Sub MemCopy4(Src&, Dst&, Optional Mtd As PtrVarOrder = PtrToPtr)
    Select Case Mtd
    Case PtrToPtr
        p4.Src(0) = Src
        p4.Dst(0) = Dst
        b4dst(0) = b4src(0)
    Case PtrToVar
        p4.Src(0) = Src
        Dst = b4src(0)
    Case VarToPtr
        p4.Dst(0) = Dst
        b4dst(0) = Src
    End Select
End Sub
Public Sub MemCopy8(Src&, Dst&) 'только PtrToPtr', Optional Mtd As PtrVarOrder = PtrToPtr)
'    Select Case Mtd
'    Case PtrToPtr
        p8.Src(0) = Src
        p8.Dst(0) = Dst
        b8dst(0) = b8src(0)
'    Case PtrToVar
'        p8.Src(0) = Src
'        Dst = b8src(0)
'    Case VarToPtr
'        p8.Dst(0) = Dst
'        b8dst(0) = Src
'    End Select
End Sub
Public Sub MemCopy16(Src&, Dst&) 'только PtrToPtr
      p16.Src(0) = Src
      p16.Dst(0) = Dst
      b16dst(0) = b16src(0)
End Sub
'##################################################################################
'общая процедура инициализации служебных переменных
Public Sub varInit(Bytes&)
    Select Case Bytes
    Case 2&
'        varInit2
    Case 4&
        varInit4
    Case 6& '(4+2)
        varInit4
'        varInit2
    Case 8&
        varInit8
    Case 10& '8+2
        varInit8
    Case 12& '8+4
        varInit8
        varInit4
    Case 14& '8+4+2
        varInit8
        varInit4
'        varInit2
    Case 16
        varInit16
    Case 18 '16+2
        varInit16
'        varInit2
    Case 20 '16+4
        varInit16
        varInit4
    Case 24 '16+8
        varInit16
        varInit8
    Case 28 '16+8+4
        varInit16
        varInit8
        varInit4
'    Case 30
    End Select
End Sub
'инициализация служебных переменных для копирования 4 байт
Public Sub varInit4()
    ReDim b4src(0): ReDim b4dst(0)
    ReDim p4.Src(0): ReDim p4.Dst(0)
    prev4.Src = PtGet(p4.Src, GetSA(ArrPtr(b4src)))
    prev4.Dst = PtGet(p4.Dst, GetSA(ArrPtr(b4dst)))
    init.b4 = True
End Sub
Public Sub varInit8()
    ReDim b8src(0): ReDim b8dst(0)
    ReDim p8.Src(0): ReDim p8.Dst(0)
    prev8.Src = PtGet(p8.Src, GetSA(ArrPtr(b8src)))
    prev8.Dst = PtGet(p8.Dst, GetSA(ArrPtr(b8dst)))
    init.b8 = True
End Sub
Public Sub varInit16()
    ReDim b16src(0): ReDim b16dst(0)
    ReDim p16.Src(0): ReDim p16.Dst(0)
    prev16.Src = PtGet(p16.Src, GetSA(ArrPtr(b16src)))
    prev16.Dst = PtGet(p16.Dst, GetSA(ArrPtr(b16dst)))
    init.b16 = True
End Sub
'освобождение всех задействованых служебных переменных
Public Sub ReleaseAllPtrs()
    With init
'      If .b2 Then
      If .b4 Then ReleasePtrs4
      If .b8 Then ReleasePtrs8
      If .b16 Then ReleasePtrs16
    End With
End Sub
Public Sub ReleasePtrs4()
    PtRelease p4.Src, prev4.Src
    PtRelease p4.Dst, prev4.Dst
    init.b4 = False
End Sub
Public Sub ReleasePtrs8()
    PtRelease p8.Src, prev8.Src
    PtRelease p8.Dst, prev8.Dst
    init.b8 = False
End Sub
Public Sub ReleasePtrs16()
    PtRelease p16.Src, prev16.Src
    PtRelease p16.Dst, prev16.Dst
    init.b16 = False
End Sub
 
'Функции уважаемого Анатолия (TheTrick)
' Создать указатель. 1-й параметр указатель, 2-й значение указателя
Private Function PtGet(Pointer() As Long, ByVal VarAddr As Long) As PtDat
    Dim i As Long
    i = GetSA(ArrPtr(Pointer)) + &HC
    GetMem4 ByVal i, PtGet.Prv1
    GetMem4 VarAddr + &HC, ByVal i
    PtGet.Prv2 = Pointer(0)
End Function
' Освободить указатель
Private Sub PtRelease(Pointer() As Long, prev As PtDat)
    Pointer(0) = prev.Prv2
    GetMem4 prev.Prv1, ByVal GetSA(ArrPtr(Pointer)) + &HC
End Sub
' Получить адрес SafeArray
Private Function GetSA(ByVal addr As Long) As Long
    GetMem4 ByVal addr, GetSA
End Function

Пример изспользования

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
    Dim s1$, s2$, l1&, l2&
    'инициализируем служебные перменные
    If Not (init.b4 And init.b16) Then varInit 4 + 16
    
    s2 = "smffakloimn"
    l2 = 34324243
    
    MemCopy4 VarPtr(s2), VarPtr(s1)   ', PtrToPtr по умолчанию
    Stop
    MemCopy4 VarPtr(l2), l1, PtrToVar '-->>направление присвоения слева на право>>
    Stop
    Debug.Print StrPtr(s2)
    MemCopy16 StrPtr(">8букаф<"), StrPtr(s2)
    Debug.Print StrPtr(s2)
    Stop
    MemCopy4 0&, VarPtr(s1), VarToPtr 'освобождаем указатель строки s2
    
    ReleaseAllPtrs                    'освобождаем служебные указатели
End Sub

@testuser2 · 03.10.2023, 17:05 **[ТС]**

Добавил две новые процедуры.
1) MemCopy16_ (с нижним подчеркиванием) копирует блоки любого заданного размера в цикле кусками по 16 байт. Размер выравнивается по 16 байтам.
2) MemCopyLs мапит строки на заданные участки памяти и копирует с помощью присвоения с LSet данных строк. Казалось бы просто, но, чтобы замапить строки, нужно прописать, им размер, для чего предусмотрены дополнительные long-манипуляции с этим размером. В итоге всего в процедуре получается аж 10 присвоений, из которых 9 из которых long-long и одно - string-string (c LSet-ом). Но, возможно повоторюсь, учитывая обстоятельства, описанные в сабжевой ссылке, это может иметь смысл. Там автор говорит, о том, что на одной из машин CoptMerory оказалась аж в 600(!) раз медленней. Также там приводится тест, на котором, CopyMemory оказалась медленей порядка 5 раз.

Кликните здесь для просмотра всего текста

Visual Basic
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
Option Explicit
'Module.bas
'///TurboMemCopy by Testuser/// 03/10/2023
Public Declare Function GetMem4 Lib "msvbvm60" (src As Any, Dst As Any) As Long
Public Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (src() As Any) As Long
 
Private Type PtDat
    Prv1 As Long
    Prv2 As Long
End Type
Private Type tpPrev
    src As PtDat
    Dst As PtDat
End Type
Private Type PtrPtr
    src() As Long
    Dst() As Long
End Type
Private Type tp16Bytes
    c1 As Currency
    c2 As Currency
End Type
Public Type initFlags
    b2 As Boolean
    b4 As Boolean
    b8 As Boolean
    b16 As Boolean
    ls As Boolean
End Type
Public Enum PtrVarOrder
    PtrToPtr = 0 'копируем с указателя на указатель
    PtrToVar = 1 'с указателя на переменную
    VarToPtr = 2 'с переменной на указатель
End Enum
Private Const h4& = &H4&
 
Private b2src%(), b4src&(), b8src@(), b16src() As tp16Bytes, lsSrc$
Private b2dst%(), b4dst&(), b8dst@(), b16dst() As tp16Bytes, lsDst$
Private p2 As PtrPtr, p4 As PtrPtr, p8 As PtrPtr, p16 As PtrPtr, pls As PtrPtr
Private prev2 As tpPrev, prev4 As tpPrev, prev8 As tpPrev, prev16 As tpPrev, prevls As PtDat
 
Public init As initFlags
 
'################################################################################
Public Sub MemCopyLs(src&, Dst&, Size&) 'LSet
    Dim ltmp&
    
    p4.src(0) = src
    p4.Dst(0) = Dst
    ltmp = b4src(0)          'сохраняем первые 4 байта во временную переменную
    'формируем строки для копирования
    b4src(0) = Size - h4     'пишем размер строк
    b4dst(0) = b4src(0)
    pls.src(0) = src + h4    'устанавливаем указатели строк lsSrc и lsDst на
    pls.Dst(0) = Dst + h4    'соответствующие указатели со смещение 4&
    
    LSet lsDst = lsSrc       'копируем данные
    
'    pls.src(0) = 0: pls.Dst(0) = 0 'освобождаем строки lsSrc и lsDst от указателей
    b4src(0) = ltmp          'восстанавливаем первые 4 байта обоих блоков
    b4dst(0) = ltmp
End Sub
Public Sub MemCopy4(src&, Dst&, Optional Mtd As PtrVarOrder = PtrToPtr)
    Select Case Mtd
    Case PtrToPtr
        p4.src(0) = src
        p4.Dst(0) = Dst
        b4dst(0) = b4src(0)
    Case PtrToVar
        p4.src(0) = src
        Dst = b4src(0)
    Case VarToPtr
        p4.Dst(0) = Dst
        b4dst(0) = src
    End Select
End Sub
Public Sub MemCopy8(src&, Dst&) 'только PtrToPtr', Optional Mtd As PtrVarOrder = PtrToPtr)
'    Select Case Mtd
'    Case PtrToPtr
        p8.src(0) = src
        p8.Dst(0) = Dst
        b8dst(0) = b8src(0)
'    Case PtrToVar
'        p8.Src(0) = Src
'        Dst = b8src(0)
'    Case VarToPtr
'        p8.Dst(0) = Dst
'        b8dst(0) = Src
'    End Select
End Sub
Public Sub MemCopy16(src&, Dst&) 'только PtrToPtr
      p16.src(0) = src
      p16.Dst(0) = Dst
      b16dst(0) = b16src(0)
End Sub
Public Sub MemCopy16_(src&, Dst&, Size&) 'только PtrToPtr
      Const H10& = &H10&
      Dim Cnt&, i&
      With p16
        .src(0) = src
        .Dst(0) = Dst
        Cnt = Size \ H10
        b16dst(0) = b16src(0)
        For i = 1 To Cnt - 1
            .src(0) = .src(0) + H10
            .Dst(0) = .Dst(0) + H10
            b16dst(0) = b16src(0)
        Next
      End With
End Sub
'##################################################################################
'общая процедура инициализации служебных переменных
Public Sub varInit(Bytes&)
    Select Case Bytes
    Case 2&
'        varInit2
    Case 4&
        varInit4
    Case 6& '(4+2)
        varInit4
'        varInit2
    Case 8&
        varInit8
    Case 10& '8+2
        varInit8
    Case 12& '8+4
        varInit8
        varInit4
    Case 14& '8+4+2
        varInit8
        varInit4
'        varInit2
    Case 16
        varInit16
    Case 18 '16+2
        varInit16
'        varInit2
    Case 20 '16+4
        varInit16
        varInit4
    Case 24 '16+8
        varInit16
        varInit8
    Case 28 '16+8+4
        varInit16
        varInit8
        varInit4
'    Case 30
    End Select
End Sub
'инициализация служебных переменных для копирования 4 байт и т.д.
Public Sub varInit4()
    ReDim b4src(0): ReDim b4dst(0)
    ReDim p4.src(0): ReDim p4.Dst(0)
    prev4.src = PtGet(p4.src, GetSA(ArrPtr(b4src)))
    prev4.Dst = PtGet(p4.Dst, GetSA(ArrPtr(b4dst)))
    init.b4 = True
End Sub
Public Sub varInit8()
    ReDim b8src(0): ReDim b8dst(0)
    ReDim p8.src(0): ReDim p8.Dst(0)
    prev8.src = PtGet(p8.src, GetSA(ArrPtr(b8src)))
    prev8.Dst = PtGet(p8.Dst, GetSA(ArrPtr(b8dst)))
    init.b8 = True
End Sub
Public Sub varInit16()
    ReDim b16src(0): ReDim b16dst(0)
    ReDim p16.src(0): ReDim p16.Dst(0)
    prev16.src = PtGet(p16.src, GetSA(ArrPtr(b16src)))
    prev16.Dst = PtGet(p16.Dst, GetSA(ArrPtr(b16dst)))
    init.b16 = True
End Sub
Public Sub varInitLs()
    Dim ptr&
    ReDim pls.src(0): ReDim pls.Dst(0)
    ptr = GetSA(ArrPtr(pls.src)) + 12&
    CopyMemory prevls.Prv1, ByVal ptr, 4
    CopyMemory ByVal ptr, VarPtr(lsSrc), 4
    ptr = GetSA(ArrPtr(pls.Dst)) + 12
    CopyMemory prevls.Prv2, ByVal ptr, 4
    CopyMemory ByVal ptr, VarPtr(lsDst), 4
    init.ls = True
End Sub
 
'освобождение всех задействованых служебных переменных
Public Sub ReleaseAllPtrs()
    With init
'      If .b2 Then
      If .b4 Then ReleasePtrs4
      If .b8 Then ReleasePtrs8
      If .b16 Then ReleasePtrs16
      If .ls Then ReleasePtrsLs
    End With
End Sub
Public Sub ReleasePtrs4()
    PtRelease p4.src, prev4.src
    PtRelease p4.Dst, prev4.Dst
    init.b4 = False
End Sub
Public Sub ReleasePtrs8()
    PtRelease p8.src, prev8.src
    PtRelease p8.Dst, prev8.Dst
    init.b8 = False
End Sub
Public Sub ReleasePtrs16()
    PtRelease p16.src, prev16.src
    PtRelease p16.Dst, prev16.Dst
    init.b16 = False
End Sub
Public Sub ReleasePtrsLs()
    Dim ptr&
    pls.src(0) = 0: pls.Dst(0) = 0        'освобождаем строки lsSrc и lsDst если в них есть указатели
    ptr = GetSA(ArrPtr(pls.src)) + 12
    CopyMemory ByVal ptr, prevls.Prv1, 4
    ptr = GetSA(ArrPtr(pls.Dst)) + 12
    CopyMemory ByVal ptr, prevls.Prv2, 4
    init.ls = False
End Sub
 
'Функции уважаемого Анатолия (TheTrick)
' Создать указатель. 1-й параметр указатель, 2-й значение указателя
Private Function PtGet(Pointer() As Long, ByVal VarAddr As Long) As PtDat
    Dim i As Long
    i = GetSA(ArrPtr(Pointer)) + &HC
    GetMem4 ByVal i, PtGet.Prv1
    GetMem4 VarAddr + &HC, ByVal i
    PtGet.Prv2 = Pointer(0)
End Function
' Освободить указатель
Private Sub PtRelease(Pointer() As Long, prev As PtDat)
    Pointer(0) = prev.Prv2
    GetMem4 prev.Prv1, ByVal GetSA(ArrPtr(Pointer)) + &HC
End Sub
' Получить адрес SafeArray
Private Function GetSA(ByVal addr As Long) As Long
    GetMem4 ByVal addr, GetSA
End Function

Пример использования:

Visual Basic
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
Sub testMemCopyLs()
    Dim s1, s2, dest(10), sorc()
    varInit4
    varInitLs
    
    s1 = "Hello World"
    s2 = "edro"
    sorc = Array(1, 2, 3, 4)
    
    MemCopyLs StrPtr(s2), StrPtr(s1) + 14, LenB(s2)
    Stop 'см отладчик (Locals)
    MemCopyLs VarPtr(sorc(0)), VarPtr(dest(3)), 16 * (UBound(sorc) + 1)
    Stop 'см отладчик
'    ReleasePtrs4
'    ReleasePtrsLs
    ReleaseAllPtrs
End Sub
Sub testMemCopy16_()
    Dim s1, s2
    varInit 16&
    s1 = ">8букаф<111222222222255555qqqqqqqqqqqqqqq"
    s2 = "        77778888888999999999999999999111111111111111"
    Stop
    MemCopy16_ StrPtr(s1), StrPtr(s2), LenB(s1)
    Stop
    ReleasePtrs16
End Sub

Новые блоги и статьи Все статьи Все блоги /
[golang] Конкурентный fetcher с ограничением максимального количества одновременных HTTP запросов. alhaos 10.06.2026 Задача Реализовать конкурентный fetcher с ограничением максимального количества одновременных HTTP запросов. Сигнатура func Fetch(urls string, maxConcurrent int) Result Пример urls :=. . .	[golang] Состояние гонки (race condition) alhaos 10.06.2026 Состояние гонки (race condition) Состояние гонки (Race Condition) — это ошибка, возникающая при одновременном доступе нескольких горутин к одним и тем же данным без должной синхронизации. При этом. . .	Взрослые отношения, и почему они не получаются kumehtar 09.06.2026 Когда в детстве ребёнок не получает от родителей чего-то важного, он лишается не просто приятных переживаний, а основы для формирования определённых внутренних качеств и навыков. Если ребёнок не. . .	[golang] Worker Pool alhaos 09.06.2026 Worker Pool Worker Pool — паттерн конкурентной обработки задач в Go. Суть: фиксированное количество горутин-воркеров читают задачи из общего канала и пишут результаты в общий канал результатов. . . .
[golang] Pipeline alhaos 08.06.2026 Pipeline Pipeline — паттерн конкурентной обработки данных в Go. Суть: данные проходят через цепочку независимых стадий, каждая из которых работает в своей горутине и общается с соседями через. . .	Свет внутри себя kumehtar 07.06.2026 Пусть это будет здесь lIs4oanZS9Y	Программа для com-порта Uhbif79 05.06.2026 Всем привет, давно хотел изучить Qt, начинал, бросал, потом снова начинал. И сейчас вот смог написать свою первую программу. До этого имел опыт программирования микроконтроллеров, писал прошивки на. . .	Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	24.09.2023, 15:13
	The trick, спасибо, что сказал про LSet, я тоже не знал. 0

@testuser2 1401 / 860 / 92 Регистрация: 08.02.2017 Сообщений: 3,661 Записей в блоге: 2
	24.09.2023, 16:42 [ТС]
	Если задекларить, может наверное еще быстрее. rtcMidBstr это наверное MidB, а с Char который под 2 байта Миниатюры 0

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	24.09.2023, 16:52
	testuser2, да не парься ты из-за этого) 0

@testuser2 1401 / 860 / 92 Регистрация: 08.02.2017 Сообщений: 3,661 Записей в блоге: 2
	24.09.2023, 16:56 [ТС]
	Надо будет еще проверить задекларированный вариант, может быть там просто указатель можно кидать и не обязательно настроку. 0

@HackerVlad Вернулся 1748 / 644 / 45 Регистрация: 10.09.2021 Сообщений: 2,786
	24.09.2023, 17:03
	testuser2, лучше бы мне с картинкой помог 0