Suite à certaines recherches, j'ai eu besoin de pouvoir encoder et décoder en base45, j'ai donc fait un petit code pour cela. Je vous donne le code et cela pourra être utile à certains, s'ils recherchent des choses du contexte actuel.
Code : Tout sélectionner
Global.s charset = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:"
#BaseSize = 45 ;
#BaseSizeSquared = 45*45 ;
#EncodedChunkSize = 3 ;
#ByteSize = 256 ;
; ****************************************************************************
Procedure divmod(x.i, y.i, Array buffer(1))
buffer(0) = Round(x / y, #PB_Round_Down)
buffer(1) = x % y
EndProcedure
; ****************************************************************************
Procedure.s Encode(input.s)
Define.i i
Define.s result
Dim Liste1(1)
Dim Liste2(1)
Dim buffer.i(Len(input))
For i = 1 To Len(input)
buffer(i - 1) = Asc(Mid(input, i, 1))
Next i
For i = 0 To ArraySize(buffer()) - 2 Step 2
If ArraySize(buffer()) - i > 1
Define.i x = (buffer(i) << 8) + buffer(i + 1)
divmod(x, #BaseSizeSquared, Liste1())
divmod(Liste1(1), #BaseSize, Liste2())
result + Mid(charset, Liste2(1) + 1, 1) + Mid(charset, Liste2(0) + 1, 1) + Mid(charset, Liste1(0) + 1, 1)
Else
divmod(buffer(i), #BaseSize, Liste1())
result + Mid(charset, Liste1(1) + 1, 1) + Mid(charset, Liste1(0) + 1, 1)
EndIf
Next i
ProcedureReturn result
EndProcedure
; ****************************************************************************
Procedure.s Decode(input.s)
If input = #Null$
ProcedureReturn #Null$
EndIf
If Len(input) % #EncodedChunkSize = 1
ProcedureReturn #Null$
EndIf
Define.i i
Dim Liste1(1)
Dim buffer.i(Len(input))
For i = 1 To Len(input)
Define.i p = FindString(charset, Mid(input, i, 1))
If p > 0
buffer(i - 1) + (p - 1)
EndIf
Next i
Define.s result
For i = 0 To ArraySize(buffer()) - 3 Step 3
If ArraySize(buffer()) - i >= 3
Define.i x = buffer(i) + buffer(i + 1) * #BaseSize + buffer(i + 2) * #BaseSizeSquared
divmod(x, #ByteSize, Liste1())
result + Chr(Liste1(0)) + Chr(Liste1(1))
Else
Define.i x = buffer(i) + buffer(i + 1) * #BaseSize
result + Chr(x)
EndIf
Next i
ProcedureReturn result
EndProcedure
; ****************************************************************************
Debug Encode("ceci est un test")
Debug Decode(Encode("ceci est un test"))
GallyHC