Правильная конкатенация

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

Студворк — интернет-сервис помощи студентам

На другом форуме видел такой вариант конкатенации большого массива и он мне очень понравился, поскольку скорость близкая к join. На сколько я знаю тип String это структура содержащая в себе массив символов и еслиб у нас был доступ к этому массиву и возможность делать что-то вроде redim preserve.. В общем, можно ли как-то улучшить алгоритм, чтоб закасматить окончательно етот join? )

25.02.2012 08:28:33
Если правильно делать конкатенацию в цикле, то Join отдыхает:

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
' Правильная конкатенация в цикле  
Sub FastConcat()  
 Dim x, t!, i&, j&, s$, v$  
 With Range("A1:Z65536")  'For i = 1 To 1703936: arr(i) = 1: Next
   .Value = 1  
   t = Timer  
   s = " "  
   For Each x In .Value  
     v = x & ";"  
     j = i + Len(v)  
     If j > Len(s) Then s = s & Space$(Len(s))  
     Mid$(s, i + 1) = v  
     i = j  
   Next  
   s = Left$(s, j - 1)  
   Debug.Print Timer - t  
 End With  
End Sub  
 
' Вариант с Join  
Sub io()  
 Dim t As Single  
 Dim x, z(), i As Long, line As String  
 With [A1:Z65536]
   .Value = 1  
   t = Timer  
   ReDim z(1 To .Cells.Count)  
   For Each x In .Value  
     i = i + 1  
     z(i) = x  
   Next  
   line = Join(z, ";")  
   Debug.Print Timer - t  
 End With  
End Sub

@Jack Famous · 09.04.2024, 11:25

testuser2, а можно сам пример получения массива кодов из строки?

@testuser2 · 09.04.2024, 11:35 **[ТС]**

Jack Famous, в том примере, при отладке можешь увидеть, как массив iText() заполняется кодами.. под x64 я сказал что переделать.

Добавлено через 4 минуты
"Заполняется" не правильный термин, фактически массив начинает сслаться на буфер строки, который фактически тоже является массивом в общем понимании.

@Jack Famous · 09.04.2024, 11:46

testuser2, не взлетает

Скрин ошибки

Код

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
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Declare PtrSafe Sub API_CopyMemory_aByte Lib "kernel32" Alias "RtlCopyMemory" (lpDest As Byte, ByVal lpSource As String, ByVal cbCopy As Long)
'==================================================================================================
Declare PtrSafe Sub PutMem4 Lib "msvbvm60" (ByRef pAddr As Any, ByVal pVal As Long)
'==================================================================================================
Declare PtrSafe Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (ByRef ppSA() As Any) As Long
'==================================================================================================
Private Const FADF_AUTO& = 1
'==================================================================================================
'==================================================================================================
Private Type SAFEARRAYBOUND
    cCount              As Long
    lBound              As Long
End Type
'==================================================================================================
Public Type SAFEARRAY1D
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    dummyPadding        As Long
    pvData              As LongPtr
    Bounds              As SAFEARRAYBOUND
End Type
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Sub TestAscW()
Dim tSADesc As SAFEARRAY1D
Dim iText() As Integer
Dim s$, i&
 
s = "Hello"
 
With tSADesc
    .cDims = 1
    .cbElements = 2
    .fFeatures = FADF_AUTO
    .pvData = StrPtr(s)
    .Bounds.cCount = Len(s)
End With
 
PutMem4 ByVal ArrPtr(iText), VarPtr(tSADesc)
 
For i = 0 To UBound(iText)
    iText(i) = iText(i) Xor &H20
Next i
 
End Sub
'==================================================================================================

@testuser2 · 09.04.2024, 12:11 **[ТС]**

Сообщение от Jack Famous

PutMem4 ByVal

Про PutMem в vba x64 можешь забыть, во первых это из vb-шной сторонней библиотеки, во-вторых, только под 32bit, используй только CopyMemory

Добавлено через 3 минуты
ArrPtr в VBA тоже ~~лучше~~надо использовать vba-шный

Visual Basic
1
Private Declare PtrSafe Function ArrPtr Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr

@Jack Famous · 09.04.2024, 12:17

testuser2, блин — сложно показать всё целиком? То не так, это не то, это забудь, а вот тут добавь…
Я уже собрал листинг — поправь, пожалуйста, чтобы заработало под VBA на x64 (Win + Office).

@testuser2 · 09.04.2024, 12:46 **[ТС]**

Сообщение от Jack Famous

сложно показать всё целиком

Не люблю копипастить, там надо было только подправить структуру в моем примере

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

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

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
Private Declare PtrSafe Function ArrPtr Lib "VBE7" Alias "VarPtr" (Src() As Any) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type SAFEARRAYBOUND
 cCount As Long
 lBound As Long
End Type
Public Type SAFEARRAY1D
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    #If Win64 Then
      dummyPadding      As Long
    #End If
    pvData              As LongPtr
    Bounds              As SAFEARRAYBOUND
End Type
Private Const FADF_AUTO As Long = 1
Private Sub Form_Load3()
 Dim sString As String
 Dim tSADesc As SAFEARRAY1D
 Dim iText() As Integer
 Dim lIndex As Long
 Dim lnull As LongPtr
sString = "Привет World!"
With tSADesc
 .cDims = 1
 .cbElements = 2
 .fFeatures = FADF_AUTO
 .pvData = StrPtr(sString)
 .Bounds.cCount = Len(sString)
 End With
CopyMemory ByVal ArrPtr(iText), VarPtr(tSADesc), Len(lnull) ' меняем указатель массива iText() на адрес структуры tSADesc
For lIndex = 0 To UBound(iText)
 iText(lIndex) = iText(lIndex) Xor &H20
 Next
Debug.Print sString
CopyMemory ByVal ArrPtr(iText), lnull, Len(lnull) ' освобождаем указатель
End Sub

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

Сообщение от Jack Famous

То не так, это не то, это забудь

Это наоборот хорошо, чем больше ошибок, тем больше в итоге знаешь нюансов )

@Jack Famous · 09.04.2024, 13:11

testuser2, благодарю!

Пока так. До 220 символов преобразование в байтовый массив и цикл по нему с вычислением AscW — быстрее. После уже начинает выигрывать копирование памяти

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
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Declare PtrSafe Sub API_CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'--------------------------------------------------------------------------------------------------
Declare PtrSafe Sub API_CopyMemory_aByte Lib "kernel32" Alias "RtlCopyMemory" (lpDest As Byte, ByVal lpSource As String, ByVal cbCopy As Long)
'==================================================================================================
Declare PtrSafe Function API_ArrPtr Lib "VBE7" Alias "VarPtr" (Src() As Any) As LongPtr
'==================================================================================================
'==================================================================================================
Private Const FADF_AUTO& = 1
'==================================================================================================
'==================================================================================================
Private Type SAFEARRAYBOUND
    cCount              As Long
    lBound              As Long
End Type
'==================================================================================================
Public Type SAFEARRAY1D
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    dummyPadding        As Long
    pvData              As LongPtr
    Bounds              As SAFEARRAYBOUND
End Type
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Sub StrToArr_Byte(s$)
Dim aBt() As Byte
Dim i&, n&
 
    aBt = s
 
    For i = 0 To UBound(aBt) - 1 Step 2
        n = aBt(i) + 256 * aBt(i + 1)
    Next i
End Sub
'==================================================================================================
Private Sub StrToArr_API(s$)
Dim aInt%(), i&, n&, LP As LongPtr
Static st&, tSADesc As SAFEARRAY1D
 
If (st = 0) Then
    With tSADesc
        .cDims = 1
        .cbElements = 2
        .fFeatures = FADF_AUTO
    End With
 
    st = 1
End If
 
tSADesc.pvData = StrPtr(s)
tSADesc.Bounds.cCount = Len(s)
 
API_CopyMemory ByVal API_ArrPtr(aInt), VarPtr(tSADesc), Len(LP)
    For i = 0 To UBound(aInt)
        n = aInt(i)
    Next i
API_CopyMemory ByVal API_ArrPtr(aInt), LP, Len(LP)
End Sub
'==================================================================================================
'==================================================================================================
Private Sub TestAscW()
Dim s$, t!, n&
Const nCyc& = 1000000
 
s = "Hello World!"
's = WorksheetFunction.Rept(s, 100)
 
t = Timer
    For n = 1 To nCyc
        StrToArr_Byte s
    Next n                                              ' ShortStr  | LongStr
Debug.Print Format$(Timer - t, "0.0"), "StrToArr_Byte"  ' 0.5       | 24.5
 
t = Timer
    For n = 1 To nCyc
        StrToArr_API s
    Next n
Debug.Print Format$(Timer - t, "0.0"), "StrToArr_API"   ' 3.3       | 12.4
 
End Sub
'==================================================================================================
Private Sub TestAscW_Best()
Dim s$, t!, n&
Const nCyc& = 1000000
 
s = WorksheetFunction.Rept("a", 220)
 
t = Timer
    For n = 1 To nCyc
        StrToArr_Byte s
    Next n
Debug.Print Format$(Timer - t, "0.00"), "StrToArr_Byte"  ' 4.70
 
t = Timer
    For n = 1 To nCyc
        StrToArr_API s
    Next n
Debug.Print Format$(Timer - t, "0.00"), "StrToArr_API"   ' 4.69
 
End Sub
'==================================================================================================

@HackerVlad · 09.04.2024, 13:16

Молодцы

@testuser2 · 09.04.2024, 14:30 **[ТС]**

Jack Famous, интересный результат, но маппинг может быть быстрей, если один раз замапить массив, допустим задеклареный глобально, а при последующих его использованияз просто менять указатель на данные (в структуре) в .pvData и размер в .Bounds.cCount. Структура также должна быть задекларера глобально.

Добавлено через 7 минут
А вижу, у тебя структура в статике, просто я код без отступов слабо понимаю, но надо еще массив в статик или глобалку поместить, чтобы CopyMemory не дергать каждый раз, тогда вообще будет хорошо.

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

Сообщение от Jack Famous

If (st = 0) Then

Я извиняюсь за очередные придирки, но я желюбитель до всех этих мелочей т.ск.. не нравятся мне эти скобки. Скобки - это же на склько знаю неявное приведение к byval, а если быть точнее копирование. Т.е. скобки всегда возвращают копию того значение/переменной, которая внутри них. Но все же сделал проверку, что бы убедиться в этом.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub testСкобок()
    Dim bl1 As Boolean, bl2 As Boolean
    
    bl1 = True
    bl2 = True
    
    Debug.Print VarPtr(bl1) 'реальные указатели
    Debug.Print VarPtr(bl2)
    
    Debug.Print VarPtr((bl1)) 'указатель возврата скобок
    Debug.Print VarPtr((bl1))
    
    Debug.Print VarPtr((bl2))
    Debug.Print VarPtr((bl2))
End Sub

Результат

56092338
56092336
56092330
56092330
56092330
56092330

По результату видно, что скобки фактически ведут себя как функция. Функция в VB всегда возвращает результат по одному указателю (из моих наблюдений). Но скобки это конечно хитрая функция, для всех значений типа Boolean она будет возвращать в один указатель, для Double - в другой и т.д. Функции, созданные на vb, конечно так не умеют, они умеют возвращать результат только одного типа и в один указатель..

@HackerVlad · 09.04.2024, 14:33

Молодцыtestuser2, умница

@testuser2 · 09.04.2024, 14:39 **[ТС]**

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

умница

Да нет канечна, какой там умница, просто скромный VB-этнузиаст!))

@Jack Famous · 09.04.2024, 14:47

Код

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
Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Declare PtrSafe Sub API_Memory_Zero Lib "kernel32" Alias "RtlZeroMemory" (pDest As Any, ByVal nLen As Long)
'--------------------------------------------------------------------------------------------------
Declare PtrSafe Sub API_Memory_Copy Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'--------------------------------------------------------------------------------------------------
Declare PtrSafe Sub API_Memory_Copy_LongPtr Lib "kernel32" Alias "RtlCopyMemory" (lpDest As LongPtr, lpSource As LongPtr, ByVal cbCopy As Long)
'==================================================================================================
Declare PtrSafe Function API_ArrPtr_Int Lib "VBE7" Alias "VarPtr" (aInt() As Integer) As LongPtr
'==================================================================================================
'==================================================================================================
Private Const FADF_AUTO& = 1
'==================================================================================================
'==================================================================================================
Public pa_API_aInt_Str() As Integer
'==================================================================================================
'==================================================================================================
Private Type SAFEARRAYBOUND
    cCount              As Long
    lBound              As Long
End Type
'==================================================================================================
Public Type SAFEARRAY1D
    cDims               As Integer
    fFeatures           As Integer
    cbElements          As Long
    cLocks              As Long
    dummyPadding        As Long
    pvData              As LongPtr
    Bounds              As SAFEARRAYBOUND
End Type
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Sub StrToArr_Byte(s$)
Dim aBt() As Byte
Dim i&, n&
 
    aBt = s
 
    For i = 0 To UBound(aBt) - 1 Step 2
        n = aBt(i) + 256 * aBt(i + 1)
    Next i
End Sub
'==================================================================================================
Private Sub StrToArr_API(s$)
Dim aInt%(), i&, n&, lLP&, LP As LongPtr, LPa As LongPtr
Static st&, tSADesc As SAFEARRAY1D
 
If (st = 0) Then
    With tSADesc
        .cDims = 1
        .cbElements = 2
        .fFeatures = FADF_AUTO
    End With
 
    st = 1
End If
 
tSADesc.pvData = StrPtr(s)
tSADesc.Bounds.cCount = Len(s)
 
lLP = Len(LP): LPa = API_ArrPtr_Int(aInt)
 
API_Memory_Copy_LongPtr ByVal LPa, VarPtr(tSADesc), lLP
    For i = 0 To UBound(aInt)
        n = aInt(i)
    Next i
API_Memory_Copy_LongPtr ByVal LPa, LP, lLP
'API_Memory_Copy ByVal LPa, LP, lLP
'API_Memory_Zero ByVal LPa, lLP
End Sub
'==================================================================================================

Попробовал обнуление с помощью API_Memory_Zero — получилось медленнее (странно).
Немного ускорил StrToArr_API за счёт однократного вычисления указателя и длины. Также, сделал более специальные версии CopyMemory и ArrPtr.
Вынести Integer-массив в глобаль не вышло.

Я считаю (безосновательно, на уровне чуйки), что весь обвес в виде SAFEARRAY1D не нужен для этой задачи. Наверняка, можно либо совсем без него, либо облегчить.
В общем, нам нужен The_Trick, я считаю

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

Скобки - это же на склько знаю неявное приведение к byval

я их использую, чтобы показать, что в них вычисляется булево. На скорость не влияет (я тестил), указатель на скобки я не получаю (но спасибо за тест).

@testuser2 · 09.04.2024, 15:25 **[ТС]**

Сообщение от Jack Famous

Вынести Integer-массив в глобаль не вышло.

Перед использованием делаешь инициализацию, после реинициализацию (или как ее лучше назвать?).

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private iArr(), SA As SAFEARRAY1D
 
Private Sub initStrMapper(Optional ByVal off As Boolean)
    Dim lp As LongPtr
    If Not off Then
        With SA
            .cDims = 1
            .cbElements = 2
            .fFeatures = FADF_AUTO
        End With
        CopyMemory ByVal ArrPtr(iArr), VarPtr(SA), Len(lp)
    Else
        CopyMemory ByVal ArrPtr(aInt), lp, Len(lp)
    End If
End Sub

@HackerVlad · 09.04.2024, 15:26

testuser2 просто умничка)))

@Jack Famous · 09.04.2024, 15:38

testuser2, ты пробовал?
Потому что я что-то похожее и делал, но не вышло.

@HackerVlad · 09.04.2024, 15:40

Если долго мучиться что-нибудь получится!

@testuser2 · 09.04.2024, 17:21 **[ТС]**

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

Если долго мучиться что-нибудь получится!

Тут и не надо мучиться, все уже исследовано в данной области, т.ск., но если кто-то найдет или предложит что-то новое, буду только рад )

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

Сообщение от Jack Famous

testuser2, ты пробовал?
Потому что я что-то похожее и делал, но не вышло.

Я чего уже только не пробовал, тем пять уже насоздавал по теме указателей, но в сущности, наверное ни особой какой-то сложности в данной теме нету если сравнивать это с каким-нибудь программированием на c++. Но в VB сложновато сориентироваться по началу может быть, отчасти потому, что в vb указатели не поддерживаются в полной мере и приходится прибегать к разным ухищрениям. Спасибо конечно The trick-у, за то что он разъяснил многие вопрсы.
С указателями я думаю вопрос ясный, мне больше интересен, другой вопрос, как быстро получить ссылку на данные в таблице Эксель. Я кстати провел недавно такой эксперимент, в программе ArtMoney нашел указатель на одну из ячеек (по введенному значению), в vba скопировал это значение по указателю в переменную (типа Double). Затем записал по указателю другое значение после чего в ячейке значение изменилось. Вообще на листе было 4 заполненных ячеек, 3 из которых оказались расположены в памяти рядом в одном массиве с ячейкой 8 байт (Double), а вот значения из первой ячейки ("A1") почему-то там не оказалось.

@HackerVlad · 09.04.2024, 17:54

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

в программе ArtMoney нашел указатель на одну из ячеек

Молодец, додумался же, я тоже так хотел помню попробовать

Новые блоги и статьи Все статьи Все блоги /
мат медиц модель 30. презентация проекта anaschu 27.08.2026 хоп хоп хоп хидахоп, а я кладую))	Как у меня протекала болезнь zorxor 27.08.2026 Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .	Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему kumehtar 26.08.2026 ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .	[EasyBuilder Pro] Памятка по разработке для панелей Weintek ФедосеевПавел 26.08.2026 Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .
Модель по догадкам anaschu 25.08.2026 Прошло две недели. Я уже рассказывал, как разговаривал с сотрудниками у сортировки и как понял, что главная ветка — не про приёмку, а про отбор. Но тогда я думал, что понял механику. На этой неделе я. . .	Запись в регистр сведений независимо от заполненности табличной части Maks 25.08.2026 Реализация из решения ниже выполнена на нетиповом документе с несколькими табличными частями, разработанного в КА2. Задача: Обеспечить запись документа в регистр сведений независимо от. . .	Ноутбук Альфария kumehtar 24.08.2026 Встретился тут в сети ноутбук Альфария, примарха Альфа-Легиона. Хотя возможно, это ноутбук Омегона, разумеется. Ну как вам?	Мастера простых решений DevAlt 23.08.2026 В сишарп стэках winforms, да и wpf существует сложная система связывания источниках данных и элементов формы(текстовые поля и метки), опирается все это на технологию событий и мета. . .

@Jack Famous 933 / 366 / 43 Регистрация: 10.05.2021 Сообщений: 1,564 Записей в блоге: 10
	09.04.2024, 11:25
	testuser2, а можно сам пример получения массива кодов из строки? 0

@testuser2 1409 / 868 / 93 Регистрация: 08.02.2017 Сообщений: 3,710 Записей в блоге: 2
	09.04.2024, 11:35 [ТС]
	Jack Famous, в том примере, при отладке можешь увидеть, как массив iText() заполняется кодами.. под x64 я сказал что переделать. Добавлено через 4 минуты "Заполняется" не правильный термин, фактически массив начинает сслаться на буфер строки, который фактически тоже является массивом в общем понимании. 1

@Jack Famous 933 / 366 / 43 Регистрация: 10.05.2021 Сообщений: 1,564 Записей в блоге: 10
	09.04.2024, 12:17
	testuser2, блин — сложно показать всё целиком? То не так, это не то, это забудь, а вот тут добавь… Я уже собрал листинг — поправь, пожалуйста, чтобы заработало под VBA на x64 (Win + Office). 0

@HackerVlad Вернулся 1754 / 650 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.04.2024, 13:16
	Молодцы 0

@HackerVlad Вернулся 1754 / 650 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.04.2024, 14:33
	Молодцыtestuser2, умница 0

@HackerVlad Вернулся 1754 / 650 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.04.2024, 15:26
	testuser2 просто умничка))) 0

@Jack Famous 933 / 366 / 43 Регистрация: 10.05.2021 Сообщений: 1,564 Записей в блоге: 10
	09.04.2024, 15:38
	testuser2, ты пробовал? Потому что я что-то похожее и делал, но не вышло. 0

@HackerVlad Вернулся 1754 / 650 / 45 Регистрация: 10.09.2021 Сообщений: 2,807
	09.04.2024, 15:40
	Если долго мучиться что-нибудь получится! 0