конвертирование в BASE64
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