Best approach to use a DLL

Windows specific questions.
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 01, 2018 14:30

@dodicat: In the example of the B64 encoded text above always the first 8 bytes were randomized. Do you have an idea how I can save long strings with FB?
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 01, 2018 14:41

I realise srvaldez.
But the different results with gcc/gas/64 bit?

I think
static as ubyte a()
redim a(0 to 4)
should be OK.
It freshens the array each time.

Code: Select all


function dothis() as ubyte ptr
    static as integer runflag
    randomize
   
    static as ubyte a()
    redim  a(0 to 4)
   
    'or
   ' static as ubyte a(0 to 4)
   
    a(0)=72
    a(1)=101
    a(2)=108
    if runflag=0 then 'only on first run
    a(3)=108
    a(4)=111
    runflag=1
    end if
    for n as long=1 to 5
    swap a(int(rnd*3)),a(int(rnd*3)) '0,1,2
    next n
    print *cast(zstring ptr,@a(0))," from function"
    return @a(0)
end function

dim as ubyte ptr z
for n as long=1 to 10
    z=dothis()
print *cast(zstring ptr,z)," from outside"
print
next

   sleep
   

     
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 01, 2018 15:26

Here what I did so far when compressing the input additionally with RtlCompressBuffer to save some more bytes.

Code: Select all

Function _WinAPI_Base64Decode(sBase64 as String) as UByte Ptr
   #Define CRYPT_STRING_BASE64 1
   Dim as any Ptr hLib = Dylibload("Crypt32.dll")
   dim pCryptStringToBinary as Function _
                              (byval pszString as zstring Ptr, _
                               byval pcchString as Long, _
                               byval dwFlags as Long, _
                               byval pbBinary as UBYTE Ptr, _
                               byval pcbBinary as Long Ptr, _
                               byval pdwSkip as Long Ptr, _
                               byval pdwFlag as Long Ptr) As Boolean
   pCryptStringToBinary = Dylibsymbol(hLib, "CryptStringToBinaryA") 'https://msdn.microsoft.com/en-us/library/windows/desktop/aa380285(v=vs.85).aspx
   Dim as Long iSize = Len(sBase64)
   Dim as UByte aDecodeB64(0 to iSize)
   Dim as Boolean result = pCryptStringToBinary( StrPtr(sBase64), _
                                      0, _
                                      1, _
                                      @aDecodeB64(0), _
                                      @iSize, _
                                      0, _
                                      0)
   Dylibfree(hLib)
   If result = 0 then Return 0
   
   hLib = Dylibload("Ntdll.dll")
   dim pRtlDecompressBuffer as Function _
                        (Byval CompressionFormat as UShort, _
                         Byval UncompressedBuffer as Ubyte ptr, _
                         Byval UncompressedBufferSize as ULong, _
                         Byval CompressedBuffer as UByte Ptr, _
                         Byval CompressedBufferSize as ULong, _
                         Byval FinalUncompressedSize as ULong ptr) as Ulong
   pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer
   #Define COMPRESSION_FORMAT_LZNT1 &h0002
   static as UByte aDecompress()
   Redim aDecompress(0 to 1502)
   Dim as ULong iUSize
   Dim as Ulong iReturn = pRtlDecompressBuffer( COMPRESSION_FORMAT_LZNT1, _
                                                @aDecompress(0), _
                                                1502, _
                                                @aDecodeB64(0), _
                                                iSize, _
                                                @iUSize)
   Dylibfree(hLib)
   If iReturn <> 0 then Return 0
   
   Return @aDecompress(0)
End Function


Dim as Byte Ptr binB64Decoded = _WinAPI_Base64Decode("nrIAJ2h0dHBzOi8AL21zZG4ubWkAY3Jvc29mdC4AY29tL2VuLXUAcy9saWJyYXIAeS93aW5kb3cAcy9kZXNrdG8AcC9hYTM4MDIAODUodj12cy4AODUpLmFzcHgADQpGdW5jdGkAb24gX1dpbkEAUElfQmFzZTYANERlY29kZSgCcwMaIGFzIFN0IHJpbmcpAQpVQgB5dGUgUHRyDQAKICAgI0RlZgBpbmUgQ1JZUABUX1NUUklOR6BfQkFTRQA3MQIhiERpbQE2YW55ATQAIGhMaWIgPSAERHkAq2xvYWQoACJDcnlwdDMyQC5kbGwiKQIyZA0AMnACFgN3VG9CaT5uANeBIwdZAhUYAChiAHl2YWwgcHN6s4MigR56cwMFgEQsnyAiIIQgY2NoByFMbwRuZ6cdZHdGbGEmZwB/LRxwYod5VUJ4WVRFrVnID0EerA9k4HdTa2lwNg8BPQkPACkgQXMgQm9vcGxlYW5CEZJ3hIVzQHltYm9sKEGKLHYgg4cLCkHEiYSWAhlpEFNpemVAEExlbgMFrgMJU3RhdGljzUeuYUS3QwdyZQGbxQTwMCB0b0MSChgELgALsHN1bHQAGVEvKAHJr4A6Rh8hTAQAMOgKMX8F/QYAQAYbvxGoBiIgHwbfF4dxBSQrAT1mcmVlwjwZYwJJZicsIDFoZW4AIFJldHVybiAOMOIDhAGIGg0KRW5yZEaCDQohAGU2pJQg0GJpbkJFmmQgC1KdACJTV1lnZVc5ADFJR05oYmlCAHlaV0ZrSUhSAG9hWE1nZEdoAmxgAmtaV052WgBHbHVaeUIzYgAzSnJaV1FnYwBISnZjR1Z5YgBIa3VJRG90SwhRPT2hUw0KPyBgQ2FzdCgqjmoRKQhbMF1DFlNsZWUAcA==")

? Cast(zstring Ptr, binB64Decoded)[0]


Sleep


It should print out my previous source code. What I need now is a smart idea how to save longer files within code...
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 01, 2018 19:49

Problem with all this.
Text files, OK.
I tested a 4 mb text file, instantly done.

I include
(the option of removing the chr(13,10) 's from the base64 output )
optional of course.


However, with binary files, it doesn't work anymore.

Code: Select all


Declare Function CryptBinaryToString Lib "Crypt32"Alias "CryptBinaryToStringA"(As zstring Ptr,As Long,As Long,As zstring Ptr,As Long Ptr) As Long

Declare Function CryptStringToBinary Lib "Crypt32"Alias "CryptStringToBinaryA"(As zstring Ptr,As Long,As Long,As Byte Ptr,As Long Ptr,As Long,As Long Ptr) As Long

Sub Remove(Text As String,oneChar As String)
    dim as long index
    For i As long = 0 To Len(Text) - 1
        If Text[i] <> Asc(onechar) Then Text[index] = Text[i] : index =index+ 1
    Next : Text = Left(Text,index)
End Sub

Function Base64Decode(s As String) As String
    Dim As Long  Length = Len(s)
    Dim As ubyte Ptr b=Callocate(length,1)
    CryptStringToBinary( Strptr(s),Length,1,b,@Length,0, 0)
    Function= *Cast(zstring Ptr,b)
    Deallocate  b
End Function   

Function Base64Encode(p As String ) As String
    Dim As Long L=Len(p)*2
    Dim As ubyte Ptr s=Callocate(L,1)
    CryptBinaryToString(Strptr(p),Len(p),1,s,@L)
    var ans=*Cast(zstring Ptr,s)
    'remove(ans,chr(13))
    'remove(ans,chr(10))
    Function=ans
    Deallocate s
End Function

 #Include "file.bi"
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 save " + filename
    End If
End Sub
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

dim as string file="ufmod.dll" '< ---  my binary file
var L=loadfile(file)
dim as string e=Base64Encode(L)
savefile("encoded.txt",e)


var L2=loadfile("encoded.txt")
dim as string f=Base64Decode(L2)
print f
print L=f

print len(L),len(f)
sleep

output:

Code: Select all

MZÉ
 0
 9728          3
 
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 01, 2018 22:26

I found a way to store the base64 within the code.

Here the code but without the encoded base64 string -> full code can be found here: https://pastebin.com/8V8kwBSQ

Extract uFMOD.dll from the base64 encoded and compressed string:

Code: Select all

'coded by UEZ build 2018-02-01
Function _WinAPI_Base64Decode(sBase64 as String) as UByte Ptr
   #Define CRYPT_STRING_BASE64 1
   Dim as any Ptr hLib = Dylibload("Crypt32.dll")
   dim pCryptStringToBinary as Function _
                              (byval pszString as zstring Ptr, _
                               byval pcchString as Long, _
                               byval dwFlags as Long, _
                               byval pbBinary as UBYTE Ptr, _
                               byval pcbBinary as Long Ptr, _
                               byval pdwSkip as Long Ptr, _
                               byval pdwFlag as Long Ptr) As Boolean
   pCryptStringToBinary = Dylibsymbol(hLib, "CryptStringToBinaryA") 'https://msdn.microsoft.com/en-us/library/windows/desktop/aa380285(v=vs.85).aspx
   Dim as Long iSize = Len(sBase64)
   Dim as UByte aDecodeB64(0 to iSize)
   Dim as Boolean result = pCryptStringToBinary( StrPtr(sBase64), _
                                      0, _
                                      1, _
                                      @aDecodeB64(0), _
                                      @iSize, _
                                      0, _
                                      0)
   Dylibfree(hLib)
   If result = 0 then Return 0
   
   hLib = Dylibload("Ntdll.dll")
   dim pRtlDecompressBuffer as Function _
                        (Byval CompressionFormat as UShort, _
                         Byval UncompressedBuffer as Ubyte ptr, _
                         Byval UncompressedBufferSize as ULong, _
                         Byval CompressedBuffer as UByte Ptr, _
                         Byval CompressedBufferSize as ULong, _
                         Byval FinalUncompressedSize as ULong ptr) as Ulong
   pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer
   #Define COMPRESSION_FORMAT_LZNT1 &h0002
   static as UByte aDecompress()
   Redim aDecompress(0 to 9728)
   Dim as ULong iUSize
   Dim as Ulong iReturn = pRtlDecompressBuffer( COMPRESSION_FORMAT_LZNT1, _
                                                @aDecompress(0), _
                                                9728, _
                                                @aDecodeB64(0), _
                                                iSize, _
                                                @iUSize)
   Dylibfree(hLib)
   If iReturn <> 0 then Return 0
   
   Return @aDecompress(0)
End Function

Dim as String aB64(1), sString
Restore __ufmoddll:
For i as uByte = 0 to 10
   Read aB64(0)
   sString &= aB64(0)
Next

Dim as Byte Ptr binB64Decoded = _WinAPI_Base64Decode(sString)

Dim as long iFileNum = FreeFile
Open CurDir & "\ufmod.dll" For Binary As #iFileNum
If Err = 0 Then Put #iFileNum, 0, *binB64Decoded, 9728

Close

? "uFMOD.dll saved to disk!"
Sleep


Now I've to modify my FB File2Bas Code Generator script...

My next step is to call the dll directly from the memory instead of saving to disk first and then loading it afterwards.

Thanks for your help dodicat. ^^
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 04, 2018 2:20

i have made a freebasic base64 encoder/decoder.
If I used gmp it would be fast, but not everybody has the gmp library, so it is slower.
For the ufmod.dll, about 25 seconds to encode it to base64 and decode it back.

Code: Select all

'look ups
Dim Shared As Ubyte Q(0 To 99,1 To 9)
For n As Long=0 To 99
    For m As Long=1 To 9
        Q(n,m)=(n Mod m)*10
    Next
Next
Dim Shared As Integer _Mod(0 To 99),_Div(0 To 99)
For z As Integer=0 To 99:_Mod(z)=(z Mod 10+48):_Div(z)=z\10:Next
    'as per wiki, the most common set for base64
    Dim As const String tmp="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim Shared As Ubyte u(Len(tmp)-1)
    For n As Long=0 To Len(tmp)-1
        u(n)=tmp[n] 'base64 characters
    Next
    Dim Shared As Ubyte iu(43 To 122)
    For n As Long=0 To Len(tmp)-1
        iu(u(n))=n   'inverse of u() to decode
    Next
   
    '==============
    Function Qmult(a As String,b As String) As String
        Var flag=0,la = Len(a),lb = Len(b)
        If Lb>La Then flag=1:Swap a,b:Swap la,lb
        Dim As Ubyte n,carry,ai
        Var c =String(la+lb,"0")
        For i As Integer =la-1 To 0 Step -1
            carry=0:ai=a[i]-48
            For j As Integer =lb-1 To 0 Step -1
                n = ai * (b[j]-48) + (c[i+j+1]-48) + carry
                carry =_Div(n):c[i+j+1]=_Mod(n)
            Next j
            c[i]+=carry
        Next i
        If flag Then Swap a,b
        Return  Ltrim(c,"0")
    End Function
   
    Function plus(Byval num1 As String,Byval num2 As String) As String
        Static As Const Ubyte AddQMod(0 To 19)={48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57}
        Static As Const Ubyte AddBool(0 To 19)={0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1}
        Var n_=0
        Dim As Ubyte addup=Any,addcarry
        #macro finish()
        Return Ltrim(answer,"0")
        #endmacro
        If Len(num2)>Len(num1) Then  Swap num2,num1
        Var diff=Len(num1)-Len(num2)
        Var answer="0"+num1
        For n_=Len(num1)-1 To diff Step -1
            addup=num2[n_-diff]+num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
        End If
        For n_=n_ To 0 Step -1
            addup=num1[n_]-48
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
            If addcarry=0 Then Exit For
        Next n_
        answer[0]=addcarry+48
        finish()
    End Function
   
    Function minus(Byval num1 As String,Byval num2 As String) As String
        Static As Const Ubyte subqmod(19)={48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57}
        Static As Const Ubyte subbool(19)={1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0}
        Dim As Integer bigger         
        Dim sign As String * 1
        Var lenf=Len(NUM1)
        Var lens=Len(NUM2)
        #macro finishup()
        answer=Ltrim(answer,"0")
        If answer="" Then Return "0"
        Return sign+answer
        #endmacro
        #macro compare()
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
        #endmacro
       
        compare()
        If bigger Then
            sign="-"
            Swap NUM2,NUM1
            Swap lens,lenf
        End If
        Var diff=lenf-lens
        Dim As String answer=NUM1
        Dim As Integer n
        Dim As Ubyte takeaway,subtractcarry
        subtractcarry=0
        For n=lenf-1 To diff Step -1
            takeaway= num1[n]-num2[n-diff]+10-subtractcarry
            answer[n]=Subqmod(takeaway)
            subtractcarry=Subbool(takeaway)
        Next n
       
        If subtractcarry=0 Then:finishup():End If
        If n=-1 Then:finishup():End If
        For n=n To 0 Step -1
            takeaway= num1[n]-38-subtractcarry
            answer[n]=Subqmod(takeaway)
            subtractcarry=Subbool(takeaway)
            If subtractcarry=0 Then Exit For
        Next n
        finishup()
    End Function 
   
    #include "file.bi"
    Function loadfile(file As String) As String
        Var  f=Freefile
        If  Fileexists(file)=0 Then Print file;"  not found,press a key":Sleep:End
        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
   
    Sub Remove(Text As String,oneChar As String)
        Dim As Long index
        For i As Long = 0 To Len(Text) - 1
            If Text[i] <> Asc(onechar) Then Text[index] = Text[i] : index =index+ 1
        Next : Text = Left(Text,index)
    End Sub
   
    Function shortdiv(Byval s As String,s2 As String) As  String
        Dim As Ubyte main,carry,d=s2[0]-48,temp
        Dim As String ans=s
        For z As Integer=0 To Len(s)-1
            temp=(s[z]-48+carry)
            main=temp\d
            carry= Q(temp,d)
            ans[z]=main+48
        Next z
        Return Ltrim(ans,"0")
    End Function
   
    Function div256(s As String) As String
        Var n1=shortdiv(s,"4")
        Var n2=shortdiv(n1,"8")
        Var n3=shortdiv(n2,"8")
        Return n3
    End Function
   
    Function mod256(s As String) As String
        Var n1=shortdiv(s,"4")
        Var n2=shortdiv(n1,"8")
        Var n3=shortdiv(n2,"8")
        Return  minus(s,qmult(n3,"256"))
    End Function
   
    Function div64(s As String) As String
        Var n1=shortdiv(s,"8")
        Var n2=shortdiv(n1,"8")
        Return n2
    End Function
   
    Function mod64(s As String) As String
        Var n1=shortdiv(s,"8")
        Var n2=shortdiv(n1,"8")
        Return minus(s,qmult(n2,"64"))
    End Function
   
    Function converttobase64(Byval i As String) As String
        Dim As String d,m,g
        Do
            d=div64(i)
            m=mod64(i)
            g=Chr((u(Vallng(m))))+g
            i=d
        Loop Until i=""
        Return g
    End Function
   
    Function convert64tobase256(Byval i As String) As String
        Dim As String d,m,g
        Do
            d=div256(i)
            m=mod256(i)
            g=Chr(Vallng(m))+g
            i=d
        Loop Until i=""
        Return g
    End Function
   
    Function convert64baseto10(Byval Number As String) As String
        Dim As String sum
        sum=Str(iu(number[0]))
        For n As Integer=1 To Len(Number)-1
            sum=plus(Qmult(sum,"64"),Str((iu(Number[n]))) )
        Next n
        Return sum
    End Function
   
    Function convertbaseto10(Byval Number As String) As String
        Dim As String sum
        sum=Str(number[0])
        For n As Integer=1 To Len(Number)-1
            sum=plus(Qmult(sum,"256"),Str((Number[n])) )
        Next n
        Return sum
    End Function
   
    Function Encode64(f As String) As String
        Dim As String pad=String(3-(Len(f) Mod 3),0)
        f+=pad
        Print "Phase 1 of 2 Encode, please wait ..."
        Var b=convertbaseto10(f)
        Print "Phase 2 of 2 Encode, please wait ..."
        Return converttobase64(b)
    End Function
   
    Function Decode64(f As String) As String
        If Instr(f,Chr(13)) Then remove(f,Chr(13))
        If Instr(f,Chr(10)) Then remove(f,Chr(10))
        Print "phase 1 of 2 Decode, please wait ..."
        Var g2=convert64baseto10(f)
        Print "phase 2 of 2 Decode, please wait ..."
        Return convert64tobase256(g2)
    End Function
   
    Function base64format(s As String) As String
        Dim As Long l=Len(s)
        Dim As String acc
        For n As Long=1 To l Step 64
            acc+=Mid(s,n,64)+Chr(13,10)
        Next
        Return acc
    End Function
   
    '=======================   TEST  =================
    Print "please wait ..."
   
   
    Dim As String file="ufmod.dll" '< --------   THE FILE
   
   
   
    Dim As Double t
   
   
    #macro Encode
    Var ss=loadfile(file)
    Var cc=Encode64(ss)
    cc=base64format(cc) ''optional
    savefile("image2.txt",cc)
    #endmacro
   
    t=Timer
    Encode
   
    #macro Decode
    Var s=loadfile("image2.txt")
    Print s
    s=Trim(s," ")
    Print "Decoding"
    Var uc= Decode64(s)
    var res= Iif(uc=ss,"Exact decode","Inexact decode")
    print res
    if res="Exact decode" then savefile("2"+file,uc)
    #endmacro
   
   
    Decode
    Print "Time taken ";Timer-t
    Sleep
   
   
   
     
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 04, 2018 13:03

@dodicat: seems to work properly except the file length of 2ufmod.dll which is 1 byte larger than the original. ;-) On my pc it took approx. 14 seconds overall.

I finished also the AutoIt version of FB File2Bas Code Generator which converts the input to a base64 string and additionally use the windows built-in compression if it makes sense to make it smaller. I used 1000 chars per line to save some crlf chars.

Please let me know if you are interested to get the AutoIt code / exe.

I tried also the Base91 encoder but something is not working properly...
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 04, 2018 15:05

My previous encoder was base 90 and starting at ascii 35 to avoid the double quote in the string.
(Just in case you want a literal string for freebasic somewhere)
For internet transfer:
Most browsers will pick up the output string (except Microsoft edge which distorts it completely some way)

on line 297 I coded s=trim(s).
Firefox seems to add a space at the end sometimes.

In another thread we experimented with base 128 transfers for bitmaps
(It is doable)

Here is a static gmp converter to play around with, any file for input.
A link to the mediafire page.
https://www.freebasic.net/forum/viewtopic.php?f=7&t=25744&p=233594&hilit=%2Amediafire%2A#p233594

....
Just be sure that your base 91 string has no unwanted characters tagged on.

I have downloaded Autolt and trying it out.
It is very basic like in syntax.
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 04, 2018 16:03

dodicat wrote:My previous encoder was base 90 and starting at ascii 35 to avoid the double quote in the string.
(Just in case you want a literal string for freebasic somewhere)
For internet transfer:
Most browsers will pick up the output string (except Microsoft edge which distorts it completely some way)

on line 297 I coded s=trim(s).
Firefox seems to add a space at the end sometimes.

In another thread we experimented with base 128 transfers for bitmaps
(It is doable)

Here is a static gmp converter to play around with, any file for input.
A link to the mediafire page.
https://www.freebasic.net/forum/viewtopic.php?f=7&t=25744&p=233594&hilit=%2Amediafire%2A#p233594

I will try it.


dodicat wrote:Just be sure that your base 91 string has no unwanted characters tagged on.

This is the Base91 encoder I'm working on:

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
   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

Function Base91Decode(sString as String) 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)) 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 Not (n > 7)
            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)
   EndIf

   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



dodicat wrote:I have downloaded Autolt and trying it out.
It is very basic like in syntax.

Yes, the syntax is very Basic like and easy to learn. As it is an Interpreter some code will work very slowly. Just install the full SciTE package to get full features which is not included in the install package. The latest interim version has major changes and some examples from the forum might work only after some modification, especially the WinAPI functions.
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 04, 2018 21:25

In your Base91decode

maybe

Code: Select all

 Dim aChr(0 To Len(sString)-1) As String '<=====================
   For i = 0 To UBound(aChr)             
      aChr(i) = Mid(sString, i + 1, 1)
   Next


gives a better return.

Code: Select all

 dim as string s="ABCDEFGHIJ"
dim as string e= *cast (zstring ptr,base91encode(strptr(s),len(s),l))
print e
print *cast(zstring ptr,base91decode(e))
print l



gives

fG^F%w_o%5qOB
ABCDEFGHIJ
 13

 
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 04, 2018 23:46

Base91 encoded string (compressed)
Test.bas

Code: Select all

'Generated by *FB File2Bas Code Generator v0.70 build 2018-02-04 beta by UEZ*

__ufmoddll:
Data 10,1,9728,7686,"Base91"
Data "y]zWu#PDwAAA5FkA@QB´HA$$v(raAA|LnbGASCGu<VY41CN/!4@LCCK´R.549fP[AA?2i>vNN!2A1RLRc%]xlL5F^IY@f[$y0AmC´4Ob!5Qn8M_1YJy4eGqIZLGf[~LZoS%I`t5}`Mmx[Fs)sOIw%tsn*hkU/C+L`EUQVBL6hEv´yB~hdc*ABtpADt*h@R(d~(z(BA!W;HDtAAaS3BKC7B=h2ETAQAqlUE4Y_E/F~tKCnIBtkIOAuWFh#(C´bEkMzHdS;(KC%NDA+OMc+BuAj)nEf)FAo.fE4kFAR9EEcF+4^IC`yC5tgjS´((HJzPFBC´AA@Q1+lEiiIEDA+u]9_ht2qIbysbp19W{I<A=J<Gw(QO<C}A@guC=R$&hEAASC@k<(UG)u{2qL(T{}+>J´?}+>J´fA$AIAUgui=AFZ0H5FlL*h´C_A(nZc0HSK@QFB@A_h[9vI(HBY&AIo/ACAbFBC1(0)IAs<?t4ATv,XT3a´fDCA=tgA/BSS:C5F95.o<>$A,AnnzA=C!c6SoI]´zHfS;4DA)MkX~Ip´hFGOe1oDbv^:LtyAH7x8s?MBtpPcVC~,zZ.AO2Q@8cNvBACtUxCT6]=v[Q_XtCZtN8LiCBMc2XDp!JWAEAOHJtaIgLmiouaIy´0X_P!~P73eQAN7lBMABt#L:]e4G9Kuf|geF{)TtL/DJ*hFUMb)/Jv(eEdfnj.V3HFBjZ3H&HitJtN´S05%yrRE%$eGJO0:~h=Yy:NsEkEA&>[v@9?DeGO{8JgA0_>DbtcLbC@9QAR?@QW)H;BtmAhtK54´aA~D/Fu)9k]~LtjnZlj|]f.oT@J*4L+>kXaq((´iLbcc2A9L;O;gwDBd&w0:qP@AnA!~sLHOLv2jgPxd^!C:qP#;*W|#g?/?,>@waBz(k]JthymCRF2OE|jY1xrCjB95MU[´^Xf4Ktp1AlD6,CP´GA"
Data "=A_QcA=~WLLP=AyyoOxb?vV6RfEA:CSwPth~B´%´_lLGIb$$^F!5O<+´/r232>BNpV^>Q/x(u;i|jU8}qXmBrv>myK/Ny´AAqBM>up})IVPDwc0)WWSqU!o4T+nBjM[udvRDZ<jg[g0´d/E*BtgL1(0PM&ju:FlhO´cdBC*CxW1xFj/=NJ3Ctp*CO?l0YXHAb?!Wdd}GYFC:{0z/eUw?1WxE5pYMjBMcNcCA;Pp9i}[:*OqATtOOnnM*M?9yHF18sVDVqiMto~+D,uAt44JBV)nh<A&ooM@QZLC´lU8?4l6Wu![QwDOZ[W8EnLO}H.qPtBlBB*TLKJA$w.ND7ff}(^itJBdJ<F]qXpgPbb>AXLog3]&HfLTB|4ck9#ItVv,>q1Z5ai$$qB^HW´TB)UGO1(eGLB$A_[1AO´R´Jd=h|ZCG2YNttH0ELv)ywB+BVR&bUI(HYZ%txp`):o8ZUI+hR6#F´uVM)EmGot;1zD+O@ARfgscMa]Sw.?eL]QL`wg6x[9Q(d<]}iYtcqBZ{xD_EmMHjRAMc2Xy~IZ=szd[NyCxM~9IJ@Qx`O7A?&HLDBtKCZ+BA<DdNgQa&,62I8oe4Hr}eHt(VfTjD.CAA?T{>ctxASCNJAXdzLAGeQ2oL2BPC>eg`CRT[H!}2`Xl4rFIHvA}C]x6;s&Nh2mNV=F1_e+ZIjI,>(^qwGl_HwBOGfG/cC]{qCt3rgZ3HRE>J@QoI^KihKAAADXdGr(%XlSCA=WH=b´ERwBzHUL.]}Ea*AAOKu`mB<BbPdx{JcYC9:H.LdAd}B´4F]#8CIoH3h@WO0/E´RJ{hHC*~:XXL_hX||q<?|Y*hgtk|Cjxp!AFRCSjBZ/L^AA._hUT4%WiA2;Ma<Jh4VOa4xC+K/MbnMuhA*W!@=/u}&Cg4)_Ca1sC=rcq´!(7z4Q&Q}´?FCKTz_:}E`y3_]9%N´Ns´29"
Data "HD7J%DLC6X+nbYU´YMPDw;6j:_+W+wc#wtkB/JNB8YN|vFCWmWAABthCO~[KlB@@?IB(Epa4XE|~T0~~R´H0GagL5Y]X^ze~P?*h4UO)6F8Mi6JuQt´>qP}j|8H8zX#sY4s?)t/yqG<kwA#mqXO+NAvf5;x+7izX8L&´PA]ywz8_LDsc4GgJ2];;J´8~^;x&O)9Eqi:wYG5ipzBADAqIpt6FSA´´`EAw9BwPjnVELm.)aLhAuuFNKU5wgev(`Hh&hN7RzAy6FTL)ob{o[9lK&_{6@V$´t[VW#AFAGe|´@<DAs8nBJ´OA*hWt_H&B3Oxdyl_nyOR~=C.$BAB6##(PKA^BhVfA:k*A(HoB4%cE,DD´.kZy@wzZQT,^RsO^2WYL8<aqr?O)k!ySVVBti/Af?H.tOF[t}9A&Np%[0(i$DAAoFRKC@$dAzh.18>gZZG)sL?Pt{9ctEEvC4FJKK}cA%$@)TuT#eO@QhR+FRQ´XnB!E]2R)k9)UOB:CHi71$y@w/>?jKlha.kHB+>6]2L9c84Et*hpI:{w84E?T$^SXU:uGPAvD´lP*)_4.C´OK&bQwMh*FdZ[Tp*44,n%FhZ>K8tl/YQNGk);tk4SD*HEN_ELPJF?{M(xSKCS~t+.Zo?Z´mVOq:´9YLCmOyyO}U;6rQ´zK>Oiu1[pGUw[&cJ_>Ei)k:Cbc!´uWUJ=W[Q.@v:OuTt6R#v$(MA1(tB382WpJ8y`2^X/YN´a´9yv1nYNJGu!YpdHU3deLcQsybLvuSXKAwF2}K&>kzD95;T_]<,b*DA<x/bD6dkf/_)APHkYD/b3SO!^t=h};?{#bPHMc/Lx)ZW3nBXqyex|n%Ll+y:+hoF@S3Bs]YGk_+P>EhAp[0ItpiZ9_I_D4ou<6<g*NYh*GSAV+24[~hGtImu0w5L7iU3#W>G{KkiPj>{nC=/B=/>ANujC´1YNG/h"
Data "BVZX&´8JEEZt:FJDP7zkY}E>5uPAGG%{/y8p|;Hk<M6E<u4FoX&=O/B´AtjaRuLC6y)pUY7C7R[Cg´smIf9u#D9H<cCmoXiaR)Z´6S._Hph+mS_)g#=A´9/WPtKA´y^>1`$J`[$bNTX#@^OtUkm(3<{m]q+>^9GFVHIW^odZL,+9<iY*MB==#O/QBp(Bjne^C7bc}sBAkUr|r_KA)hoIkug3)6kM9AZ7u´l@MOVLUE5r;v+wW3GA`E{Y(5NOtWUEOUdZJE´96AHDX`*A_&WTX;KzY@Mv7M+WnTeupM^CNuMA=JO?DDT)?Y@2Vqr_AR``|´mB)kCO3ZDt}C+>B96k8AUS´FC´1Gd@uW[C;TuW|eTz)H´5#C|;/DC)KI3DyAZSIA{sDfnAmOF[%W%t.[G´Mv/SB8.0WzF%JFG<eIFeLYxdxg}b;qv^VAEXy´/´TJ#CNp!IRRlI;Mzw,H[Q#TUE&a4xv(H)2XtCTpPBLHhJp@l0kGa*TQ@Aw(|WMcmM$$miJ7PCuC^FKr^?64u_QgCA310t:@I($}XLSK3KMgt`zLe4iEVB6qHBvJQAsg8yUMtT}>QAuVEIHUMf2K:C%niL9MvFe´be:V^´sKKGYYL|2(S4WE8W*5v|GkxA9yAAO/k?B$RMIF,7}g|Ajx,XJ´p~_95N|Nxv@wiBke&(ZqCA<cZbHwS>VWT´v8VipY5h)A@wviPA8fb,x(iAnI}Q`LBDRtHn{leu1v6y`FN7n4P)!aD´XXbc1F5YnAGu4QSK*yo$CA,[=tp%mEUK%AazLH+OF56D´ySI+h?GJF3JBtb4.^;kr7AM1Z#)&K20NvAD+O+,<T(?hZ*t$P<IT´H´lLIAoI]QY5_^sMR´{F;[:uvkFGrb,F@g=(YLbf4}`Cne)JYiFXc8%;AA?jq}{GT0eL4J´s)(NFIA?7+k<gq´``KP5Fa!xROhSGPAql"
Data "9Fc/ZoAt4}/ytxEdbYBGvH3>Kqoa[AhAdB<&H7t7c{?vHPe:/`Qg|Is?f=T&G^T5e(OttVueqwa5IFB5&n$Y#z2/Wce+H!CB}k[58AA4UMhBy/jU#(!ghN:1#5VNLACts1y/$Yd@eZ>GJ4mk*B)kS´hBFcVRwb]G*h]$H?IL9t]´l´&y5N3TU´FAf%,~B´]cFBgwD5G54n(J+coI>vl´zDoLAA2Cg}mb%9MViGLG/l<M!OtscMz?&/f´8D0A<A8EiywiF5ZOE´Xv4GVfJhK~j4v/&f4cYI&B<FwoFAJ*Et>{&t#/hZ^qCAdX3n=WXDMu=]p?..oMD´2W!To?=p*t)f{h;SzKdx%JE*zB~}oJ*Ls$MRPDQI`97xeI.ohZy{Q9yhEAFCzv4IoT~vqAQD1xFB+GYA|CSJI.KCNBm%vBbvAA=8,4C:]G}4hNY4hf6}|<!XMc3H1nQi5´xADAvn9BinLVa]f|bM>QGwg´zKNifY}s?LPjA´B´ETPWJ´j,8j(KlSWEs83Z(@P`@Qa´$Jr(c|C*sRUEmu[H|~tWoLCMw4ZGjnG3iAeWfoo*#T/YuWF5oL?[%y`A7%iY6L:FxF|LuqAAuWG´QhXL;fVJxu_8kB`tbiBt&i{FZ4E8KF(VqucC$gziJVH(06XL%+xy?t0´*v_)|E@D}IwXDAIANJsBXHkFOCdRJ$*F5^Z4;Y)a6A7va´N$=B^X_JHraIrfiAz1bAkX)C+K[@!F%tN@.ktFbLMI8MNf8}xp7y^xYX.iXa;$DAbI*Cm*dfFG?(5Yp´kA,Hw(Hp]v7Jv5WF*[,QFDdU=~EteGu=3DB6wISqfZn{0)1WHAwD)hNuU<RC!+SV4i+1P<HASG}5`YiA1t/`},|QA{dEmWwweWUM}G_8C´bQFD6f$OgONJ2v?|V,WRT´R?Oz{wxANG(H]oxuV3#nR´wAAAB´,uLFC´Tu"
Data "o6*hfg1C[NCNMWS}yzwWpOnH:]ZX}LT´LNgq%dcah~:C6y7|_MEZbshA<_;vlN=)2tw(?tjAfxs_QBC´Ii´i7LowMcrn[LMO=taBjr*]G2oqN?xWSKd!WzcR/Mv(ti5xOP_;5A95!L=_KU3TxW5LLZ,I:N0K@jEt[9fzJDkAd~iymzSJtsRA{(J´6W]|LA.YqI9.?jDY(t{;VA:Wa]^h<>6R{+cwIAwC2u=/b:´K´ex(NC|h[FU)>sm|rcJtk|B´=Wda%nBtuc#CjoMvVwGOc51_5+Q^*AW*_)y<NWdt0u(?DD[Bcc3CpJGuK+rnxFyCP´}HKZ3O;IFAj|uOTxwwUJv(~*>(zA&BdB[tTcGw>w!DC´sGKcM>5F&Ba´_K3B?ry´2C%NtWv;r´.HitYlCFU+6yd~C´&xU4hY5L:CJVtZ:Gu[|9IA,´J0>g/o{BW!uWa!d|^oDt)H:5J*!4NGnbzZKG~G$BfAKS$okUGAPqHt1:Di4b}C>GHH)kOSh=|+Rw(n4u*E0W)ErV_)qX´C}Q:S*[yWv<h+kATl+>Q´a|J7:1`E3AmOKyisSDDABt`~AtO^{N5Rx(YXjMkuyP0(!AhF1%9M4+Btjn$A<sBAKyoAfTeacDF!jGDA[olX.KAE!C8M4+blwwl_jAkGfJVJE7OZoIT]@Y+AXLAA(,Fe4by}ZLJ`[:3A3xck1u`RNF6´4AHiBtD<ga1[n/tWd~U|J!GJk_R´Nc]md~^/VMW2+m=WG´gGkURNWe1[,C`XemZBIAMD6k9L:C9WfD0K4A7B{{q_KC&T*hO/s?h$VETJ@cbjdVzHHDZFG!:/6y(,$A9Wjn9uEaX4.u4B:CXL(hQ`{;(´}`iJ_)/^(,x(ay*yY[|Q0O+>5<.e9vNGE´%LMCJFwALBGA4(Y4|LwA%BHtI2AAkHwtF´}Q#TWEcs[WAAk6qCE8IAccSR4A6B"
Data "gtJ)YLVc4:qEm>lFoI,D{EqSXBV5e@GOxW@(xW3AAG^uh?@Ag$EuFBRtCxmuhwAH:5@vrCe33L8yW?/XUEx9y*{ehBB4H,´~Lc1t>E8(&):C`T3[$yTP@B8M|wNM+W=FFDcM7@]q4b8yy(siUE,zBO@CTHdE)aIunLeC^91IzXoBjAQwBt<sQ^&n,MOAZu:&VEnB>WOAUzhzcjbH:CBD8MCAvkQt%7.huZtFGMZ;(E2WjuZR&o$FaAm_qbBSHjckoY6SIL9c/ISUCkM<´a^tz_B$uBbcTXe%iDLQuCGp#T6y+pdRC&fBx/6KM,K`nU+h2KfNn?OYwB<s3xeSUYEl*h^aT@M5JLCEg@DTNslE*aUA,W[Qgx:eT*Q´/[|h!I&6NJ/1E/ejV36!K´rSHdy{C7´DgA/N4+{(zvIA:C!TQ+K]NtK´[<1[%tT:8LRt+W0$3G9@h#XLyQ`}CTCdPK6k641Af$ZH;I+WZlhA2WtA;I9FGalBss&^xh3^D0|78&C6yVYAH´dZLeqC=B4Af´Ct/huWtHYAPM*W+(l_7![9´BcA&tYL,DhB}´D)>´LAfv:&k8`>2[bA!´qSN/DrNZZ1/`=J6ruifilpOc|;=HnuXYTw+h.wX`>s7`EAyiUGt@q%vPw+yi0kzi´CRj6CxBC344GAaLWhcOx1+^Gt7&a|>k~CeR]AnDthvH3M;vw*[(_9,*GA,LnejH{esh}BXYpj2hX3vB/NUUSnGA+Ht0>tkG5F{u5b#|=C2F,JlB8<WclS1X}Ics!W?t?GqcF!d4EBRfi~R~X@#/B$dt=(Jo{JwgC<_´QJ@RH=2zH5XArZd19Fni^)oI!Q)|{{F~B´Yj^)&`kA;A)A{C^Xjne6nUSVyervK[,Ws&xByCAD#fJ$eG51d´rCdBfEG+!ML9BtqBV=eG,[eAeGgH%dVGx5#FJpg[UsndfH?CR9=´"
Data ":6[4nQmA(LKW`y$D[W)(g4qB!MzJ1fF!i/C´nbp´ZKAVSqS´NNBA3[VH`hQAlJKGSEBj+C{Q{ANRKCC9EAOOoEI´^(AAkEuWaS)IBt,DsAltCt8>@DGeRFOC1R6C^P8<HBnb*B}H3rCCxFAA6uTHiB2a)tZlyKUXDvP>zFJFCR_)XL/w4iHM8C{x(v&6a;GzV+VjaXt/aiSJ1EYicjuWqCKL´&I7FA88oUDiEkSAFBJF<vNA$g~*eJ<C3vwcI!pm/1T|X~(0!eC6kiwNt<fDFR[FlBYqPGeK!yRR2?WBkEoYFzS´WY{~!?o13BPLkANUKM5}7L{´Z>z1wUz8#3Mc6´>)zwWod]0)h´MfSA!)aLuWo_#w%f95Rw+Aq´%5aFUKHuXXnAG´~Y@J<C~AUs/v4ZY4^?.h+WNJ1LOGk+/hDtAActy9{|b]{tw(miC´bE8<GBo}~(*hY4L7UE_EFBGu~(+>[Q*hUEeGFBBt[(*h]QMcldr@Z!:´$P|L1U%5,TR´(M8qRE<vvN8}I3,kbXOUne8FjEph!I=oPCqBd7%97AHBPzYAPN>Cznll.uoi@@aL/oaBwU4[KC!~7;BEq´a´YB7P=;Wl&d7LK´ymF!YHQJV0´C*/5/dX]qybOSGOQXWBy/dX_qCbV>{)wviZqCGOuGbfDV=/_X{X5L|B1Wy4cH[9it0XNDlHx8GWLPI´/(>GgFM8{PMy9FxAu?B$,dggZJrkF´2_<´cL.P5Bl%k+lnNIF!WtDj4$<2KhcYa´T+c[.ILFGRdJqBpp!PnBIu:C*>p`dS9[]XlNZNVE>bWuOFmuD<$y3HBtMc(5IBgH8)WtCNB@kPkAmg8MvDVEkUmglo)XX%Ite_?Q8,_BCLKCq1L*)6gMR/LD;QfzuG7X,HknJ*,+;3ct)FIAIATB._@wYBRt,C!WE5_|CtFAt3ZRpPNAaCIAtBE~.I"
Data "T|K?7´d@sFQAIduX@{!y,qE0z/7:[oUqiAKM=eA~>!EMDzai?y$#&AQ$#E6:~8GGijFO=KFBa4$/tvJRBtFUwcM)}Y3Dc41>MCLHhh[LBtnF+>fA1hmB9JHt1y![Nj+A´eiBlS@W=P&y[l^PSW/YpZ9F.eEYo}V+CAvW0FRt%XJCX|Et`T_w´>BSlFpAuq)X9D´sLCCt.yq(_h;HtEog)HB0T@:O!zso#FdtfNEHUYstE)r/JqTK%AZBE<L1*F}[sPvW3xVX2hQ^iLBN<Mc4CEDvuKb#kny|1Z4VGABB.ABtpEZAxt!ZZl$B^(_W´;6lPmUkL4d´okLU#_[Y2T%t_=D_{i3AfABBe.fGr^CwWtAA4suwx?%Fv(`_1QdMxdaFSqv(WLk_BtHAeAdByKk_BtHAy_BtHAAApVMAMcxdMAv(UEMcFBz3~(C´sI{eLCPjwAB9´QN/XEUEGB&aYA<<yI+>MCgAY4|Ed~wAE02RAA1BGA/(uW0bwAu2!Ag)u4AA29nNk_Y4tbK&LPyKhBx[eD%a9hf~2_9ueNzfC´[u6x+Y>zeH=//pG$7V;aP´,xKFtJoIvJG>8e(5V%mxP´yA5B,L90ZE:oi5PJYAJBAAvvr1]IovD´EK=/#NxS:@YLV´XL$PvnriwJS>QCXb~AAkAA:CldaAm0HyWoUB6KrP`QF$20hAHA%k?huS60sPIA{C3D9B{BC´BAtYuLUAy&N.NA!0CFC´[AxBqSWz@70ob8kt`*;PA@@QNQsAgBAASa(aMb~Ccrv<*A[OW0TAvivxsg%*FTAAv(LtGvq9|v{7W3dJAAmm9A#T]I14dTxS[Lj^;m51Bt?jknMR#0)7{o?AS9:mN/H´N/@AZ9vn$z^IV,oI8!@+BA[=lnvW5jePVKAA`xs´}dUuABPuiLePe+6x9jAAHPJA%S^+Uj{ixWmG[9`I?O0(K`FXFA"
Data "gA=JltFB9BeuUq[QjnUErHCAGObHFBECYA~FAAoAEt3k,hDHSAuW43#TfLKCxF>G:,jHC´OA|9Dt2[*h,7=AjLN´Z4+hNpoI2WU)EAYAlBGOAAKC#TAAD´NX)8Qn&Gnjyx#B[N~rk7_oJr8*@3MI@Q´L8wYi%58=`Es0W$TNbt.oXP5ts]kC?ITXax{o)z$JfGi´FfS[u_GOBvsPgd3oIJ`EAA=g0E!R:R1f]xutCf6KBtbY;(v(@AXEv(VBdL,LVEKAai(a]hNDFav(HHX9s<,axArf/,gi7FyD_)8MMO3OfxTA`_<a*iOI+X_)SSA]t<jEAAM]kEajeM`Ke+7bis/LoEpAX%|a$jOQgpe+RhLB5OtEOA|_tEKk´S}R(,umCsGXxxlAXUxEiklV8l(,;rv`e?zEBA;LL.>k}aGnN/H3D~%/!xXAwfT.3l?j{Hh=V[TpVG@EnAQlpb8nvx/e1[2eS?1fWF6A,cfF[q2:wp/`D(SPXlyFXL$AAA:(gw+,kAV%,,QitD#cv(fHS8&q.,bDoo[>?}[jNRAF]Q#3{R21QB~@bAtx^@RR2vCV*hfFqrX^^@fAsE_@VR{veBqiEGzgH{rN4Aq&ffO.iw}a1A@+}a+jSQboe+)gl^iwrE5A0t4EElia!fN/J1Q&0AevYAxLevzSy67S0kXb%mbtevcAy4ev3S]6qV0k|bfsaA9XBtxLfv7SX7+BZl8c}xbtIke´Vf@YCTU!AD~l2imHA%@YGAX<@YGT0!:F~lbjEN´TNkS´O3$N+T**CVGo.y4hY~+>F´PA!A`~HAfAhB]KT|v(HAfAhBZFfAhB]KoIAA"


Decoder

Code: Select all

#include "Test.bas"

Function Base91Decode(sString as String) 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)) As String
   For i = 0 To UBound(aChr) - 1
      aChr(i) = Mid(sString, i + 1, 1)
   Next
   
   For i = 0 To UBound(aChr) - 1
      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 Not (n > 7)
            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)
   EndIf

   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 ulong iLines, bCompressed, iFileSize, iCompressedSize
Dim as String sBaseType

Restore __ufmoddll:
Read iLines
Read bCompressed
Read iFileSize
Read iCompressedSize
Read sBaseType
Dim as String sBase91, aB91(1)
For i as uShort = 0 to iLines - 1
   Read aB91(0)
   sBase91 &= aB91(0)
Next
Dim as UByte Ptr aBinary = Base91Decode(sBase91)

Dim as long iFileNum = FreeFile
Open CurDir & "\ufmod.dll" For Binary As #iFileNum

If bCompressed Then
   #define COMPRESSION_FORMAT_LZNT1 1
   Dim as any Ptr hLib = Dylibload("Ntdll.dll")
   dim pRtlDecompressBuffer as Function _
                     (Byval CompressionFormat as UShort, _
                      Byval UncompressedBuffer as Ubyte ptr, _
                      Byval UncompressedBufferSize as ULong, _
                      Byval CompressedBuffer as UByte Ptr, _
                      Byval CompressedBufferSize as ULong, _
                      Byval FinalUncompressedSize as ULong ptr) as Ulong
   pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer

   Dim as UByte aDecompress(0 to iFileSize)
   Dim as ULong iUSize
   Dim as Ulong iReturn = pRtlDecompressBuffer( COMPRESSION_FORMAT_LZNT1, _
                                                @aDecompress(0), _
                                                iFileSize, _
                                                aBinary, _
                                                iCompressedSize, _
                                                @iUSize)
   Dylibfree(hLib)
   ? Hex(iReturn)
   
   Put #iFileNum, 0, aDecompress()
Else
   Put #iFileNum, 0, aBinary[0], iFileSize   
EndIf

Close
? "Done"
Sleep


The decompression doesn't work (error code 0xC000000D) which is wrong parameter. Any clue what's wrong?

If the source is not compressed than it doesn't work either. Seems still a problem with the Base91 decode function!
Last edited by UEZ on Feb 04, 2018 23:54, edited 1 time in total.
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 04, 2018 23:53

Here the non compressed base91 file.

Test.bas

Code: Select all

'Generated by *FB File2Bas Code Generator v0.70 build 2018-02-04 beta by UEZ*

__ufmoddll:
Data 13,0,9728,7686,"Base91"
Data "´/!MKCAAC´AAAAA´PAjnBAAAAAAAlBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAC´MAAAh|h9DAbbworny(J[cc<P1oht0=(.MIVTlx.,;ms5>vb,|L7U4tM.kL{qdH)<{Y;RxSHX9MAAAAAAAAt)´}AVv5&*e@,zjK+/??Gbw+dx@ko!HUqjXXoSV<DK&RuMV2!:nWFJYzKbg]%hxx6+yNF6RTh#e@,zRAAAAAAAAArHBAi65F*h@R(dCAAAAAAAAAcAnu(L:CAANBAA[9EAAAAA0k9BAABtAAAAYAAAAA5FBtAAAABAuWAAAAAAAA$AAAAAAAAAC´BABtAAAAAABtAAAAAA:CAAgAAAAAIAC´AAAAAAC´AAAA{+AA$wAAv(tIAAdBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXA#TDAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAjnBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAjn%g9_yCAA4YyAAA5FAAuWDAAAIAAAAAAAAAAAAAAAAABA*hNzef=[MCBt{EAAAAMAAAQAAAJVAAAAAAAAAAAAAAAAlBAAwg;Hr%wAAA!2.AAA:CAAAAAAAAAAAAAAAAAAAAAAAAuWAA|;No?ic=YABtUAAAv(FAAABAAAtBAAAAAAAAAAAAAAAAIA:CBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
Data "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABtAAEA~FrABt08AAEA$AGuIA(n|CuWrLCAog(A;v`XAAq1IAhtGDuWGWCAzPCwpBaN6FXL%n[>MvRA{!&BtM@/it4imuJAIA%tXL0(zA>C<ckUmni´.BISKCRj&WXC&W.wQ2m/<vwcdR)Nt/Fa<j>APR?fVCuWXi+FMJ(J;f|9M$bXaS%A;vvGaE5FnIFmX;!F.h:*ZE5FZeX)EC=*7P.?xP5FOHJtaIgLn?Z`xP5FOv=ff~#)sLuWr(7FwA}4#(&Jn;1z!rR8D}iQMAj#bRfB0+GRpC$iu+jNf_=8^QF5o|ED`)N´S05%yrRE*W[D_)H;~h>*w!c/xBT|f.qP´´BAOc#$z:9m(hOJYA´yOu`eKCGA)MJD1)PBNJgAAAmmZlMcLANAAA0k]~LtKC5Fi}]f.oRIGAiGtuNZ4L.c0)QzUOBuC´TH%8^BrOhYb]&HptBA#~sLVEXLPVR8Be^!C:qP#;h&@ShhHvBAq*6AHd,AnVGE5FAAwGe(vB&IBXBt4w7`9F*[aS+hA6J0NL]GsVxNlB^J+>B´haTA754w@G.Pu*iAP/FtF5;_B´4F&&~H$Bc8LvDAA´%ab!uBIC:CAAKv)FXL(3^~B´*]*]#}RKf~~WoIuWQIZiBtT3KCQc=huKJZ$}`GF5LvtsQAAAK:Jj2[MC;vvHXJ]oE4J;B84atLuWcIbiBtcE>GwBn}qCgI8FBt/=B^uP"
Data ".YwR]m1xFjTsOGqcVMZB^J=vPa6?9a+fSYg[Ewsp{QDok|BAHHs4*BLO0AgAmu3~V{>D?(AA>~WcKC5FqB5?0_e[J*,/t&=CAAl`VeOO~~=C=CAA3r~IWA~xFYAA$AoI]Gi~>*´i.haE5FpSou.Wa{N2`e´CGAB*TLKJBAXLerL7Ps@{o4#FI~E[&H[tBA.uR9]bm9_u_+JA(nh8`egADAzD?2?Lw:RYmFI}_B.hC´njG(|#g?jG2B,uR9rAnCAAXL1(eGLBi6ZpB8Eu?C5F2PwWit:NK*XR,7Wc@9AAGA$}}t@QBt;,_GFCp*cGa!`C9}.=lGzYbP2t0EdiCtP;y~stsIuWr()awAr?&H`tBA]ww?+LK]NzoQ[Xs(qIwAqiX%jAAA1hnvFA)|&p$,LgU9Ie,4nB:CTGy!IAqRu]spn|_B_hC´&iMDB^ZvP2SX]B@9qCMA4IDLHAfP+e9uJAvbSRd[7(X*ZE5FH7gB[n+H:CkB5F$F/JlRAAl5&BXLGElBAA1jh8H~SQIAB*T|$efN6FXLV(}2{)ZE5F<r$44AAAcIlBAA5/b@m=[X´FBAuWY&H(/N*;Hm~wRfSGfG/cC]{qStUBk#~rit4TIYO?)=6DAAZ/0B@9o/3xpF´!xEpF{wT5^)g3?L8IV[[1mL!OggYAo4+XD)nB;v2VGw{[4{B´WL,lfyiOjM@LxbsY3x~9DB[~7ABtSJdsWhr|VG*CF*RKZ!sFHu[?2(I.RFJ*s[.s@´gsWPC~/M~Vh/[GAANJt_D.GuiLfoDA+>H`HODn}AtZ1sC=rcA4B´tWWhph[BAuC´kM<7{JWA,H(uJC*+zc|e>w,{3xHLvngSKIdiBtYQ5FAA8MEgz0S*DgPCJ(d~BAmOKy´`8^K7z_PA+>IX/~%CBtAA3XN|5b.o=~;c?~#Ajn9GNvBA{hiWoUGJLF0n,7VKwEv>vUY)"
Data "q1iEvd=~[ME9_m=4|DCAwW|)sB)BHB.c~BBA|>hPWqmCoaTrGUeES!uW>]QhoJI´/IVw/.O5VN$SP;69rs.`D44]&6bRlYNwcR(+FBlBScFB$Mtt`EAw9BwPvt2x`odB7L5LZwwbP51Hx#.@`QQztEml0o@Js@ck;Un?@b+rM@L4|}:C2W$ADeB89Av(}WBeB8OAvH9/V3VRAP{PAy;u]sL?rBAAU0|HrYcP@@(C@wSM&i`hSIz´>FP5GVtPWM%<>;,VyMQsu^0k%´m{AA[9ySVVzHEC>,´YH;v_X;WIOyr&s=OA~*V){e/pjnX}z#khZG)sL?>AAAUIbiBtBFVLSUS{DCl`h$s?(i8I#1[vJ1´L^:qB5?J?#ej31tJFWwOB´9xF?H%{NYyN1(Y;SXf5bXnAu´#mj)|/>G5~#M6E=oDt:hit[0vLr/wLF+_Gz?ZI{XL*sP@CVw´Lz?a<$11wOoOxYe(,sF(HGZou9YAjKlw4X)H&#QQX:~M`{ci|*.fs(Mp*|(/B</Z(Or}.x_<c^KyW!zSVas9n=(!k{Xdq7?;C.o}_.hz,C7G[t8PTj#6C3KQAcI?)NRuWRJ#ABGi!=vGB^XJ`>GWO>kPC6´I)nPP/dSa)gJuR4UcQsybL+5SD>cFLP|Tq&/LH[I|`}GrY8v^Y^6C:OSPOx)C´q6Kd{)3U58W´MRuWZR+MV+4igc/Lx)ZW3nr~B´kx|n%LMRuW]moF@S3Bs]w!kMtP>EhAp[I<^B[Iu@|]Edh0pkA}Q::1&U=yoyQX+~(M´QRwaYF5rXjM%B)v2IlS[(H&rS+{T|*+?IdhcI%AJ>PGV|s!kMWEHD2xI}ZCa_)VN)$Cui3~K`TyGD?;V*I)4_vwW5;X&=}~B´Zi&lE)J`UyZO=(}@A´u(Lga;8LAA$$6wB9_Cz7a|N7Rw56/Wj5VQym8y*%R@VA|L:(O[_pV#"
Data "G3g|p5EV0<h_NT(JVhBAE$MXlXvkhQnOG(fxAHp&j[k@jc<q&$9{v:NOt(uWvI/C=Dd~ivJi=6!O3Zfw=H00mCi~GXpFt/=nm:rnvT/LQX{~Zc5A{:%My]HDX`*A_&*{lPCwQ)<ssInCF!/MMPC´SC´i]2N?a|>kB|jFisMvA(|~B´UJvwlzY4(AD$y47C(3{~B´mP/YOANX0).o3(3xC!/N2Vv;tn)H*W)yzkQA[~G!?t&W´bi´%N}+0)l2Ael,)1#kAA5Fy^Kh2NHe6etd$Kjr9IsINZ1xg]c3PC/a4*%+a!Y@%rq.Bm_B;Y,_w_l/5tc3X5]:pNW7Tz6KvtmMaV%B=Y0qv7xgTRz:HBXB)7hSMGAAJVF1rvGJ.gd^E*?AjOIiXMo[c4iEF!5c|Gn_Qg?J/n@weZKG)JsnK6o=eMFGE*](%m9MJ*#tl!u_MH/=)Hxu;ss8*OD?tZC`N.HBk}+_MtHFF!wH%oj*&%.>1Z?o*|!(w2;3L3z{u~h$?´z_G´jjjQ;1E/6?Y;L!UM:QMipYlF%tM!=#JtTEsI}FdER`F(PVVpm+LiI}l%/W>8>y9[xw{L=[sI{q2[~tp%sL5.hZfPwLECJZ!MI2Qw_OF56Ds]iA`T2[HtTP4AVo3Y$Zy/(f=&)ps8JREY]I:mM)(NF5$P2qu^{e~AJFsIe4oBM$U8m?O>}C^om)Y#.[uC};eFQ`_GP^Kv)k´%JI>ID8&EC´TBj&,}6qlB;v!~+D$$AABA}7RJTIqAAA(h+t.0oNOxx?6dkteuS0}~AtJ*´2fJSJwH2hQwFA8P0D^veLQEpls]BLQ;o=pDhFl{#/9$lqzE0v||f=ArB9]GzYS3WW{yWBAA1/WcXG{g8MR0dVAOFD=W]`IFr[]Q(C#UnO;+´CAA?jjS!c1q@2$}dVT)9bRJ`V.}9Fj@oUiN0,zKT)=CpSAAeG$B|Y,h"
Data "U3Z{B´rM`Q+kS2#fVkYtAAv(+WLDF5´CDtf´^~$B(U~NWM3;?$_zxGaZJ*o5m?B´AtJ981eCRZYRx/MH2Ps&4GVfJhK~}tbiBt&i]t<[t1eA5FBt2Kn?*(.F1NAA1[3WAAe+}og4=W|jBAjn(_,H;&2B^X!T´~X40M)azl;SgEDAXR@mKGGvhn,Cxe]=y)95Y/Z*xW.tui*>.{viZ´}CQz~?@A`|]#Sx#bkU})t%)X7Fp(0^E*zB[L8Y?xQJd/Q9yhxpV/RM^/´Jjtn;jcBlpD(n3xyD7Pe~s^<L$fQD*G(J__AA@J`(=2lh7)nI=spYLLxRvpD*:vG,~~B´Jmes?tl$qY6PJDce:5ho1qoI)o7}mDvw3T2A9[)4B´CHFYDXzMi![`#Of~f,$H/>RJ4L/Y)kLLee8%iY6L:FxF[JPAAA,H=sWhQcoZ^wX7]~´QaE5F38A5O8qU{{/FY2PNxAF!R6,+R`65r46W@Xn?G!BAuWk/AAY4)XCaf{qP$IGAuiQmwLV=w~B´A3,XAA;v]9BI>F$na]Oh?j6d5=5F&59Wl.@hTBLHIW!w~|TX^BAAJ*N?d!_`4PL`O8C}>DRvBAq*vRl!c/1PfpIuYx>A/AzP<SWF(=W@=%´|SxYXHF~~!y^?]c~NZ){GL,#C<VkUFHt(YCn![a@GC38U,NvFKw´/qMRA.Wi,~~u(5NAO<>3YPLKGsDqez,.HPWvUSJ|i|yshOUlNlDUxvfgEYI*4o$OO}+?{MCAA`~VOuSAAoIpRH´gn>=5ukq^kJc@7UH%Dlp74t/UM*Nh|&HgEDA9fC*AttINC;vH,oNdUe_{vbFtZrzngs1&B,A8I|>hC]qE)Qz{>:O(T{FGH`(6$]#B3~wFGA´´h0IXL;[y{P`m62B´vrS685hxCtV!ZwTN)yf5LLZ,I:NI>RBFRHMjzJDlt</dy_wD5c5~>Et6W"
Data "]|j42B=70tBIh@spFAy[gtsKWmlE(RHMf~xu4*R?=6m5.F:+B´WLiitBAA9~:_|4sMA´tWQ$bV0Yw/x]B$Cujal,;k8}Oobr4b6W62h_J>6KQQ!wWeJ0Z3bB3V1pxB#}.oQ$X5jO1jh5_)Ja2hQc//KCk~z3O/Kt<Bn4KG$HiHkUc|?IUB@oLt_K3B?rY.P´/NtWv;r´.HfW;+´CAAFB:´T)>YL/QM:F_)>vDT.rTB.5=hD6%e$gcwFAK*V?8/TClSlXw2´&/N,MGwtw>t&?bC$okUGAPqcuHJ5/CFkn]A/Y|wRoV3{y/NxIFiwwsZ,hS)DZ!C>D}L?(2PQWV3AkmL4B3b^wZ)luwt_yE?9J/B,/bnOiAA#~B´z!:3u+ET^Kyx`~At3x/BGWfB]mQw7RY48FT|XA1[j#UM%h_PaFuY1XV3>y#CAB_L/YicPcNt^k7L2t%/cJpSk:+xxBBtAAV(iYB]RE(|p]bA/YP#ERd]Htl54AHi6CghL´&E´~WLeWv2zA<sb4/=4}:5s*FzJW´CBAXL.oKtVAa~`~B´9H1[ZKN/{hEk&Ai!Z@vFfXAA:C%=+hKtRn~~WLss6Ai!Z@au<)SB{FAA<cbjdVWEC.K´D<]kdZF!$HTqIo9uEaX4.u4BBA#~xMAt%_A(PBAA7[9($ED%EUqs;?:}B´PQQNi|5LBtwYIA*[]CXL)GCAhZ&AlBkXC´hdIAX7iDXL#HCA9F(Amu2XC´2>IAFR|CXLBPCAPv(A^XMbC´dpIA:y>CXLTDCA$M%A_):XC´<MIA:y>CXLTDCAz()Amu]WC´W2IA:y>CXL;NCA$M%Amu]WC´<MIAWODDXLnT^X(421TBj#j=OEnT^Xh!6/_caSNs3x>SGi^G>m;v1zW?Q]Ht59y*p1TBj#CgAO<~B´M8UtTBj#:gh$oT^Xr<<T(?g4/W>8,#5N<Q2wFBkXV5"
Data "98XB1YWD+mWRKC]+AH{XK*?(ZR]Cl6bAne5J.ik|[C+AeGM?bMpWEI{JMXm>KC%A7nH;W/3DITci´ww?LMBD|;ery:FsuZtFGMZ;(EEs<M}q4C2P!sBzOWJp[?B´MpBf:GdGmHci*C5LAAlB>m7x`MFAC´D<EGgAAAHBH#Eb{mFUq67A|j^4D?3],key0@z|U3x?mh0KwasYFO3Z8)k#;*;1k+XYTWbTpw3ibMNCDw,v8N+P^/El,%/[|h!I&6kUG|zyJ5LY:k5xYHO~Y]/D.o3x´G_o)M3Z*~P`NRxE)kUTkU`hFp^C6U6F7mOYQ%21dDXenAX>oa3HQ:`sB´/Ce3Ca9oT?Q]Ht59!Vv;%leRzts]oc2m>Et/klF!Uz´Abjb?M8%WKtdnr3REU~uz4{vB5FdIBA,BjATXRMBth*IA*[HDXL9RCA!y+A_)<YC´|7IA*[JDXL}SCA1d*AlB^YC´{>IAo4bAWhzrB9k|WEvt8IDiFpxW:e[K*lD(GuiL4YuIe4H{aywQ[El!b|B*!):]K!UM>Q<CvwkGR!V3<@v@rDZRLwX`&g*H/Mv*:_cRtBNCC2@KLV>AM&zTH??Gx/>H.o?(U_eb3As&J|lhi^e*3DIhKGiIk*WY;Ii!s_jS}u*E6yTPZEl!%}hq@H´Gs*q?SJA(6wCuk,3x<sJSxP}O$B/M*hD6Of.C`|DABtuW:D´wwi}QxF,#<UyIfOk_HrB9EBRfi~R~´LAAJVv;l~Q/VqpHvuaL<W:m@w^T)4>]i42P{B|LH=2zH5JK,[UD{q1~´CBAXL.oKt(Wr`@^J}B´4~fDBAXL.oKt^Wr`5.I}B´B+vU^z<)mF{FAA<cbje&9M9,Jt,F&i1_JiiL9M*T=[EA!}sPe4]D,[q)&AcT2up%eL4beZ&JlUE]B´spv=;UsbWA7t6]$Wm:p/IZB´@9O?6<kn]AJF}evH"
Data "VLY8+t^jyn1FF!i/Bt6bz3v=I?iHUjUDXLgQpAAA;oeLgCxuFu)I$t0HB´u(2z:,0GuW$8EA)M6B5Fe+AAN?YAqiGNBt9ZJAiqRCXLYaCAae/AmuOaC´DPJALfUDXLYaCA(T=A_),ZC´DPJA{>iDXLYaCAae/A_),ZC´DPJALfUDXLYaCAae/Amu{aC´DPJAd/cDXLYaCA+´aA&´v={~At,Czv{}B´&zkYd!DGfu8srnpDnTu+Kjg*3D.o#(zHzuuY?ITzit+,9WpC|H88oUDiEkSAN/j´MPJDA|dh+T$:=h)5.H=s#W&e/WV(;~QN9Hv7IS<,.ik|mF(zN/4Lj?jZ^zb;K`Ag<1/_4A0QiwpB?b<}B´U%pN;F}}Y`B´S,?GDOvWsBHf4baP%RzeRfh~,´;3x}kIv%$K]oT=0)fAZBhz:k/B*VN/(´wd%/jNBtF5UH2uf?~4Ni*[sIoUMv3E/#Qj$][|%mkA1/PL#Fbv[Cyu(´~Q=hWEUJ@)7QBAc]lAqifNBt3rJA)keDXLzhCAOC<A^X,aC´5tJAFRfDXLIiCAsI<A^X)aC´BtJA51fDXL/[U$AM.F1Fm#qYi:VctuDDL_RwPhyX}4N]#@UYLcQwxb40H´lL8_w2n(eOfPMOL7%9P)?(&nO^uFsI&B6F.im|7I>`GBUW/oaBwU4[@@v@4mj!%}xA.NK^srWMyZrnoMjA5FBtD<6w2xKaF5YH:k94~|lM0/^y245t+k94:93/Ar(,wdpC)koU*C;4TBiSr=3x/Bzv%M4+@wZ)lu*4!yYy{~WLbCIh:G,or*(%XEBbBAkU=hDv96|)]wn(fLqk6sKvj9bAJFzI5?N9/#sU$WOCxF[#nXAA0k?3R0+e}e=/sX[o,y;>aQIiF]&WUJ~]yf0Ywu/KS3SjsUY)QHm_hbp|IYeF!}VuyFxL[~%G7z$AAA2WWuPy6ClC"
Data "t#CAXjsUT/qtku}P]FAAyK=D,CoJ*LAADHr1iE8%,?fj#92}%an`´(5T3(@M`T=Ix@E<vA]Vv;)EBA*hqC|2nxi%%$S´i%f+Ot2K?n>A0FhtGY<`]D1[tzr|vSaCIAtBE~.IWLgUtJu[b4y7)Lorg+[r,GVYVYot0/Z@3lLL>HBYNv>*SqneDf3]$e,kqu#fNM)+KcT~lBckt*nO[hBFMHDRWG_´aszIlB;v9asB(VBtkB4}LtLATLjn0R&=],|(BLV5AD+kK*x>I~[|jS1XBz%i*tq(NWvw,tN~:CnT5h$AAA(?7P^tH.+W<B$OMh{y_t)hDXau5~iB5!}@f6*´b5XoD34@z.E?i_E/M5fN,k*t#fF)r/JqVsBHyBZ}mBgQBx$Rdx!C]M/Y54/92{Rc7FXLOcBCvX*bd´Z+#Y_]F)GtEA{e^yLC&MI7;G1B?E99AAe<o.UWp:m3amsk)=P)}^Bqs!d´_BXLe.fGr^CwVAh=}V/YB%{r3x__1QdMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA#vBAvDxAC´5IAAuGDASqHBAA8iAAGeMAXLfEAABxBA]qxAv(lRAA`RGAY4QCAA`*AAAAAAuWjEAA4yBAUEyABt5RAA.YGA#TTCAAK+AAAAAAv(YEAAAAAAAAAAMciEAABtBAy:wAAAAAAAAAAAwQZAv(rIAAAAAAAAAAAAAAAAAAAAAAAAN/NCAA~)AA"
Data "VxYABt6IAA{GDA6yHBC´#iAAbfMA*hfEAAPxBALvxAC´%IAAdJDAjnIBAAAAAApVGAT|RCAAk+AAeGZAuW;IAA}MDA[9IBAAAAAAzf2ejaW3X>jTvSq3C9^bTdn<=[[9CtX!7m9j3D$JV<UCBNUEa9WifPmHq@=H7RAAUO37#/$DVo_D;Ik@${L%%/eF/1vWlfD?{)G$<x+hzAo0ZE%XdPzIg,AAck6y=H*Tm0HyWoy,Et:Bf*<!G)CtI´#+$P_o´RXJe,nBUEeZ$PbjIaDgZAMc&(X,ckuS60b]Glr5_1cAoIGtD:_Yt7a.O9WoOP)F`xy(0$Pz@70ob80=b,AAK6i606=!F2@70ob80=b,AAJd>5=dm63+DvKmRBC´X´Gvq9^by5_Fh>8eGAZlknMR#0)7{o=OVKa>P1r%!&=EAABBsQ5pcrcK@32elT1[.>YihPsd][BN<RDva9pZ_Defp@AAoQ#^[j=!~:4b5jePVKAAKC}gX^4{4UQe=EWoLu01f,%dLR20CFC´FBsQ5pcrcKu9N1r%yAjn[M%S^+Uj{iDAAAAAAAAAAAAA[9`I?OBAAAQ@KBBtAAAA.AAA8MAAAA1jAAx9MAC´VCAAoXAARdIAY4`CAA5FBA*hgABt9LAA+uEAk_pBAAnuAA4}yAv({RAADjGAs8WCAAF.AAy6ZA6yCJAAPTDAa]LBAAAABAIAwA:CMcC´BAHAgA0U>#]xcQ>iwJa]!:`N~rk7_oJrB>j@eeKUy:g7@b||+c>[eYMRi.Z4+YErv/Ry&Y>7?#pENpfl}GA(#dqUM6Ly8jH7#c+3[`H6`#obSce5(gp@mC0U9Stwth#D<=f,Mck5vV+[XcAER>a>/pHtHJP]BY!zm<2]weHtHJP]BYt2]I/8|*7%60BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
Data "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABtAA_)AAAApI5(FB^Jy´Lv_Qpt@Dllp`wIe)HHX9s<,abiqExm9BPvXRQwDa8w=?8Io*EQuoVUhx[i)KQ~YAW:/I0+8Y?V57oxujOO?c6=s6=RI1!%B[´R~1`,Uk?VH)uEMkLTD$H{XCLSJ3T]vn]?JJ^.;rv`e?zE1k$Y=S*P<*1S,6XW`o`?j2M;99;hPl=E<m|p](!n$6.T5)DSThbue3:]Zp8[,cfF[q2:x{@:rk>V$|BAEA*hDABtM)qGP1s<,,Ri1Dkd)8]@KR~uJQ5pq`011))Ip,&q/,ei&Exm?r]jRRyv9US>{R41?)DL(~}I;,ri?F!v´alN<R%0´98w)z`1p,#f}:@+}a+jSQbo{5t6]Ra10|jL9)XJK:_0+$f?5EJl:aSjPRdC0S26AT=$OBbJk:T3F^1t7EWl|bfsaA9XdJ2:.4#F=48Efl)c9yvx@*BTQ!8vFY{ivJR<x*7Rs!+xMmLj6L(I[YIT)!E?1.>z@J[?uKxC5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
Data "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"


I cannot see which function doesn't work properly - one or both codecs...
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 05, 2018 12:25

Hi UEZ
If you use the gmpmethod.exe like:

Code: Select all


Process image file or Process text file   i/t? i


dirfiles.txt
GmpMethod.exe
image.txt
mytest.bas
ufmod.dll


Enter filename ? ufmod.dll
Enter Ascii start (or press enter to accept 32) ? 0
Enter number base (or press enter to accept 128)? 91
Length of file  9728
Continue?? y/n
please wait ...
Length readable  11974
file saved as image.txt
 


Then map the image.txt to your base 91 string with

Code: Select all


Dim As String sB
  ' sB = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   sB="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~´" '´ instead of "

dim as ubyte a(len(sb))
 for n as long=0 to len(sb)
    a(n)=sb[n]
next



 #Include "file.bi"
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 save " + filename
    End If
End Sub

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



var s=loadfile ("image.txt")
'trim off the file information
var start="0|91|ufmod.dll|"
print mid(s,1,30)
s=ltrim(s,start)
print mid(s,1,20)
print
for n as long=0 to len(s)-1
    var v=a(s[n])
    s[n]=v
next
print s
sleep
 


I get a completely different base 91 output.
Here is the start:

Code: Select all

EQ.&Ta_5mrQ6TFC:~5XH.Vtf^_I!,1&WvJ}}#q%eb<FLt,|!*!P#xHbEHjFK~L~=grwJ=)c(v┤T(1W$KvN}T&>dmS6TIQw@6#7wIJ8ylLF8Fp3+G1@QK4lfw^b8?!c[!t>Dw}./ix#_&sDk9(J3wpJHH#z0x}
)?YXGPbx^^+aOaz4(950^I|R1_a6o93*[,z]eiBR5S┤8cX?i_7l@9g>b&p[P~_/=CGR*j=u#~u2Bt!Rf>4d4WA3DyW)M9lQPFTO@g?g%p@a!N┤?7d!*3!zxJ}E]T3Win<XZ@Hd%M^k70ud)|uwRN(GegtserL
MT~W[RAg~MN6|(mTgq^4/2RC]<Y,Bt/MDE_A,*d{^NBBGI&N<0G#|kP%/D!7$A<fPnA(qR%9P<CXoggO|Qxv?;Y.m$$|`hjPc).19qyxIf&0Ps5tb|:Z8bS@!R?ENEM8m:m6,M_[R2$82|Ig!a|e5CasRH#Pj
vMY*b_vYOh$OwP(3YQ:2>Weug8z<~G┤msnlMKBjJo]M2m.t}GI=T1`&z~Wr]l`!YHR@PYZ)#aY2VwD<[E:b~;vD8y`~Y%!nM.<o>?`Qxtz]voCj+B(>!2O?#01DMU?TS2#bp~W86~K_%SxhvFQ9XURo=`:lc@
:g4Z%_*91CAN2dS&)s[o*!e!ZU%&%(2h00Lx3┤2%u/}Xq7[6mL*,Zzxn,t,_du2f$XVWGMdv7^lB[6Rzd12r(H(c5KYzs<:*4_+t%`]68B}eVS$b?D*m7c`E}K`]oa#NU`X>2v#27>>P*Db}!GlP/q}[P%+]j
l]Quc7#x1L}<EmC:E:v$g_=F}ez<r}ky~Og;AWOVgo;>>Eg`<*&%`i%Sz|!q6hu]Pf3pL&,Z|EVhx2t{f^q;Vjfm%a5aI3|*H&#_}POX(MfFHX<rNq+!gU;G3D_<`GR~+W0;P9&Hy>}>!G:bhe}Xq8@Qd2&Fw


I tested the ufmod.dll with 64 bits using the same method and I get agreemant there.
UEZ
Posts: 140
Joined: May 05, 2017 19:59
Location: Germany

Re: Best approach to use a DLL

Postby UEZ » Feb 05, 2018 16:52

That's really odd. I tested the Autoit version of the Base91 codec and it works properly (encoding and decoding).

I need to check once again what's wrong with the FB version!

Base64 works as expected.
dodicat
Posts: 4764
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Best approach to use a DLL

Postby dodicat » Feb 05, 2018 17:59

Is your base91 conversion a pseudo change of base? ... and not a true mathematical change of base.

I don't know a base change algo where you run along the input string at base 256 and create another base more or less, on the fly.
But of course, I could be wrong.

Here is FreeBASIC from the web
https://www.dcode.fr/base-91-encoding
it is
lzmf#ucS]5h
But mine is
hh)Kz}z|L4|

I have been trying to tweak yours it with no luck yet.
I see a C version here
http://base91.sourceforge.net/

Aside:
Here are my encode64 and decode64 using only strings (no need to worry about sizes, they sort themselves out).

Code: Select all

Declare Function CryptBinaryToString Lib "Crypt32"Alias "CryptBinaryToStringA"(As zstring Ptr,As Long,As Long,As zstring Ptr,As Long Ptr) As Long

Declare Function CryptStringToBinary Lib "Crypt32"Alias "CryptStringToBinaryA"(As zstring Ptr,As Long,As Long,As Byte Ptr,As Long Ptr,As Long,As Long Ptr) As Long


Function Base64Decode(s As String) As string
    Dim As Long  Length = Len(s)
    'print "in ";len(s)
    static As ubyte b()
    redim b(length)
    CryptStringToBinary( (s),Length,1,@b(0),@Length,0, 0)
    dim as string result=string(length+1,0)
    for n as long=0 to length
        result[n]=b(n)
        next
    Function=result
    'print "out ";len(result)
End Function   

Function Base64Encode(p As String ) As string
    Dim As Long L=Len(p)*2
    static As ubyte  s()
    redim s(L)
   CryptBinaryToString(Strptr(p),Len(p),1,@s(0),@L)
    Function=*cast(zstring ptr,@s(0))
End Function

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 2 guests