Your code seems to work fine.
1) in encode you have Dim aB91(0 To 91) = 92 elements, but you can repair that.
2) in decode Dim aChr(0 To Len(sString)-1) As String , I changed this.
3) I have added a parameter to decode to save the length.
*zstring ptr OK for ascii text, but not binary (It halts at first chr(0)
I did ufmod.dll to newufmod.dll, seems OK.
Your base91 convertor:
Code: Select all
Function Base91Encode(binArray As Ubyte Ptr, iLen as ulong, ByRef iLenOut as Ulong) As Ubyte Ptr Export
Dim sChars As String
sChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~´" '´ instead of "
Dim aB91(0 To 91) As String ' This is 92 elements
Dim As ULong i
For i = 0 To UBound(aB91) - 1
aB91(i) = Mid(sChars, i + 1, 1) 'split sChar to an array
Next
Dim aASCII(0 To iLen) As Ubyte
For i = 0 To iLen - 1
aASCII(i) = binArray[i] 'split input sString to an ASCII array
Next
Dim As String sEncoded
Dim As Integer n
Dim as uInteger b, v
b = 0
n = 0
For i = 0 To iLen - 1 'encode input to Base91
b = b Or (aASCII(i) Shl n)
n += 8
If n > 13 Then
v = b And 8191
If v > 88 Then
b = b Shr 13
n -= 13
Else
v = b and 16383
b = b Shr 14
n -= 14
EndIf
sEncoded &= aB91(v Mod 91) & aB91(v \ 91)
EndIf
Next
If n Then
sEncoded &= aB91(b Mod 91)
If (n > 7) Or (b > 90) Then sEncoded &= aB91(b \ 91)
EndIf
iLenOut = Len(sEncoded) 'return lentgh of the string
Static As ubyte aReturn(0 to Len(sEncoded))
For i = 0 to Len(sEncoded) - 1 'convert result string to ascii code values
aReturn(i) = Asc(sEncoded, i + 1)
Next
Return @aReturn(0) 'return pointer to the array
End Function
#include "file.bi"
Function loadfile(file as string) as String
If FileExists(file)=0 Then Print file;" not found":Sleep:end
var f=freefile
Open file For Binary Access Read As #f
Dim As String text
If Lof(1) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
return text
end Function
Sub savefile(filename As String,p As String)
Dim As Integer n
n=Freefile
If Open (filename For Binary Access Write As #n)=0 Then
Put #n,,p
Close
Else
Print "Unable to load " + filename
End If
End Sub
Function Base91Decode(sString as String,byref l as long) As Ubyte Ptr
Dim As String sB91, sDecoded
sB91 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~´" '´ instead of "
Dim As Long i, n = 0, c, b = 0, v = -1
Dim aChr(0 To Len(sString)-1) As String '<=====================
For i = 0 To UBound(aChr)
aChr(i) = Mid(sString, i + 1, 1)
Next
For i = 0 To UBound(aChr)
c = InStr(sB91, aChr(i)) - 1
If v < 0 Then
v = c
Else
v += c * 91
b = b Or (v Shl n)
n += 13 + (((v And 8191) <= 88) * -1)
Do Until (n > 7)=0
sDecoded &= Chr(b And 255)
b = b Shr 8
n -= 8
Loop
v = -1
EndIf
Next
If (v + 1) Then
sDecoded &= Chr((b Or (v Shl n)) And 255)
End If
l=len(sdecoded)
Static As ubyte aReturn(0 to Len(sDecoded))
For i = 0 to Len(sDecoded) - 1 'convert result string to ascii code values
aReturn(i) = Asc(sDecoded, i + 1)
Next
Return @aReturn(0) 'return pointer to the array
End Function
dim as long l
dim as string s=loadfile("ufmod.dll")
print filelen("ufmod.dll")
dim as ubyte ptr eu=base91encode(strptr(s),len(s),l)
dim as string e= *cast (zstring ptr,eu) 'zstring OK for base91 (no chr(0))
savefile("ufmodencoded.txt",e)
dim as ubyte ptr p=base91decode(e,l)
dim as string ret=string(l,0) 'need string to capture result (binary file contains chr(0))
for n as long=0 to l-1
ret[n]=p[n]
next
savefile("Newufmod.dll",ret)
print filelen("Newufmod.dll")
print "done"
delete p
delete eu
sleep