Давно не писал, был занят. Недавно столкнулся с необходимостью отправить файл на сервер в автоматическом режиме. Сделал формочку, распарсил посмотрел закинул в WinHTTP и бамс ... сервер говорит что я формочку не отправил:) а длина данных вместо 400к всего 182 байта. Вообщем стал разбираться оказывается проблема была в пресловутых нулевых байтах которые были в бинариках отправляемых на сервер. Пришлось обратиться к манулу на тему как закодировать так, чтобы проходил.
Здесь нашел ответ - Base64, взял свой древний алгоритм (прилагать его не буду чтоб не дискридитировать себя, суть была в привидении 3*ASC => 24*BIN => 4*ASC), запустил ... ждал минуты 3 пока файл перекодируется, перекодировался, прошел. В принципе на этом можно было бы и закончить пост, но ждать 3 минуты - мне не понравилось. Начал искать, нашел вариант в сети - там я ждал 18 секунд, это уже было значительно интереснее по сравнению с 3 минутами, но всеже как-то медленно)) Решил разложить всё с нуля.
в форме решил потестировать различные варианты:
базовая идея преобразования заключалась в данном коде:
- Код: Выделить всё
B(1) = Mid$(IncStr,I,1)
B(2) = Mid$(IncStr,I + 1,1)
B(3) = Mid$(IncStr,I + 2,1)
'результирующая последовательность
R(1) = B(1) \ 4
R(2) = (B(1) Mod 4) * 16 + B(2) \ 16
R(3) = (B(2) Mod 16) * 4 + B(3) \ 64
R(4) = B(3) Mod 64
Res = Res & Mid$(Code,R(1),1) & Mid$(Code,R(2),1) & Mid$(Code,R(3),1) & Mid$(Code,R(4),1)
всё конечно получилось, только вот 100000 байт считывало 7 секунд, рисковать и проверять на 1Мб не решился)))
требовалось немного ускорить, в противном случае это грозило минутным ожиданием при отправке фотографии в 1М на сайт (только лишь на перекодировку).
Вообщем решил пойти по пути поэтапной оптимизации на форме для тестирования:
на форме кнопка, вот код:
- Код: Выделить всё
Dim A1 As Single
Dim A2 As Single
Dim A3 As Single
Dim A4 As Single
Dim SMB As String
Const N = 1048576
Dim ARR(63) As Byte
Private Const Code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private Sub Form_Load()
Erase ARR
For I = 0 To 63
ARR(I) = Asc(Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", I + 1, 1))
Next I
End Sub
Function Base64Encode2(ByRef ArrByte() As Byte) As String
Dim ResByte() As Byte
Dim B(3) As Byte
Dim R(4) As Byte
Dim DobSmb As Byte
Dim I As Long
Dim F As Long
Dim T As Long
DobSmb = (3 - (UBound(ArrByte) Mod 3)) Mod 3
ReDim Preserve ArrByte(UBound(ArrByte) + DobSmb)
F = UBound(ArrByte) \ 3
ReDim ResByte(UBound(ArrByte) / 3 * 4)
'IncStr = IncStr & String(DobSmb, 0)
For I = 1 To UBound(ArrByte) Step 3
B(1) = ArrByte(I)
B(2) = ArrByte(I + 1)
B(3) = ArrByte(I + 2)
R(1) = B(1) \ 4
R(2) = (B(1) Mod 4) * 16 + B(2) \ 16
R(3) = (B(2) Mod 16) * 4 + B(3) \ 64
R(4) = B(3) Mod 64
T = ((I - 1) \ 3) * 4
If F = (I + 2) \ 3 Then
ResByte(T + 1) = ARR(R(1))
ResByte(T + 2) = ARR(R(2))
Select Case DobSmb
Case 0:
ResByte(T + 3) = ARR(R(3))
ResByte(T + 4) = ARR(R(4))
Case 1:
ResByte(T + 3) = ARR(R(3))
ResByte(T + 4) = 61
Case 2:
ResByte(T + 3) = 61
ResByte(T + 4) = 61
End Select
Else
ResByte(T + 1) = ARR(R(1))
ResByte(T + 2) = ARR(R(2))
ResByte(T + 3) = ARR(R(3))
ResByte(T + 4) = ARR(R(4))
End If
Next I
Base64Encode2 = ResByte
End Function
Private Sub Command1_Click()
Dim ArrByte() As Byte
A1 = Timer
SMB = String(N, "A")
A2 = Timer
ArrByte = SMB
A3 = Timer
RES = Base64Encode2(ArrByte)
A4 = Timer
Erase ArrByte
Debug.Print "#2:", A2 - A1, A3 - A2, A4 - A3, A4 - A1
End Sub
вот результат тестирования из окна отладки:
- Код: Выделить всё
#2: 0 0 1,09375 1,09375
#2: 0 0,015625 1,09375 1,109375
#2: 0 0 1,09375 1,09375
#2: 0 0 1,09375 1,09375
#2: 0 0 0,84375 0,84375
#2: 0,015625 0 1,09375 1,109375
#2: 0,015625 0 1,09375 1,109375
#2: 0 0,015625 1,09375 1,109375
здесь видно что для прогона 1МБ потребовалось лишь от 0,84 до 1,093, этот результат мне понравился, возник лишь вопрос, а можно ли сделать быстрее? Как мне показалось - Да, можно. Попробовал избавиться от массивов R и B заменив их переменными R1..R4,B1..B3
получилось вот так:
- Код: Выделить всё
Function Base64Encode(ByRef ArrByte() As Byte) As String
Dim ResByte() As Byte
Dim B1 As Byte
Dim B2 As Byte
Dim B3 As Byte
Dim R1 As Byte
Dim R2 As Byte
Dim R3 As Byte
Dim R4 As Byte
Dim DobSmb As Byte
Dim I As Long
Dim F As Long
Dim T As Long
DobSmb = (3 - (UBound(ArrByte) Mod 3)) Mod 3
ReDim Preserve ArrByte(UBound(ArrByte) + DobSmb)
F = UBound(ArrByte) \ 3
ReDim ResByte(UBound(ArrByte) / 3 * 4)
'IncStr = IncStr & String(DobSmb, 0)
For I = 1 To UBound(ArrByte) Step 3
B1 = ArrByte(I)
B2 = ArrByte(I + 1)
B3 = ArrByte(I + 2)
R1 = B1 \ 4
R2 = (B1 Mod 4) * 16 + B2 \ 16
R3 = (B2 Mod 16) * 4 + B3 \ 64
R4 = B3 Mod 64
T = ((I - 1) \ 3) * 4
If F = (I + 2) \ 3 Then
ResByte(T + 1) = ARR(R1)
ResByte(T + 2) = ARR(R2)
Select Case DobSmb
Case 0:
ResByte(T + 3) = ARR(R3)
ResByte(T + 4) = ARR(R4)
Case 1:
ResByte(T + 3) = ARR(R3)
ResByte(T + 4) = 61
Case 2:
ResByte(T + 3) = 61
ResByte(T + 4) = 61
End Select
Else
ResByte(T + 1) = ARR(R1)
ResByte(T + 2) = ARR(R2)
ResByte(T + 3) = ARR(R3)
ResByte(T + 4) = ARR(R4)
End If
Next I
Base64Encode = ResByte
End Function
вот результат из окна отладки:
- Код: Выделить всё
#1: 0 0,015625 0,765625 0,78125
#1: 0 0 0,78125 0,78125
#1: 0 0,015625 0,765625 0,78125
#1: 0 0 0,78125 0,78125
#1: 0 0 0,78125 0,78125
#1: 0,015625 0 0,75 0,765625
#1: 0 0 0,78125 0,78125
#1: 0 0 0,53125 0,53125
Результат вдохновил, но можно ли лучше? )))
Прошу помощи)))
