Base64

[Fennek]

Hallo,

hier ein Code und Base64 zu decodieren:

Code: Alles auswählen

Function Base64Decode(ByVal base64String)
 
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If
  For groupBegin = 1 To Len(base64String) Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
     
      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
   
   
    nGroup = Hex(nGroup)
   
   
    nGroup = String(6 - Len(nGroup), "0") & nGroup
   
   
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
   
   
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function


Viellleicht ist es hilfreich.

mfg

[Der Steuerfuzzi]

Hallo Fen,

sehr schöne Umsetzung. Ich habe das bisher immer unter Zuhilfenahme von "MSXML2.DOMDocument" gemacht:

Code: Alles auswählen

Function EncodeBase64(ByRef strText As String) As String

    Dim objXML As Object
    Dim objNode As Object
    Dim arrText() As Byte
   
    Set objXML = CreateObject("MSXML2.DOMDocument")
   
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    arrText = StrConv(strText, vbFromUnicode)
    objNode.nodeTypedValue = arrText
    EncodeBase64 = objNode.text
   
    Set objNode = Nothing
    Set objXML = Nothing

End Function
Function DecodeBase64(ByVal strText As String) As String

    Dim objXML As Object
    Dim objNode As Object
   
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.text = strText
    DecodeBase64 = StrConv(objNode.nodeTypedValue, vbUnicode)
   
    Set objNode = Nothing
    Set objXML = Nothing

End Function

[Fennek]

Für die Umwandlung von Base64 in Klartext stellt MS eine API zur Verfügung:

Code: Alles auswählen

Private Declare PtrSafe Function Base64 Lib "crypt32" Alias "CryptStringToBinaryA" ( _
ByVal folderStation As String, _
uriTexture As Long, _
v As Long, _
nLogon As LongPtr, _
k As LongPtr, _
resultOptimize As LongPtr, _
dateServer As LongPtr) As Long