Last active
November 18, 2022 08:52
-
-
Save wqweto/0002b7e6c4f92e69c8e8339ed2235b4c to your computer and use it in GitHub Desktop.
[VB6/VBA] Simple base64 encoding and decoding by API functions
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'--- mdBase64.bas | |
Option Explicit | |
DefObj A-Z | |
#Const HasPtrSafe = (VBA7 <> 0) Or (TWINBASIC <> 0) | |
#If HasPtrSafe Then | |
Private Declare PtrSafe Function CryptBinaryToString Lib "crypt32" Alias "CryptBinaryToStringW" (ByVal pbBinary As LongPtr, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As LongPtr, pcchString As Long) As Long | |
Private Declare PtrSafe Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As LongPtr, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As LongPtr, pcbBinary As Long, Optional ByVal pdwSkip As Long, Optional ByVal pdwFlags As Long) As Long | |
#Else | |
Private Declare Function CryptBinaryToString Lib "crypt32" Alias "CryptBinaryToStringW" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, pcchString As Long) As Long | |
Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, pcbBinary As Long, Optional ByVal pdwSkip As Long, Optional ByVal pdwFlags As Long) As Long | |
#End If | |
Public Function ToBase64Array(baData() As Byte) As String | |
Dim lSize As Long | |
If UBound(baData) >= 0 Then | |
ToBase64Array = String$(2 * UBound(baData) + 6, 0) | |
lSize = Len(ToBase64Array) + 1 | |
Call CryptBinaryToString(VarPtr(baData(0)), UBound(baData) + 1, 1, StrPtr(ToBase64Array), lSize) | |
ToBase64Array = Left$(ToBase64Array, lSize) | |
End If | |
End Function | |
Public Function FromBase64Array(sText As String) As Byte() | |
Dim lSize As Long | |
Dim baOutput() As Byte | |
lSize = Len(sText) + 1 | |
ReDim baOutput(0 To lSize - 1) As Byte | |
If CryptStringToBinary(StrPtr(sText), Len(sText), 1, VarPtr(baOutput(0)), lSize) <> 0 Then | |
ReDim Preserve baOutput(0 To lSize - 1) As Byte | |
FromBase64Array = baOutput | |
End If | |
End Function |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment