Хочу «опубликовать» функцию, являющуюся примером обращения со строками как массивами.
За основу взята функция dhTranslate из русского издания "VBA Developer's Handbook" by Ken Getz and Mike Gilbert, Copyright 1997; Sybex, Inc. All rights reserved.
В исходном (почти) виде она лежит в приложенном архиве dhTranslate_old, там же (в ней) описание интерфейса и примеры вызова.
Там же лежит ее «оптимизированный» без использования массивов вариант (dhTranslate). Он почти вдвое быстрее исходного.
Вариант, работающий на массивах, назван dhTranslate_B. Интерфейс изменен в связи с отсутствием режима текстового сравнения строк – только binary.
В p-коде он сравним с оптимизированным VBA вариантом, ожидаю, что проиграет ему на «длинных строках», и наверно на вырожденных сильно коротких – 10-ок символов.
В native должен быть строго лучшим на всех объемах, кроме, может быть упомянутых коротких.
Не могу утверждать, что «публикуется впервые», поскольку идеи широко известны, но прямо в таком варианте не встречал.
Сильно не бейте – охота пуще неволи.
Здесь (в форуме VB) ее «публикую» по причине того, что, хотя и удалось добиться времени исполнения, сопоставимого с временем исполнения «стандартного» VBA написания для режима p-кода - подобные манипуляции гораздо лучше (должны) смотреться в режиме native компиляции, и, желательно с отключенной проверкой границ массивов. Кстати, «окончательных» замеров пока не проводил. Поэтому, может, кто возьмется замерить скорость на VB – буду благодарен. Надеюсь на конструктивную критику.
Если кто из «акцессного» форума сюда заглянет – к ним отдельный вопрос. Акцесс с этой функцией не сильно дружит (хотя и готов исполнить «много раз»), и с регулярностью интересуется – не надо ли «отправить отчет по домашнему адресу»? Может, будут какие идеи по «стабилизации».
Вот код.
-
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.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
Function dhTranslate_B(ByVal strIn As String, ByVal strMapIn As String, _
ByVal strMapOut As String) As String
'принимает список символов в strmapIn, ищет поэлементное соответствие в strMapOut,
'и производит посимвольную замену в strMapIn
'Victosha - 2004
'вариация на тему Ken Gets & Mike Gilbert
' "VBA Developer's Handbook"
' Copyright 1997; Sybex, Inc. All rights reserved.
'попытка изобразить dhTranslate, оптимизированный до работы с массивами
'в отличие от исходного варианта не работает в режиме текстового сравнения - только бинарный режим.
'
If Len(strIn) = 0 & Then
'ранний возврат при пустой входной строке
Exit Function
End If
If Len(strMapIn) Then
'сюда попадаем, если строка поиска не пуста
Dim lastIndex As Long
'Dim strOut As String 'выходная cтрока
Dim intOut() As Integer ' соответствующй выходной строке массив интов
Dim iOutStruct As SAFEARRAY1D 'описатель для выходного массива
Dim saOutPtr As Long 'хранитель адреса выходного массива
Dim intIn() As Integer 'массив интов, соответствующий входной строке
Dim iInStruct As SAFEARRAY1D 'описатель для входного массива
Dim saInPtr As Long 'хранитель адреса входного массива
Dim intMapIn() As Integer 'массив интов, соответствующий строке поиска
Dim iMapInStruct As SAFEARRAY1D 'описатель для строки поиска
Dim saMapInPtr As Long 'хранитель адреса строки поиска
Dim iChar As Integer
Dim tmpL As Long, tPos As Long, totalRet As Long, intI As Long
Dim intMapOut() As Integer 'массив интов, соответствующий строке замены
Dim iMapOutStruct As SAFEARRAY1D 'описатель для строки замены
Dim saMapOutPtr As Long 'хранитель адреса строки замены
Dim bFound As Boolean
' сформируем пустую выходную строку
dhTranslate_B = String$(Len(strIn), Chr( 0 ))
'Дополним строку замены последним символом
If Len(strMapOut) Then '> 0 Then
strMapOut = Left$(strMapOut & String(Len(strMapIn), Right$(strMapOut, 1 )), Len(strMapIn))
End If
'подвяжем массив к выходной строке
'исходный указатель на массив
saOutPtr = VarPtrArray(intOut)
'сформируем описатель массива
With iOutStruct
.cbElements = 2 'длина инта
.cDims = 1 'к-во размерностей
.fFeatures = 146 ' подсмотрено для интового массива
.Bounds( 0 ).lBound = 0 'счет с нуля
.Bounds( 0 ).cElements = Len(dhTranslate_B) 'к-во штук
End With
'копируем данные из одной структуры в другую
LSet iInStruct = iOutStruct
LSet iMapInStruct = iOutStruct
LSet iMapOutStruct = iOutStruct
'указываем в качестве данных - нашу строку
iOutStruct.pvData = StrPtr(dhTranslate_B)
'заставим intStr смотреть на наш описатель
CopyMemory ByVal saOutPtr, VarPtr(iOutStruct), 4 &
'---------------------------
'подвяжем массив к входной строке
'исходный указатель на массив
saInPtr = VarPtrArray(intIn)
'сформируем описатель массива
With iInStruct
.Bounds( 0 ).cElements = Len(strIn) 'к-во штук
'указываем в качестве данных - входную строку
.pvData = StrPtr(strIn)
End With
'заставим intStr смотреть на наш описатель
CopyMemory ByVal saInPtr, VarPtr(iInStruct), 4 &
'-----------------------------------------------------------------------
'подвяжем массив к строке поиска
saMapInPtr = VarPtrArray(intMapIn)
'сформируем описатель массива
With iMapInStruct
.Bounds( 0 ).cElements = Len(strMapIn) 'к-во штук
'указываем в качестве данных - нашу строку
.pvData = StrPtr(strMapIn)
End With
'заставим intStr смотреть на наш описатель
CopyMemory ByVal saMapInPtr, VarPtr(iMapInStruct), 4 &
'------------------------------------------------------------------------
'подвяжем массив к строке замены
saMapOutPtr = VarPtrArray(intMapOut)
'сформируем описатель массива
With iMapOutStruct
.Bounds( 0 ).cElements = Len(strMapOut) 'к-во штук
'указываем в качестве данных - нашу строку
.pvData = StrPtr(strMapOut)
End With
'заставим intStr смотреть на наш описатель
CopyMemory ByVal saMapOutPtr, VarPtr(iMapOutStruct), 4 &
'----------------------------------------
'количество возвращаемых элементов и границы массивов
totalRet = 0 &
lastIndex = Len(strIn) - 1 &
tmpL = UBound(intMapIn)
For intI = 0 & To lastIndex
'входной символ
iChar = intIn(intI)
'ищем его в строке поиска - подменяем InStrB
'intPos = InStrB(1, strMapIn, ChrW(iChar))
bFound = False
For tPos = 0 & To tmpL
If intMapIn(tPos) <> iChar Then
'движемся дальше
Else
bFound = True
Exit For
End If
Next tPos
'символ нашелся , если intPos ноль или больше
If Not bFound Then 'intPos < CInt0 Then
'не нашли - копируем символ в выходной масив
intOut(totalRet) = iChar
totalRet = totalRet + 1 &
Else
'нашли символ в строке поиска, производим замену
'подменяем Mid
' Mid(strOut, totalRet + 1, 1) = Mid(strMapOut, intPos, 1)
intOut(totalRet) = intMapOut(tPos)
totalRet = totalRet + 1 &
End If
Next intI
'подчистим память
With iInStruct
.pvData = 0 &
.cbElements = 0 &
.Bounds( 0 ).cElements = 0 &
End With
'----------------------------
LSet iOutStruct = iInStruct
LSet iMapInStruct = iInStruct
LSet iMapOutStruct = iInStruct
Else 'Len(strMapIn) > 0
dhTranslate_B = strIn
Exit Function
End If
dhTranslate_B = Left$(dhTranslate_B, totalRet)
End Function
-
