Chaine vers Base 64 et vice versa
Contenu du snippet
Private Const EOL_SIZE As Long = 2 ' Size of vbCrLf
Private Const LINE_SIZE As Long = 40 + EOL_SIZE ' Size of a line
Private Const Base64 As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private Const Base64_EOF As String = "="
Public Function Decode64(ByRef lpConvString As String) As String
Dim pt As Long
Dim ptMax As Long
Dim dwBuffer As Long
Dim cbSize As Long
Dim cbBits As Byte
Dim aByte As Byte
dwBuffer = 0
cbBits = 0
cbSize = 0
pt = 1
ptMax = Len(lpConvString)
Do While pt <= ptMax
aByte = InStr(1, Base64, Mid$(lpConvString, pt, 1))
If aByte Then
' Add 6 bits to the buffer
dwBuffer = dwBuffer * 64 + aByte - 1
cbBits = cbBits + 6
If cbBits >= 8 Then
Select Case cbBits
Case 12 ' 6 + 6
aByte = dwBuffer \ 16
dwBuffer = dwBuffer And 15
cbBits = 4
Case 10 ' 4 + 6
aByte = dwBuffer \ 4
dwBuffer = dwBuffer And 3
cbBits = 2
Case 8 ' 2 + 6
aByte = dwBuffer
dwBuffer = 0
cbBits = 0
End Select
cbSize = cbSize + 1
Mid$(lpConvString, cbSize, 1) = Chr$(aByte)
End If
End If
pt = pt + 1
Loop
Decode64 = Mid$(lpConvString, 1, cbSize)
End Function
Public Function Encode64(ByRef lpConvString As String) As String
Dim pt As Long
Dim ptMax As Long
Dim dwBuffer As Long
Dim cbSize As Long
Dim cbBits As Byte
Dim cbLines As Long
Dim aByte As Byte
Dim lpBuffer As String
dwBuffer = 0
cbBits = 0
cbSize = EOL_SIZE ' Tips for the NewLine
cbLines = 1
pt = 1
ptMax = Len(lpConvString)
lpBuffer = String$(LINE_SIZE + ptMax * 2, 0)
Do Until pt > ptMax
' Add 8 bits to the buffer
dwBuffer = dwBuffer * 256 + Asc(Mid$(lpConvString, pt, 1))
cbBits = cbBits + 8
Do
Select Case cbBits
Case 6
aByte = dwBuffer
dwBuffer = 0
cbBits = 0
Case 8
aByte = dwBuffer \ 4
dwBuffer = dwBuffer And 3
cbBits = 2
Case 10
aByte = dwBuffer \ 16
dwBuffer = dwBuffer And 15
cbBits = 4
Case 12
aByte = dwBuffer \ 64
dwBuffer = dwBuffer And &H3F
cbBits = 6
Case 2 ' Only when pt = ptmax
aByte = dwBuffer * 16
dwBuffer = 0
cbBits = 0
Case 4 ' Only when pt = ptmax
aByte = dwBuffer * 4
dwBuffer = 0
cbBits = 0
End Select
' Add a character to the buffer
cbSize = cbSize + 1
Mid$(lpBuffer, cbSize, 1) = Mid$(Base64, 1 + aByte, 1)
' Add the NewLine to the buffer
If (cbSize Mod LINE_SIZE) = 0 Then
Mid$(lpBuffer, cbSize + 1, EOL_SIZE) = vbCrLf
cbSize = cbSize + EOL_SIZE
cbLines = cbLines + 1
End If
' Loop while not done with this byte
Loop While (cbBits = 6) Or ((pt = ptMax) And (cbBits > 0))
pt = pt + 1
Loop
' Add one or two bytes Base64_EOF
Select Case (cbSize - EOL_SIZE * cbLines) Mod 3
Case 1: '8 bit final
Mid$(lpBuffer, cbSize + 1, 2) = Base64_EOF & Base64_EOF
cbSize = cbSize + 2
Case 2: '16 bit final
Mid$(lpBuffer, cbSize + 1, 1) = Base64_EOF
cbSize = cbSize + 1
End Select
' Return the string and ignore the two first bytes
Encode64 = Mid$(lpBuffer, 1 + EOL_SIZE, cbSize - EOL_SIZE)
End Function
Public Function hash_string(ByRef s As String) As String
Dim h As Long
Dim i As Long
h = 0
For i = 1 To Len(s)
h = ((h And &HFF000000) \ &H1000000) + _
(((h And &HFFFFFF) * 8) + Asc(Mid$(s, i, 1)))
Next
hash_string = Right$("00000000" & Hex$(h), 8)
End Function
Compatibilité : VB6
Disponible dans d'autres langages :
A voir également
- Chaine vers Base 64 et vice versa
- Javascript et base de données - Conseils pratiques -Javascript
- Sous chaine en python - Forum Python
- Convertisseur jpg vers png ✓ - Forum Java
- Le format de la chaîne d'entrée est incorrect ✓ - Forum C# / .NET
- Extraction sous chaine dans une variable ✓ - Forum Delphi / Pascal
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.