Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

конвертирование в BASE64

22K
18 августа 2007 года
UDmitriy
1 / / 01.11.2006
у меня данный метод 5 метровый файл конвертирует 15 сек кто может быстрее ?


Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, lpString2 As Any) As Long
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)



Option Explicit


Public Function Base64_encoding(ByVal BStrg As String) As String Debug.Print Time
Dim CHS(63) As Byte
Dim StrArr() As Byte
Dim strhex() As Byte

Dim i As Long
Dim endm As Long
If BStrg = "" Then Base64_encoding = "": Exit Function


Dim lss As Long
Dim Ubm As Long
Dim stroct As Long
MemCopy CHS(0), ByVal "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", 64
Dim l As Long
lss = Len(BStrg)
endm = lss - (lss Mod 3)


ReDim StrArr(1 To lss) As Byte
MemCopy StrArr(1), ByVal BStrg, ByVal lss
ReDim strhex(0)

'''''''''''''''''''''''''''''''''''

For i = 1 To endm Step 3

MemCopy ByVal VarPtr(stroct), StrArr(i + 2), 1
MemCopy ByVal VarPtr(stroct) + 1, StrArr(i + 1), 1
MemCopy ByVal VarPtr(stroct) + 2, StrArr(i), 1
Ubm = UBound(strhex)


ReDim Preserve strhex(Ubm + 4)
strhex(Ubm + 1) = CHS((stroct \ 262144))
strhex(Ubm + 2) = CHS((stroct \ 4096) Mod 64)
strhex(Ubm + 3) = CHS((stroct \ 64) Mod 64)
strhex(Ubm + 4) = CHS(stroct Mod 64)

If (i + 2) Mod 57 = 0 Then
ReDim Preserve strhex(Ubm + 6)
MemCopy strhex(Ubm + 5), 13, 1
MemCopy strhex(Ubm + 6), 10, 1

End If
Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''





Select Case lss Mod 3
Case 1
l = StrArr(lss) * 16
Ubm = UBound(strhex)
ReDim Preserve strhex(Ubm + 4)
strhex(Ubm + 1) = CHS((l \ 64) Mod 64)
strhex(Ubm + 2) = CHS(l Mod 64)
strhex(Ubm + 3) = 61
strhex(Ubm + 4) = 61

Case 2

l = CLng(StrArr(lss - 1)) * 1024 + CLng(StrArr(lss)) * 4


Ubm = UBound(strhex)
ReDim Preserve strhex(Ubm + 4)
strhex(Ubm + 1) = CHS((l \ 4096) Mod 64)
strhex(Ubm + 2) = CHS((l \ 64) Mod 64)
strhex(Ubm + 3) = CHS(l Mod 64)
strhex(Ubm + 4) = 61



End Select


Base64_encoding = Space(Ubm + 4)
lstrcpy Base64_encoding, strhex(1)


Debug.Print Time
End Function
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог