Base64

Alle anderen Themen ...

Moderator: ModerationP

Base64

Beitragvon Fennek » 29. Jun 2020, 11:52

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
Benutzeravatar
Fennek
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 709
Registriert: 12. Feb 2016, 18:56

Re: Base64

Beitragvon Der Steuerfuzzi » 29. Jun 2020, 13:13

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
Gruß
Michael
Benutzeravatar
Der Steuerfuzzi
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3778
Registriert: 25. Mär 2013, 13:28


Zurück zu Offtopic (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste