It is similar to UUencode or base64, but is more efficient.
The overhead produced by basE91 depends on the input data.
It amounts at most to 23% (versus 33% for base64) and can range down to 14%, which typically occurs on 0-byte blocks."
I'm tired of using base64, so i converted this from javascript .. and i made it faster.
More info: http://base91.sourceforge.net
Code: Select all
; BasE91 encode/decode
; Coded by: xakep
; Based on http://base91.sourceforge.net and https://github.com/pkalogiros/base91.js
; Version 0.2, thanks to wilbert@purebasic.fr
EnableExplicit
Structure B91
s.s[1]
asc.a
EndStructure
Global Dim Base91_Alphabet.B91(91)
Global Base91_Initiated.b
Procedure.b Base91_Init()
Define i.l, bAlph.s, sNow.s
bAlph = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~" + #DOUBLEQUOTE$
i = 1
Repeat
sNow = Mid(bAlph, i, 1)
Base91_Alphabet(i)\s = sNow
Base91_Alphabet(i)\asc = Asc(sNow)
i = i + 1
Until i > 91
Base91_Initiated = #True
EndProcedure
Procedure.l FindInB91(Array Arr.B91(1), sToFind.s)
Define i.l, zFound.b
i = 1
Repeat
If Arr(i)\s = sToFind
zFound = #True
Break
EndIf
i = i + 1
Until i > 91
If zFound = #True
ProcedureReturn i -1
EndIf
EndProcedure
Procedure.s Base91_encode(*Mem, memLen.l)
Define i.l, b.l, n.l, v.l, sRet.s, x.l, *Encoded, eLen.l, iC.l
If *Mem = 0 Or memLen = 0
ProcedureReturn
EndIf
If Base91_Initiated = #False
Base91_Init()
EndIf
*Encoded = AllocateMemory(memLen * 1.5)
If *Encoded
Repeat
x = PeekA(*Mem + i)
b = b | x << n
n = n + 8
If n > 13
v = b & 8191
If v > 88
b = b >> 13
n = n - 13
Else
v = b & 16383
b = b >> 14
n = n - 14
EndIf
PokeA(*Encoded + iC, Base91_Alphabet(v % 91 + 1)\asc)
iC = iC + 1
PokeA(*Encoded + iC, Base91_Alphabet((v / 91 | 0 ) + 1)\asc)
iC = iC + 1
EndIf
i = i + 1
Until i >= memLen
If n
PokeA(*Encoded + iC, Base91_Alphabet(b % 91 + 1)\asc)
iC = iC + 1
If n > 7 Or b > 90
PokeA(*Encoded + iC, Base91_Alphabet(b / 91 | 0 + 1)\asc)
iC = iC + 1
EndIf
EndIf
If iC > 0
sRet = PeekS(*Encoded, iC, #PB_Ascii)
EndIf
FreeMemory(*Encoded)
ProcedureReturn sRet
EndIf
EndProcedure
Procedure.l Base91_decode(*Mem, memLen.l)
Define i.l, p.l, v.l, s1.s, b.l, n.l, mCount.l
If *Mem = 0 Or memLen = 0
ProcedureReturn
EndIf
If Base91_Initiated = #False
Base91_Init()
EndIf
v = -1
Repeat
s1 = PeekS(*Mem + i, 1, #PB_Ascii)
If s1
p = FindInB91(Base91_Alphabet(), s1)
If p > -1
If v = -1
v = p
Else
v = v + p * 91
b = b | v << n
If (v & 8191) > 88
n = n + 13
Else
n = n + 14
EndIf
Repeat
PokeA(*Mem + mCount, b & $ff)
mCount = mCount + 1
b = b >> 8
n = n - 8
Until n <= 7
v = -1
EndIf
EndIf
Else
mCount = 0
v = -1
Break
EndIf
i = i + 1
Until i >= memLen
If v > -1
PokeA(*Mem + mCount, (b | v << n) & $ff)
mCount = mCount + 1
EndIf
ProcedureReturn mCount
EndProcedure
Procedure.b encodeFile(FileIn.s, FileOut.s)
Define *dIn, dLen.l, encoded.s, bRet.b
If OpenFile(0, FileIn, #PB_File_SharedRead)
dLen = Lof(0)
If dLen
*dIn = AllocateMemory(dLen + SizeOf(Character))
If *dIn
ReadData(0, *dIn, dLen)
EndIf
EndIf
CloseFile(0)
EndIf
If dLen
encoded = Base91_encode(*dIn, dLen)
FreeMemory(*dIn)
If encoded
If OpenFile(1, FileOut, #PB_File_SharedWrite | #PB_File_SharedRead | #PB_Ascii)
If WriteString(1, encoded, #PB_Ascii)
encoded = ""
bRet = #True
EndIf
CloseFile(1)
EndIf
EndIf
EndIf
ProcedureReturn bRet
EndProcedure
Procedure.b decodeFile(FileIn.s, FileOut.s)
Define *dIn, dLen.l, lDecoded.l, bRet.b
If OpenFile(0, FileIn, #PB_File_SharedRead)
dLen = Lof(0)
If dLen
*dIn = AllocateMemory(dLen + SizeOf(Character))
If *dIn
ReadData(0, *dIn, dLen)
EndIf
EndIf
CloseFile(0)
EndIf
If dLen
lDecoded = Base91_decode(*dIn, dLen)
If lDecoded
If OpenFile(1, FileOut, #PB_File_SharedWrite | #PB_File_SharedRead | #PB_Unicode)
If WriteData(1, *dIn, lDecoded)
FreeMemory(*dIn) : *dIn = 0
bRet = #True
EndIf
CloseFile(1)
EndIf
EndIf
If *dIn > 0
FreeMemory(*dIn)
EndIf
EndIf
ProcedureReturn bRet
EndProcedure
Procedure.s encodeString(sIn.s)
Define *dIn, dLen.l, dRet.s
dLen = Len(sIn)
If dLen = 0
ProcedureReturn
EndIf
*dIn = AllocateMemory(dLen + SizeOf(Character))
If *dIn
If PokeS(*dIn, sIn, dLen, #PB_Ascii)
dRet = Base91_encode(*dIn, dLen)
EndIf
FreeMemory(*dIn)
EndIf
ProcedureReturn dRet
EndProcedure
Procedure.s decodeString(sIn.s)
Define *dIn, dLen.l, decLen.l, sRet.s
dLen = Len(sIn)
If dLen = 0
ProcedureReturn
EndIf
*dIn = AllocateMemory(dLen + SizeOf(Character))
If *dIn
If PokeS(*dIn, sIn, dLen, #PB_Ascii)
decLen = Base91_decode(*dIn, dLen)
EndIf
If decLen
sRet = PeekS(*dIn, decLen, #PB_Ascii)
EndIf
FreeMemory(*dIn)
EndIf
ProcedureReturn sRet
EndProcedure
