FB File2Bas Code Generator v1.01 build 2020-05-25 beta [Windows only]

User projects written in or related to FreeBASIC.
Post Reply
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

FB File2Bas Code Generator v1.01 build 2020-05-25 beta [Windows only]

Post by UEZ »

As you might have seen I'm using embedded base91 strings from time to time to embed files into the compiled executable which was converted by my AutoIt script.

BasicCoder2 proposed to see the code in this forum, so I converted my AutoIt script to FB.

This code uses heavily the WinAPI thus Windows only.

Just drag'n'drop files to the GUI. Press rmb on the GUI to change settings.

Source code: FB File2Bas Code Generator.bas (too long to post it here!)

TitchySID v2.bi (required for FB File2Bas Code Generator.bas)

Code: Select all

'TitchySID v2.0
'Coded by UEZ build 2019-03-28
'x86 aka 32-Bit only!!!
'Thanks To wakillon For finding the DLL And publishing it (https://www.autoitscript.com/forum/topic/169098-chiptunes-players/)
'DLL coded by StatMat -> https://forum.tuts4you.com/topic/16644-new-sid-player-in-masm-titchysid/

#Include "file.bi"
#Include "windows.bi"

#ifdef __FB_64BIT__
    MessageBox(NULL, "This code cannot run in 64-bit mode because TitchySID.dll is x86 only! - SORRY.", "ERROR", MB_OK or MB_ICONSTOP)
    End
#endif

#Define __SID_MEMORY 1
#Define __SID_NON_DEFAULT 2


Declare Function __Base91Decode(sString As String, Byref iBase91Len As Ulong) As Ubyte Ptr
Declare Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr
Declare Function BinaryMidToString(pBinary As Ubyte Ptr, iStart As Ulong, iCount As Ulong, iLen As Ulong) As String
Declare Function BinaryMidToInteger(pBinary As Ubyte Ptr, iStart As Ulong, iCount As Ulong, iLen As Ulong) As Integer


Type __tagSIDInfo
   MagicID As String
   Version As Word
   DataOffset As Word
   LoadAddress As Word
   InitAddress As Word
   PlayAddress As Word
   SongsCount As Word
   StartSong As Word
   Speed As DWord
   Name As String
   Author As String
   Copyright As String
   Flags as Word
End Type

Dim Shared As Any Ptr __hLibTitchySID
Dim Shared As Boolean __bStartup_TitchySID = False
Dim Shared as __tagSIDInfo __SID

Dim Shared __SIDOpen As Function(Byval As Byte Ptr, Byval As Integer, Byval As Integer, Byval As Integer, Byval As Integer) As Integer
Dim Shared __SIDStop As Function() As Integer
Dim Shared __SIDClose As Function() As Integer
Dim Shared __SIDPause As Function() As Integer
Dim Shared __SIDResume As Function() As Integer
Dim Shared __SIDChangeSong As Function(Byval As Integer) As Integer

Type __TitchySID
    Declare Constructor(sFile As String = Curdir & "\TitchySID.dll")
    Declare Destructor()
    'methods
    Declare Function Startup(sFile As String = Curdir & "\TitchySID.dll") As Integer
    Declare Function Open(sFile As String, iSubsong As Integer = 0) As Integer
    Declare Function Close() As Integer
    Declare Function Stop() As Integer
    Declare Function Pause() As Integer
    Declare Function Resume() As Integer
    Declare Function ChangeSong(iSubSong As Integer) As Integer
    Declare Function GetInformation(pBinary As Ubyte Ptr, iLen As Uinteger) As __tagSIDInfo
    Private:
    Declare Function DLLCreate(sPath as String = Curdir & "\TitchySID.dll") as UByte
    'properties
    as Integer dummy
end type

Constructor __TitchySID(sFile As String = Curdir & "\TitchySID.dll")
    This.Startup(sFile)
End Constructor

Destructor __TitchySID()
    Dylibfree(__hLibTitchySID)
End Destructor

Function __TitchySID.GetInformation(pBinary As Ubyte Ptr, iLen As Uinteger) As __tagSIDInfo
   Dim As __tagSIDInfo SIDInfo
   SIDInfo.MagicID = BinaryMidToString(@pBinary[0], 0, 4, iLen)
   SIDInfo.Version = BinaryMidToInteger(@pBinary[0], 4, 2, iLen)
   SIDInfo.DataOffset = BinaryMidToInteger(@pBinary[0], 6, 2, iLen)
   SIDInfo.LoadAddress = BinaryMidToInteger(@pBinary[0], 8, 2, iLen)
   SIDInfo.InitAddress = BinaryMidToInteger(@pBinary[0], &h0A, 2, iLen)
   SIDInfo.PlayAddress = BinaryMidToInteger(@pBinary[0], &h0C, 2, iLen)
   SIDInfo.SongsCount = BinaryMidToInteger(@pBinary[0], &h0E, 2, iLen)
   SIDInfo.StartSong = BinaryMidToInteger(@pBinary[0], &h10, 2, iLen)
   SIDInfo.Speed = BinaryMidToInteger(@pBinary[0], &h12, 4, iLen)
   SIDInfo.Name = BinaryMidToString(@pBinary[0], &h16, &h20, iLen)
   SIDInfo.Author = BinaryMidToString(@pBinary[0], &h36, &h20, iLen)
   SIDInfo.Copyright = BinaryMidToString(@pBinary[0], &h56, &h20, iLen) 
   If SIDInfo.Version > 1 Then SIDInfo.Flags = BinaryMidToInteger(@pBinary[0], &h76, 2, iLen)
  Return SIDInfo
End Function

Function  __TitchySID.Startup(sFile As String = Curdir & "\TitchySID.dll") As Integer
   If Fileexists(sFile) = 0 Then This.DLLCreate(sFile)
   __hLibTitchySID = Dylibload(sFile)
   __bStartup_TitchySID = true
   __SIDOpen = Dylibsymbol(__hLibTitchySID, "SIDOpen")
   __SIDStop = Dylibsymbol(__hLibTitchySID, "SIDStop")
   __SIDClose = Dylibsymbol(__hLibTitchySID, "SIDClose") 
   __SIDPause = Dylibsymbol(__hLibTitchySID, "SIDPause") 
   __SIDResume = Dylibsymbol(__hLibTitchySID, "SIDResume") 
   __SIDChangeSong = Dylibsymbol(__hLibTitchySID, "SIDChangeSong")
   Return 1
end function

Function __TitchySID.Open(sFile As String, iSubsong As Integer = 0) As Integer
    If __bStartup_TitchySID = False Then Return 0
    If Fileexists(sFile) = 0 Then Return 0
    Dim As Integer iLen = Filelen(sFile), iResult
    Dim As Ubyte aBuffer(0 To iLen - 1)
    Dim As Long hFile = Freefile()
    ..Open sFile For Binary As #hFile 
    iResult = Get(#hFile, 0, aBuffer())
    ..Close #hFile
    __SID = This.GetInformation(@aBuffer(0), iLen - 1)
    Return __SIDOpen(@aBuffer(0), iLen, __SID_MEMORY, __SID_NON_DEFAULT, iSubsong)
End Function

Function __TitchySID.Stop() As Integer
   Return __SIDStop()
End Function

Function __TitchySID.Close() As Integer
   Return __SIDClose()
End Function

Function __TitchySID.Pause() As Integer
   Return __SIDPause()
End Function

Function __TitchySID.Resume() As Integer
   Return __SIDResume()
End Function

Function __TitchySID.ChangeSong(iSubSong As Integer) As Integer
   Return __SIDChangeSong(iSubSong)
End Function

Function BinaryMidToString(pBinary As Ubyte Ptr, iStart As Ulong, iCount As Ulong, iLen As Ulong) As String
   Dim As String sString
   Dim As Integer iEnd = iStart + iCount - 1
   iEnd = Iif(iStart + iEnd > iLen, iLen - iStart, iEnd)
   For i As Ulong = iStart To iEnd
      If pBinary[i] = 0 Then Exit For
      sString &= Chr(pBinary[i])
   Next
   Return sString
End Function

Function BinaryMidToInteger(pBinary As Ubyte Ptr, iStart As Ulong, iCount As Ulong, iLen As Ulong) As Integer
   Dim As Integer iInteger, iEnd = iStart + iCount - 1
   Dim As String sString
   iEnd = Iif(iStart + iEnd > iLen, iLen - iStart, iEnd)
   For i As Ulong = iStart To iEnd
      sString &= Hex(pBinary[i], 2)
   Next
   Return Cint("&h" & sString)
End Function

Function __TitchySID.DLLCreate(sPath as String = Curdir & "\TitchySID.dll") as UByte
	Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
	Dim As String sBaseType, sBase91, aB91(1)
	Restore __TitchySIDdll:
	Read iLines
	Read bCompressed
	Read iFileSize
	Read iCompressedSize
	Read sBaseType
	For i As Ushort = 0 To iLines - 1
	   Read aB91(0)
	   sBase91 &= aB91(0)
	Next

	Dim As Ulong l 
	Dim As Ubyte Ptr aBinary = __Base91Decode(sBase91, l)
	Dim As Boolean bError = False
	If bCompressed Then 
		If iCompressedSize <> l Then bError = TRUE
	Else
		If iFileSize <> l Then bError = TRUE
	Endif
	If bError <> False Then 
		? "Something went wrong"
		End
	End If
	
	Dim As Long hFile = Freefile()
	..Open sPath For Binary Access Write As #hFile

	If bCompressed Then
        Dim as UByte Ptr aBinaryC = _WinAPI_LZNTDecompress(aBinary, iFileSize, iCompressedSize)
        Put #hFile, 0, aBinaryC[0], iFileSize
        ..Close #hFile
        Deallocate (aBinaryC)
    Else
        Put #hFile, 0, aBinary[0], iFileSize
        ..Close #hFile
	Endif
    aBinary = 0
    Return 1   
End Function

Function __Base91Decode(sString As String, Byref iBase91Len As Ulong) 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
    iBase91Len = Len(sDecoded)

    'workaround for multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To Len(sDecoded))
    Redim aReturn(0 To Len(sDecoded)) As Ubyte
      
    For i = 0 To iBase91Len - 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

Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr
   '#Define COMPRESSION_FORMAT_LZNT1 2
   
   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 Ptr pDecompress = Allocate(iFileSize)
   Dim As Ulong iUSize
   Dim As Ulong iReturn = pRtlDecompressBuffer(COMPRESSION_FORMAT_LZNT1, _
                                    pDecompress, _
                                    iFileSize, _
                                    aBinary, _
                                    iCompressedSize, _
                                    @iUSize)
   Dylibfree(hLib)
   Return pDecompress
End Function

'Generated by FB File2Bas Code Generator v0.75 build 2018-02-22 beta by UEZ
__TitchySIDdll:
Data 7,1,5632,5017,"Base91"
Data "B´.ztL[QAAAAEAAA=~kBC´LAAAAAAAXLAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA$AAA))?odAemQ2)tbAh2WXg#c.mBWo^Uzg_<1RLRc%]xlLNP>v2]mCsS4t*[ad_k.Jc,O:aC#yAAAAAAAA,7IA@Q:hAAAAAAAAAAAAAAAAcAcx(L$APA$AAA5FAAAAyA*hXSAA*hGAAAPBAAAA:CuWAAC´AAXLAAAAAAAAgAAAAAAAAA*hDAAABAAAAAuWAAAAAAlBAAQAAAAAEABtAAAAAAC´AAAAnXNA*hAAAAy:AA=BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA^H1AoIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAxdwDARAAAAAASCAAlBAAAAAAC´AAAAAAAAAAAAAAAAC´AAK&Wc.wBAAAAA$AAA@QDAuWCAAAEAAAAAAAAAAAAAAAAACA+>{t+0MAAAAA:CAAC´aAAABAAA*BAAAAAAAAAAAAAAAAQAAA.*JU1A(DFf`k/tDHY<oKn@}&e$J2YAJ1OAAA5FAAPHAAz~C|B´`POsJ*o$R;rzREC´{C%aBtC/f]h$kG++WL/~6~[SsI`FSV[(BmstZ.V8bc8AJh_(7]^%s(&D@2?tjGq!]Qb|[tnF%dgzP=ELb?c/it>Mp/FBn}TsBI7RPDaG84kMZLNDkH+$fwa_B´LJ8M1L~WdSS)ay>R@}f+u/1u!|1~´8/ic%}dBR+C=C9DJoBAC>b$Tkj3B=cLqY=k4PY;WpZx+~K(´~´KWqC´nW/=KCy9G5rj>C^CdPz<I.V!in^};_*L3^[AC´N´Sr(_).tN"
Data "C´sL`{X=*>R^VaLBV*+_l!cES1,(;3O<@sGDQ9abJZe:fB#LJ`^P1L}Y>kc=1^Vq7xkBQ)z{uY$gW|f?A´v}?hC+rU+BDHm#:st`*h>A,DW!g}z|/X/{zW%y]!:C5lh)6}3xq!ipin8/8#1aV~}jAsy|/Pi4[U2$n}#5?N9~/%PW=[g/ts%/W/A&~mshGB+/UKF(~r`zG31=KmCv`BfIy9Aw%I!LY~2;yx#:!B8t:KHT9]rcc#FBekcZ|^RAbOaOOUdfdCaX(:SN3=C$jc$~F@*7U]1z)~C>{;1JLANyBtn:AtaDzvhgk1bW@$A´w^#hr!mump}${{`e´GB^XElUrIU#{=:/]vGHfzn4D.iMi|JVca_X3nm?C$(${IWd9xqn:/lF6<=^W1c`^n+A%eoOxKb`I4h[Y$eGw]9hyB!.13TW`zCBKxCC%Uso03z:h)f~psyxWD@:3AY}mQF%EA(oJ9Q$?0W´<r)9Gt^Gm}4~E[{hcgk_eDaO2WN<FW$AZ~pUQs;T/,kFzd=saR5$P&Cq6cR)sv%NKhznJSq_d$inOf?GkG&B´1@9n.!Gaj&Q*th>>QmK}T^Xg6*/9~ov2YnIRsc=;MnDKjIPw(0xTiJY5Pnm~G?x~CnK<PSx9J7X|?X<gO6SZ8_Coa%~t{4=^*&@((^0´~.e}uRAum)pfeot5L7;;Rfs5X!´t}g:),(hLvXrKGNkW1G<c{cn!oNnC]zwwi_%E`D6Ci$4Ze]]9kqiXr:iQ9Rd,Teoy:$t)IV/B/^~i?4C,A:ErClymuJOLZnt4K;5sG=T+^GhHFCI$hibXb0I=xA^i42Bb=@%kB(J|LSjxnw1aL:>TB1T0lGj9QdtqdXLLD7QEka9vz[uQa55WUB(Ann;4#S0!F]m)$%To9~s2x1k"
Data "|>:(rX:I9%E´lPWmUDih.tFA7(k~2$E19(<`!b;CWc~:RX+>hsu}I>NORftuf$lT~´_Wn?f~*>$gypQWGD´B+yCBW%WXT@W<]%Q2:B`pfM$Hes0ciiO(%hCBPBIwnXHH$p2xyJOcuZo[8yFqZUZaD)@:z?N]XfS9yGll}(OZ:pB_EBf#`[KHm$DkxWeYm%~q&f2{je[ied;1o=YkX1=F:_[c:>+x8^$m*(`%<gsG,$30/4kiH!j+z4nF5Dce!P2$KUEs$>´Wt!=%S<MIlg/M_^IISoc9&3(FVVE{84oy*$06pBB;MuqS*x{l]vwx]Jc@3uh9W[Xol}sy{jnEw+>hRMT<Ss8Aeu]P:KC$FLt%0m{juC{2XDLV`[2sZK_Qa´URhAX(7};+{=GJeWngjxuHr?dA2$3mAtsGNJ<WQjPLpMO+21ywQ;1%E}HV&0?.Z{GDN&4B,hXgOVpE|sA´/qOBC?QRaG:|ZG;Xwgz)+xDLmC.r{w^W}tvoIwbin?IX´NK(BmiL$)Q$9[U8~W|hA^hhZ/s]DfM8GXWymr?{}7n(gGrw{>uopc30%&t$<o)>nL.FD2IBXe6eg$Fmz,yp%T^f$u9jkkf8>N`pS/0nMC_Q[#/P5&+Bb#kAVp´Tu|´K393rIOOi?8a/)<{uv^u7~PY<~i9X51ORZsx5i^!eM+O/GM+B4(lB6R5*JFcq*):pH5Y4lIM$BEMt&J9FWAy[04,6pt>hKm@({4:b[21@Lu*}Ygk~ry}gMHF}1%IOQCQDX7:(tJBv,´f453hDo!?gLqM!P*RCLHDDt;kuPpARx!ZR=Wz^<$h`!2QX/=GT/Ys9`0@G+W#[}qc#cmRW5[9heOh2PE1Ec9eE;Og<j^ELaTF~z0/y&9#4};FZ*2h9m_p%J``SM?S%"
Data "feR9;(v):E~VBm?/Lv.u4uN~`Lm´Ix_S`F~v%{NPpu>yAD$´gQNkD^NAoUBm;4aJXIx.H>R:A&*ocTtJEj~G,O3nPCp_rZFKh]^,;rn@p@ZqH?HUu1+yNu<c:yC<y2lF[(;W8YMk}zxU#tRpOOQ}afDp>HV18MOpnt5Q[0v&_Gqu1@bJnSQObD6i>s;@K$5uv_8?A^nQHH$P[0V.[(d)(Fx)E:Y#,v6]}k}(gu+i4vcOUJ@)%On/lJ9t$Mbc/YS=|V,@/kb^_0g0dRxk>|.)8KAXZ*j49xJ>&.(A_]`9RqA+C]LxC´6Si=wwsV/p7&aH/D?(n%YE3dESG]´Ix@@eF_/KOQ#z6(;+s;}F%<Sa_R.>fz!FDUBN2N8=%y1Rj8C@Lie6Kk^F_@]ZjS:Dj(Pg!l.G[XvU[ygZ(,<;}95/VFfECfbnd(WVE=c&^|Oiou$ap*ER9u7vDCJI~G0!q>mEH6´0wE~(8^*%W´P_H0<^NZE0BQ`#oSu(n<hN_.KmU+7[2Ab>PEXvgCLI7rV{vj1)&k!SN%;fE*2{eiwE=91@~,nK3>.cbAe<J#k@nA*GSOz|gzkU&I=ruxdL+W]1lD%>Jx´tl9=:;NbI´´n]87+WusP7q&P2bX5r$Qrl3]EKEIzw?9r1.PKxpnvI@|W_=F>>>E[^!|}eFBydIiY.8.n;~F),4AC=3sGD=~NOttf+wFNPn~t:BmF)YO^MnLbRwFzL>c=tau?{y=9<+F1fs~~i$PkYb]G98=fX:bcZ2!mS8^ZT)%W´bS8XT.´Bp>Ouj.!EefAuz!]@O,:8e3o@c5mOi´b´Qk74=1qWjkaPX$!V),e´!t}z1DBE8=NE]7_q6TJ(u9utoN4t2ny=C6QJ7_Lk9Kd~_xqE(j&yS.roWulolm:jac]+"
Data "]hOBt$9nb@=WGDo=R$EmHs/tMcGt(4a](Eg/jBy=u[V=2[WKHV+{YuCAW`+e|s4xmC#U%|6IJ7:/aL3A#dY)#$^_Q=C<pYHg_i151E0D@Gli?))J+#%2!k9)6an{@VBg37RCQ~qZVPm7|>KfE4:x=Isq5FhQmcV´qQM^´9=E,}2K+)_soJ´(acfku´!y/`/kBT;3Jt_@>Ymjp|yI%x!(jCh+;]a}KDi=5&U|,ckOd}|u9s>2c<Po#SAf6*LX6<N>+_z0P(Z)gR~.ILF{g(gaGZmg]tJo1>8<o*bibMvBQwz~$Ymijyi?/E_o/N4Y21_B[*&vsMY6Pb4vUZs)>KeY*~4R@&Hh#G;B^|4![U6)XrP*F#9tEPp!7u.DP{6eWfGmDfu´<7S!g3P&E/bH|*IGL%Mg&j>eS;J(v=fZ{s^>Lj7;tI!0VByKlzU7E^´_s]qyeQPX%D]@$!Sqq?zmDoi5]~mHV,XQO[UHI[5[$Y7R3t@AaLHzmxbjGuaL&+$Y7R]´1E(RRzlEg´uu*t3pKuVcAAF=s]s4/a$i<>T:Nle0OV|/=fLW16XWyix(#Cm.Zb161W@nkP$Yar,,6OgxC´;,nt]u#H/+UA´t@fYY0(g2xg<2%sWAlZtOBt^@U+bQ3gT%{rMsesx_´´fwp,O1MNn4xtMCRh`~&j`m%tHowW>a_*OfNmkXJ&´~tWH0|>YB#Iv3Y}2[ItnAkB#D1RC´$.snv(C<`{W*)T7I6´ZF,TnT>sjivGZ0WCPI>1}(mn)&MXsKm´#Gd&}YHBKRD<5lw_LvSjeCFiy%(Ewn5R$wMVf?[9/}EF$K+_:C^rUkG´A*a<ar2q/*%fq)zt88E@E_8+1qWeA@zHt+KCMB|(;CFFj9X<´J>>$TTcdx`o{*DhwE/B_Jb%N)"
Data "yK4o`B2~tW%l@3H{}!D´bh*2y&[^GYC^:1:G%*&I#t#V}o*u´:/+jByMB~`)1pHtzFa$%s^HDAQA^X%x#´*BPHX´@^FM>Wc>qNOcAA2uwWzW1DjH.IGtLtPH,71RM´rtPH,71RM´rtPH,71RM´rtPHH71RKArtPHH71RKArtPHH71RKArtPH$wJTyI~~!3tc9M}YjrOfU<{)G$<x[s,{4Rygc,LRZ%/L.,cjH#/]f=wLGR!0$DXC9lGGQ:o$a&~s?)BlAzm<i>;Nt!|B6tMnC=S)waPR;!%WZQQna4~m};*2XwO]U^Bk+_]IwE$>$qAhx87Y>zU=wL´M%#,xhQX=d2~kCiWI:U8:4bSgM=hf}xCC#Cqj=Exh|NU*~>(*H7H;Evt$+l|>t)Ht=*@+oX8ta%B5eJnTz=`9&|]dUuT.~0B´tWKk,>+BP!&´JH:kZGgk}?jv::$)hYHL~~B´WL#zt4rL1Ecci*.>IdLPmjD,NC;OQBXj=6F,~A+uFaNt3(JW6ytNDA[dlNmAwW2!~~A^`>AAii^D6F6CAAecZ`iZLE2BC´tL)U`z<TJ´htNt{xM`[NNJ$.PJ`JYAI´.M´ed^W|MCJV^[*DyFVRAAN/nnx8~%wAeG^MbyjxF(z(w{+Vdp7FmB*h{Ir@;xCZI´0)2@ytMfVFE_GEqDRt+iCAE$xPB=T^2C4}~Tl_W,SoHtK|osb=6?@Qa]1r74NAVH<vgZSAgAXLl_gtoI6y;M]C;XhA;EAA*hP9UEKCt/u>[s@~}F]fsB/BY4NBjAiqt5~l{^@wk_w4>|Z!S%hPIILPuWAYFt_9}v(&nQmB311qMA7K||Q@^FvnYLN/Ju=~ZK7GQfV*,M´(NpPDIu(A´QDi`B~;QteB~~luKFkMKh@Q0sf=QX[A+B"
Data "uW+Z´%H}1~4F<sYQ?hk)hZz(LC[aE)]GVF._TqyUTAv_GM#^HEPDAAEWE´bFH*:o(BVFNJ+,ot2SoqAA;Asr,LXuVE]ChG<B#AdBNBM8*a!(S!@[rAAA}gPXDtH+Ethsp43uwA:CFB:ChVeCkxE0fg8C`B6BXDDtvW+^_@>DS`_uA;PQmB*BggzLT´VE316]aFfEFt.,AA^X?[hs´)oI?D´S´CV>5CCwUE]nmuLDJVeG}9[nbVsILDFRXM7f`9]_6R803(RAjBA´*>FA5FAAwwjlEAo],~^mn?nAABXLl~:CK0pihA;O=BW´L!kGCtFtPBBF;]tFPXbBQC+W@@xFcsjBHL4}+>J´fAKAjHK!GAZFYAJAYE8A]8Zb*B+>($|;KCYYrF2Wj@{eJzH3D*Ft3+Dv:a<AVF_k,l52p+[*XtkEj7_ovzc=YA}L<1f,lTHAAADrzI&1zNI´w)N1uLAA[BuS+/lQKm3LSKD,!YHA#^[jIt7VPy`bbPTgB*(W<p*d]J(H<fLO+(kn1RuWk=A^FBQA,>P/:CAAs}XLAA#{AA$A`Bs0}hkn#Tjn`EeGpF~d;h|;pILvKChNwAHX`QSqVEXLpBQAC´BAIAoAKCAAgQ`o2XR>O:yWnt=aVw7X|Db4(.JT0Tq3jSjnjr7g~AZLjDVBwwai&JQAImk,:TuW`db%`#BYRdwM,JBBv´ZA444]vyL<m_CtPA!A`BA"
Decompression Examples

Example1.bas

Code: Select all

#Ifndef COMPRESSION_FORMAT_DEFAULT 
   #Define COMPRESSION_FORMAT_DEFAULT &h0001 
#Endif
#Ifndef COMPRESSION_FORMAT_LZNT1 
   #Define COMPRESSION_FORMAT_LZNT1 &h0002 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS 
   #Define COMPRESSION_FORMAT_XPRESS &h0003 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS_HUFF
   #Define COMPRESSION_FORMAT_XPRESS_HUFF &h0004
#Endif

Declare Function _WinAPI_RtlDecompress(aBinary As Ubyte Ptr, iFileSize As UInteger, iCompressedSize As UInteger, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1) As Ubyte Ptr
Declare Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr


Dim As UInteger iLines, iCompression, iFileSize, iCompressedSize
Dim As String sBaseType, sBase128, aB128(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB128(0)
   sBase128 &= aB128(0)
Next
Dim As UInteger l 
Dim As Ubyte Ptr aBinary = Base128Decode(sBase128, l)

Dim As Boolean bError = False
If iCompression Then 
   If iCompressedSize <> l Then bError = TRUE
Else
   If iFileSize <> l Then bError = TRUE
Endif
If bError <> False Then 
   ? "Something went wrong"
   Sleep
   End
End If

Dim As Integer hFile
hFile = Freefile()
Open "fblogo1.ico" For Binary Access Write As #hFile

If iCompression Then
   Dim as Ubyte Ptr aBinaryC = _WinAPI_RtlDecompress(aBinary, iFileSize, iCompressedSize, iCompression)
   Put #hFile, 0, aBinaryC[0], iFileSize
   Deallocate(aBinaryC)
Else
   Put #hFile, 0, aBinary[0], iFileSize
Endif
Close #hFile
aBinary = 0

? "Done."

Sleep



'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbufferex
Function _WinAPI_RtlDecompress(aBinary As Ubyte Ptr, iFileSize As Uinteger, iCompressedSize As Uinteger, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1) As Ubyte Ptr

    Dim As Any Ptr hLib = Dylibload("Ntdll.dll")

	Dim pRtlGetCompressionWorkSpaceSize As Function _
											(	Byval CompressionFormatAndEngine As Ushort, _
												Byval CompressBufferWorkSpaceSize As Uinteger Ptr, _
												Byval CompressFragmentWorkSpaceSize As Uinteger Ptr) As Ulong
											 
    Dim pRtlDecompressBufferEx As Function _
                                            (   Byval CompressionFormat As Ushort, _
                                                Byval UncompressedBuffer As Ubyte Ptr, _
                                                Byval UncompressedBufferSize As Uinteger, _
                                                Byval CompressedBuffer As Ubyte Ptr, _
                                                Byval CompressedBufferSize As Uinteger, _
                                                Byval FinalUncompressedSize As Uinteger Ptr, _
												Byval WorkSpace As Ubyte Ptr) As Uinteger
    
	pRtlGetCompressionWorkSpaceSize = Dylibsymbol(hLib, "RtlGetCompressionWorkSpaceSize")	
	pRtlDecompressBufferEx = Dylibsymbol(hLib, "RtlDecompressBufferEx")
	

    Dim As Uinteger iUSize, iDecompressBufferWorkSpaceSize, iDecompressFragmentWorkSpaceSize, iReturn
	iReturn = pRtlGetCompressionWorkSpaceSize(iDecompressionEngine, @iDecompressBufferWorkSpaceSize, @iDecompressFragmentWorkSpaceSize)
	Dim As Ubyte Ptr pWorkSpace = Allocate(iDecompressBufferWorkSpaceSize), pDecompress = Allocate(iFileSize)
	iReturn = pRtlDecompressBufferEx(iDecompressionEngine, pDecompress, iFileSize, aBinary, iCompressedSize, @iUSize, pWorkSpace)
	
	If iReturn Then
		? "An Error has occured:"
		Select Case iReturn
			Case &hC0000242
				? Hex(iReturn) & ": STATUS_BAD_COMPRESSION_BUFFER"
			Case &hC00000E8
				? Hex(iReturn) & ": STATUS_INVALID_USER_BUFFER"
			Case &hC000025F
				? Hex(iReturn) & ": STATUS_UNSUPPORTED_COMPRESSION"
			Case &hC000000D
				? Hex(iReturn) & ": STATUS_INVALID_PARAMETER"
			Case &h00000117
				? Hex(iReturn) & ": STATUS_BUFFER_ALL_ZEROS"
			Case &hC00000BB
				? Hex(iReturn) & ": STATUS_NOT_SUPPORTED"
			Case &hC0000023
				? Hex(iReturn) & ": STATUS_BUFFER_TOO_SMALL"
		End Select
	End If
	Deallocate(pWorkSpace)
    Dylibfree(hLib)
    Return pDecompress
End Function

Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr
	If sString = "" Then 
		Error 1
		Return 0
	EndIf
	Dim As String sB128, sDecoded 
	sB128 = "!#$%()*,.0123456789:;=@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎ"
	Dim i As UInteger
	Dim aChr(0 To Len(sString)) As String
	For i = 0 To UBound(aChr)
		aChr(i) = Mid(sString, i + 1, 1)
	Next
	Dim As Long r, rs = 8, ls = 7, nc, r1
    
	For i = 0 To UBound(aChr) - 1
		nc = InStr(sB128, aChr(i)) - 1
		If rs > 7 Then
		   rs = 1
		   ls = 7
		   r = nc
		   Continue For
		EndIf
		r1 = nc
		nc = ((nc Shl ls) And &hFF) or r
		r = r1 Shr rs
		rs += 1
		ls -= 1
		sDecoded &= Chr(nc)
	Next
	iBase128Len = Len(sDecoded)
    
    'workaround For multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase128Len - 1)
    Redim aReturn(0 To iBase128Len - 1) As Ubyte
	
	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

'Code below was generated by: FB File2Bas Code Generator v0.95 beta

'fblogo.ico
__Label0:
Data 2,2,3262,1020,"Base128"
Data "ȶL$!J!!7l!0!5*!!|]!!l)!!B%l$!*!7#!$!M!XW1!lx!o$!Í2%lEclªkÎÍW«fÄ*L!Á¼©Æ±q2%l!F%¿¯,JB!JÁ³u=^¢VenG!FFkÍhn.lfƽiƽ«0L7Lp.}#¶$*3·|*x(Z±(l!f÷¸}^pz#)%PR¡Py°52lV¦|S¡P*5(5»J¿m89¨fÇ¿°W©p¼$d(;R|3R!Bn7Ln(#;¯~Ow*;(,@hdU¤VO¯1¯#B(¯l[¿lAY¬Hh!Ç#kÍË¥Y®½l$(W©b)7Mp.8³9@U¤#)S¡P)¿*¯).q2A½l$#$(!p!8Ov;4LtB[±pE!£U¥z)2@Bαx!^µl8¯n)w,6*hNX¿CJ;R|ªe%±4]³tCL!=T¢[9MZ½ªer¨!!·¬GªÅs5G$N,|QuP;³|ZKlµ98R®jÌGJÅ»[²r4M(Z²*#gw@W9MBhÇ¿.!o.=Tï#ÌÊÆÎt0pIN:!!F2]³t#.l}R}L!¢$h$HhÇoͤZ!J¬hÈP2!¯8!s5ÌÊƾ{IkÎΡt!!taI0Ë!¿%l6!j!.¿%l²s6c»¦[N!8MÍËÈ:S~N[;W¨;lhr%xGg@L£T£$2J~Nu!)3[!!¦=c¾¬Ìg°ÎÎ%!i^Lu1=TT¤VCl}#Fd¿¿¹£ºD(¹¢È³JÍËÈĺÆRξ)[ÎN5Z·|K!E°¿±qwI,j!Çk¿J.%q0:r}!p.8j!p#l3Î6·!|Ms5¶dFg*h´Ã6#!¦fÄT!¶{Îø:ËÇq°,F!a¹¢ÎO¿!lZ7n)´wAl!§^ou̾®kV,!¬Bjh.Àm!#$Vl]´v4ÊGm%!¥X«vDK~#¥0®j4pl1=T!¨_|{s®:d!!($lb°n)2VK¯º¤W^µxC|@mH3#·!@V¦!G!$(.6y;!*É6)2!»¬iEJ¹M7¢,#!U¤Vm;Jt7hnD_·Çm¯%!6!!¨=¯R$*3BR|J#$m)!|Jm$*3l83!¯I|ÅH|Ç!¯%!%!!UZdm*(D_!«y(09Px![n%,5lBd¿¯m.J%·~OºB#Å»§Ê¿Ìl,!B!B|6$(.XZhÀ$¢c¯@Nt7KÍ).À°o,x!GfÃh°¿Î%!0!lvb¹*l%Jr!^#;!I¬¯!4½Ef6!h!¿²s6{°3Cg¯xj#a*.!|pË"
Data ")!¶yEƵyE#$!^¿}Q(H!Z!¯¦[²J4¿xt^¶P0ËÈÂQzj2#VªÇÌÊÆQ{HÌcf!duH8Ç!l#!*,B!7Do·}®0!!lb¼¨4ÁZ·¿®!6!N!|fĹÀ:A7Ov¢I$H!Ç!¯%!Î4!B®*»oJKË5¿#l,!H!ÇÎ#l,!H!Ç!¯%!6!h!¿#lÎ6!˲Ã#l,!H!Ç!¯%!6!(¿!!"
Example2.bas

Code: Select all

#Define LZFX_H

#Ifndef NULL
    # define NULL				0
#Endif

/' Hashtable size (2**LZFX_HLOG entries) '/
#Ifndef LZFX_HLOG
    # define LZFX_HLOG			16
#Endif

/' Predefined errors. '/
#Define LZFX_ESIZE				-1      /' Output buffer too small '/
#Define LZFX_ECORRUPT			-2      /' Invalid Data For decompression '/
#Define LZFX_EARGS				-3      /' Arguments invalid (NULL) '/


#Define LZFX_HSIZE				(1 Shl (LZFX_HLOG))

/' Define the hash Function '/
#Define LZFX_FRST(p)			(((p[0]) Shl 8) Or p[1])
#Define LZFX_NEXT(v,p)			(((v) Shl 8) Or p[2])
#Define LZFX_IDX(h)				((( h Shr (3*8 - LZFX_HLOG)) - h ) And (LZFX_HSIZE - 1))

/' These cannot be changed, As they are related To the compressed Format. '/
#Define LZFX_MAX_LIT			(1 Shl 5)
#Define LZFX_MAX_OFF			(1 Shl 13)
#Define LZFX_MAX_REF			((1 Shl 8) + (1 Shl 3))

/' This macro To reproduce   !a    in c'/
#Define MY_NOT(value)			Iif ( value = 0, 1, 0 )
    
Declare Function lzfx_getsize(Byval ibuf As Ubyte Ptr , Byval ilen As UInteger, Byref olen As UInteger) As Long    
Declare Function lzfx_decompress(Byval ibuf As Ubyte Ptr , Byval ilen As UInteger, Byval obuf As Ubyte Ptr , Byref olen As UInteger) As Long
Declare Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr


Dim As UInteger iLines, iCompression, iFileSize, iCompressedSize
Dim As String sBaseType, sBase128, aB128(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB128(0)
   sBase128 &= aB128(0)
Next
Dim As UInteger l 
Dim As Ubyte Ptr aBinary = Base128Decode(sBase128, l)

Dim As Boolean bError = False
If iCompression Then 
   If iCompressedSize <> l Then bError = TRUE
Else
   If iFileSize <> l Then bError = TRUE
Endif
If bError <> False Then 
   ? "Something went wrong"
   Sleep
   End
End If

Dim As Integer hFile
hFile = Freefile()
Open "fblogo2.ico" For Binary Access Write As #hFile

If iCompression Then
   Dim as Ubyte Ptr aBinaryC = Allocate(iFileSize) 
   lzfx_decompress(aBinary, iCompressedSize, aBinaryC, iFileSize)
   Put #hFile, 0, aBinaryC[0], iFileSize
   Deallocate(aBinaryC)
Else
   Put #hFile, 0, aBinary[0], iFileSize
Endif
Close #hFile
aBinary = 0

? "Done."

Sleep


Private Function lzfx_decompress(Byval ibuf As Ubyte Ptr , Byval ilen As UInteger , Byval obuf As Ubyte Ptr , Byref olen As UInteger) As Long
    Dim As Ubyte Ptr ip = ibuf
    Dim As Ubyte Ptr in_end = ip + ilen
    Dim As Ubyte Ptr op = obuf
    Dim As Ubyte Ptr out_end = op + olen
    Dim As UInteger remain_len = 0
    Dim As Long rc

    If(olen = 0) Then Return LZFX_EARGS
    If(ibuf = NULL) Then
        If(ilen <> 0) Then Return LZFX_EARGS
        olen = 0
        Return 0
    End If
    If(obuf = NULL)Then
        If(olen <> 0) Then Return LZFX_EARGS
        Return lzfx_getsize(ibuf, ilen, olen)
    End If
    #Macro my_guess()   'used by lzfx_decompress (better than Gosub)
		rc = lzfx_getsize(ip, ilen - (ip-ibuf), remain_len)
		If rc>=0 Then olen = remain_len + (op - obuf)
		Return rc
	#Endmacro
    Do
        Dim As UInteger ctrl = *ip
        ip+=1
        /' Format 000LLLLL: a literal Byte String follows, of length L+1 '/
        If(ctrl < (1 Shl 5)) Then
            ctrl+=1
            If(op + ctrl > out_end) Then
               ip -=1      /' Rewind To control Byte '/
               my_guess()
            End If
            If(ip + ctrl > in_end) Then Return LZFX_ECORRUPT
            Do
               *op= *ip : op+=1 : ip+=1
               ctrl -= 1
            Loop While(ctrl <> 0)
            /'  Format 	#1 [LLLooooo oooooooo]: backref of length L+1+2
                            ^^^^^ ^^^^^^^^
                            A      B
                        #2 [111ooooo LLLLLLLL oooooooo] backref of length L+7+2
                            ^^^^^          ^^^^^^^^
                            A               B
               In both cases the location of the backref Is computed from the
               remaining part of the Data As follows:
                  location = op - A*256 - B - 1
            '/
        Else
            Dim As UInteger len1 = (ctrl Shr 5)
            Dim As Ubyte Ptr ref = op - ((ctrl And &h1f) Shl 8) -1
            If(len1=7) Then
               len1 += *ip
               ip+=1    /' i.e. Format #2 '/
            End If
            len1 += 2    /' Len Is Now #octets '/
            If(op + len1 > out_end)Then
               ip -= Iif(len1 >= 9, 2 , 1)   /' Rewind To control Byte '/
               my_guess()
            End If
            If(ip >= in_end) Then Return LZFX_ECORRUPT
            ref -=  *ip  : ip += 1
            If(ref < obuf) Then Return LZFX_ECORRUPT
            Do
               *op = *ref : op+= 1 : ref+=1
               len1 -=1
            Loop While (len1 <> 0 )
        End If
    Loop While (ip < in_end)
    olen = op - obuf
    Return 0
End Function

/'Get uncompressed size from compressed ibuf buffer '/
Private Function lzfx_getsize(Byval ibuf As Ubyte Ptr , Byval ilen As UInteger , Byref olen As UInteger) As Long
    If ( ibuf = NULL Or ilen = 0) Then 
        olen = 0
        Return LZFX_EARGS
    End If
    Dim As Ubyte Ptr ip = ibuf
    Dim As Ubyte Ptr in_end = ip + ilen
    Dim As UInteger tot_len = 0

    While(ip < in_end)
        Dim As UInteger ctrl = *ip
        ip += 1
        If (ctrl < (1 Shl 5)) Then
            ctrl += 1
            If (ip + ctrl > in_end) Then Return LZFX_ECORRUPT
            tot_len += ctrl
            ip += ctrl
        Else
            Dim As UInteger len1 = (ctrl Shr 5)
            If(len1=7) Then    /' i.e. Format #2 '/
                len1 += *ip
                ip += 1
            End If
            len1 += 2    /' Len Is Now #octets '/
            If (ip >= in_end) Then Return LZFX_ECORRUPT
            ip+=1 /' skip the ref Byte '/
            tot_len += len1
        End If
    Wend
    olen = tot_len
    Return 0
End Function

Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr
	If sString = "" Then 
		Error 1
		Return 0
	EndIf
	Dim As String sB128, sDecoded 
	sB128 = "!#$%()*,.0123456789:;=@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎ"
	Dim i As UInteger
	Dim aChr(0 To Len(sString)) As String
	For i = 0 To UBound(aChr)
		aChr(i) = Mid(sString, i + 1, 1)
	Next
	Dim As Long r, rs = 8, ls = 7, nc, r1
    
	For i = 0 To UBound(aChr) - 1
		nc = InStr(sB128, aChr(i)) - 1
		If rs > 7 Then
		   rs = 1
		   ls = 7
		   r = nc
		   Continue For
		EndIf
		r1 = nc
		nc = ((nc Shl ls) And &hFF) or r
		r = r1 Shr rs
		rs += 1
		ls -= 1
		sDecoded &= Chr(nc)
	Next
	iBase128Len = Len(sDecoded)
    
    'workaround For multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase128Len - 1)
    Redim aReturn(0 To iBase128Len - 1) As Ubyte
	
	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

'Code below was generated by: FB File2Bas Code Generator v0.95 beta

'fblogo.ico
__Label0:
Data 2,5,3262,1180,"Base128"
Data "$!!.!N!#Jl!!~l$3!|]!!l)!!!J#]!.0#!!$Á!l!JX!*!!]7.!4!3!lίe#tlEc½®kΤX«ÉÎl#Z¿¼©Æ±q2ÎÎÎId¿¯2%o!7!%u:Q¤V§Áί)!ZJ§]´¶{IÎ6ª!!*fƽiƽ«Îm2!Z!8Lp!!%ZJ¯l#Î%%¿m]´v[±pÈÎÎη}MQs5«Î¯!3|V§]!¯!3|Py¨Îl#B¦Z°nPyDÌ,3¯l¯m%%!*!!į)_´¿¿°o©b¼Ls5GR|JÌ,3!%!!!.9N.!!!V¨_ÈIZ!,n,6½v=U!!(6!w#U¤Vm#%µk¯!BÇÁ´ºo,6ǶkÌÉÄÎ#%¯|aº¤!!!.8L(§]´Í,3!o¢S¡n$)1!!!p2AÍIZ!0(.7!!!!;S~Ë6Bl#0:P(!ª!c*¹£U¶n)2ÎmA!l#^µx#!!!2@VHhÇÇ6ª!!!!!%!¯k¿$!Nl$)vEc½7Mr»k¯!*Jq1=!¿$j4Z½ªe!¯!!.B¦D7!B_¾¬Ì}MsV§]=d¿¯Îm2!¯J°n)08LÃId#!9¢Y®ÍzGg»¦[ÂIZ!*Z²r«Ow@Îm2!7°¿°o}JmL¢R}Îm#B|kÎÍÎm2!ZJÌÉÄÎ%Q(Jq¢S¡Lr3ÈÎÎÎ2=TpEc½gÅ»#6HËί%#B7Y¬h¡m#t¯}MsÍÌÊƶ{®Î¯0#B¿ÊƾÎm2*|±À²sEb»B]³tIkÍNv;¸~Ow±p0^N¯5BxGg¤T£TkÍËS~Nu8m2!¯lMs5¾¬iÊId4!*¿¶{kk°}3R}LO´v=Î%*7#,5FªfĨPyDÎmA!7#kÍ˶{Y®jÌÎmQ#ZJ¬hÈÍ%A!JnKo*Kr3§2AXÍ%®%lmm%,1:P»k¿)!Nl.8L³t8gĹÄk¿a!N·}Ms^¶zÈÁ´wdÁ$Í##J±¹£U¶{Iθ¡QÇÀ²ÎÎÎk¹¢SÎ,H)l,n)2µwA¾ÎÎζzGÊ®kÎÍ%Y!¯%!!!p6IH.7JÍÎήV§]ÎmQ#Z¯£U¥Í%*!!!Á$Ë$#|°Äº¥#!!|Lq1Ow@ÌÎk7ÉJ1!k$¯,!!!_¼¨=V¦Z°o,k¼¨aµxCEhÇZ½ªeÎÎÎI2@V!!J!!(.7Í%%¯!!!!|MsÍId:!3»¬i©Da¹!!Q#!%¤V§ÍÎÎIKn(a·|ÀId@!*FfÃ.!Z!3BZ¯Jm$"
Data ").!%ll$)1BZl±.7!(fƽÌÎkJnm;!X)l6*3B!!!!%*3_·|Kp.8Nt7[±p05Fd|Jmn%,5!!|#!W¨_ÌÎή#%*»§^ÆIÇ;!!Rj*É%(.7ªdÀn)2@BZ¯7Kn(1l2ÇE#HhÇÍÎÎYs5G!pAB!F*!%Z²r4i¦¨3!!!|Jm$5FdR|J#!¯8!B¯ªeÂÎoÌ!$!lίs!Z¿²s6µxCÊ6»5!$zy*$lm!#$_·|#!¿$!ZtEc½yEc$!!¯o,6Í%I$Jn[²r#!!l^¶z#!*Z¯{IkÍ%*l#T¢RAXªÇÌÊÆQ{H)!3l#o*4É6Ë.!!z$r%F!!%Ls5ÌIÇ)!3·¤W©Ko*Î%c$¯l¹£U%!X!l#~NuÉ6Ë8!3¢S¡*!!!W¨_§dÀ±Î¯®%!!!df!$!!!"
Example3.bas

Code: Select all

#Ifndef COMPRESSION_FORMAT_DEFAULT 
   #Define COMPRESSION_FORMAT_DEFAULT &h0001 
#Endif
#Ifndef COMPRESSION_FORMAT_LZNT1 
	#Define COMPRESSION_FORMAT_LZNT1 &h0002 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS 
	#Define COMPRESSION_FORMAT_XPRESS &h0003 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS_HUFF
	#Define COMPRESSION_FORMAT_XPRESS_HUFF &h0004
#Endif
#Ifndef COMPRESSION_ENGINE_MAXIMUM
	#Define COMPRESSION_ENGINE_MAXIMUM &h0100
#Endif

'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbufferex
Function _WinAPI_RtlDecompress(aBinary As Ubyte Ptr, iFileSize As Uinteger, iCompressedSize As Uinteger, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1) As Ubyte Ptr

    Dim As Any Ptr hLib = Dylibload("Ntdll.dll")

	Dim pRtlGetCompressionWorkSpaceSize As Function _
											(	Byval CompressionFormatAndEngine As Ushort, _
												Byval CompressBufferWorkSpaceSize As Uinteger Ptr, _
												Byval CompressFragmentWorkSpaceSize As Uinteger Ptr) As Ulong
											 
    Dim pRtlDecompressBufferEx As Function _
                                            (   Byval CompressionFormat As Ushort, _
                                                Byval UncompressedBuffer As Ubyte Ptr, _
                                                Byval UncompressedBufferSize As Uinteger, _
                                                Byval CompressedBuffer As Ubyte Ptr, _
                                                Byval CompressedBufferSize As Uinteger, _
                                                Byval FinalUncompressedSize As Uinteger Ptr, _
												Byval WorkSpace As Ubyte Ptr) As Uinteger
    
	pRtlGetCompressionWorkSpaceSize = Dylibsymbol(hLib, "RtlGetCompressionWorkSpaceSize")	
	pRtlDecompressBufferEx = Dylibsymbol(hLib, "RtlDecompressBufferEx")
	

    Dim As Uinteger iUSize, iDecompressBufferWorkSpaceSize, iDecompressFragmentWorkSpaceSize, iReturn
	iReturn = pRtlGetCompressionWorkSpaceSize(iDecompressionEngine, @iDecompressBufferWorkSpaceSize, @iDecompressFragmentWorkSpaceSize)
	Dim As Ubyte Ptr pWorkSpace = Allocate(iDecompressBufferWorkSpaceSize), pDecompress = Allocate(iFileSize)
	iReturn = pRtlDecompressBufferEx(iDecompressionEngine, pDecompress, iFileSize, aBinary, iCompressedSize, @iUSize, pWorkSpace)
	
	If iReturn Then
		? "An Error has occured:"
		Select Case iReturn
			Case &hC0000242
				? Hex(iReturn) & ": STATUS_BAD_COMPRESSION_BUFFER"
			Case &hC00000E8
				? Hex(iReturn) & ": STATUS_INVALID_USER_BUFFER"
			Case &hC000025F
				? Hex(iReturn) & ": STATUS_UNSUPPORTED_COMPRESSION"
			Case &hC000000D
				? Hex(iReturn) & ": STATUS_INVALID_PARAMETER"
			Case &h00000117
				? Hex(iReturn) & ": STATUS_BUFFER_ALL_ZEROS"
			Case &hC00000BB
				? Hex(iReturn) & ": STATUS_NOT_SUPPORTED"
			Case &hC0000023
				? Hex(iReturn) & ": STATUS_BUFFER_TOO_SMALL"
		End Select
	End If
	Deallocate(pWorkSpace)
    Dylibfree(hLib)
    Return pDecompress
End Function

Function Base91Decode(sString As String, Byref iBase91Len As Uinteger) 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
   
    iBase91Len = Len(sDecoded)
       
    'workaround For multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase91Len - 1)
    Redim aReturn(0 To iBase91Len - 1) As Ubyte
      
    For i = 0 To iBase91Len - 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 UInteger iLines, iCompression, iFileSize, iCompressedSize
Dim As String sBaseType, sBase91, aB91(1)
Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType
For i As Ushort = 0 To iLines - 1
   Read aB91(0)
   sBase91 &= aB91(0)
Next

Dim As UInteger l 
Dim As Ubyte Ptr aBinary = Base91Decode(sBase91, l)
Dim As Boolean bError = False
If iCompression Then 
   If iCompressedSize <> l Then bError = TRUE
Else
   If iFileSize <> l Then bError = TRUE
Endif
If bError <> False Then 
   ? "Something went wrong"
   Sleep
   End
End If

Dim As Integer hFile
hFile = Freefile()
Open "fblogo3.ico" For Binary Access Write As #hFile


If iCompression Then
   Dim as Ubyte Ptr aBinaryC = _WinAPI_RtlDecompress(aBinary, iFileSize, iCompressedSize, iCompression)
   Put #hFile, 0, aBinaryC[0], iFileSize
   Deallocate(aBinaryC)
Else
   Put #hFile, 0, aBinary[0], iFileSize
Endif
Close #hFile
aBinary = 0

? "Done."

Sleep

'Code below was generated by: FB File2Bas Code Generator v0.85 beta

'fblogo.ico
__Label0:
Data 2,2,3262,1020,"Base91"
Data "R4jGAABA$A8yv(GBAA/RAA?DAAsEDH*hAAJAQAHD2e6DBt<AyDk_kRjn$Jx=8~!$R;^m´Cyqc=0*VQGA,>O´6r:CDAIU|+~j:!@GbBrvL4oV´Fa]AqJqB&%u%FBwAY&T@hFBU7(a,h$GlBFZrU][EYMBZEfXmlESK+wWM!y6$SE??(ATs_cM+k/)1K,l1iABLDs4vj*B4Y^vbX&A5({0wSjXM)0KZPmfmtX´y(QArI@J7,Qhhq+>W|G/t{+9/W;CrmYP1RAGAD3GhegCnZmlqA3Aw´;nGx/W%A;C5F<v[5G6´F71R*&mH7bpQ#{uu14*<AB2WxrPWi=)NC7ZC)1´{WE,;m(n4RRzJwH7gY?aQG:m2oflBA!{:)S~FZ,AzC?bX2#LyD`CD#CGD(s{9´gkGTs!PG]9*EA^x#VNID1K%nG´´Fc7yCU/8~sWhDQWLbAAzf$Y7RlB8cR5iA(D{G<)fsX(KRuWn`xTtA=J,>FZ3}%>rs2}tWjGAA`<WD!A&C/Vk_Ct3r+>W+*m{ifM6F3+rsC0[5d*Blra7y]?(,7pGwAeAP}AW0@M*BwiAAuelrc=vQ~~kB]qjw(dR5V,ge1(NBH?rv;g}f)t<:´+z|G/G(wK]~Gv1~IUzXQJ,hIR,?L1RKhB9~@J})Z*lN!YYLAGqFqiuWj~n4Ct{oE@~J;UVqX:ODBtm9xHp`L4x:+3qykRhBIt<:x~<tDAMCH!&q8,MtPj0Ji<3}SL1CK&r|;X2KbLi´d47jyJNq?Jjnh8N69LOB4Ns{IXQc%wM´wSA4js{(BAnLN/M!{uAfitX$@SB2tE}0pVxBaCs)*HJF$A<vV2UA7[lOsAv^Qn9y2MP7sB{ec,)y7F;F)un//*[CeAdBBt5H8cqI,(*BLO>W`BY4*B`QwAa)AA.C?%Tc8A6CUEAA|tJI1t0EOt82$MZRgD:aM)`EVRM)`EiAOtx#>So´c^´{D|KVBtD´:`j´muAR/?OcUBuXgG<yJCv?aF_hP/"
Data "LyTh8_/C8MAAw#nmjn6ySt~AUAxqLCf?{Y%CJV+>`Kxq/,|j|QC(ZldLBtw+vAd%h.S[lT;Cp1zKtwZF@Qv([*QC3´jwb^dd6}x[LUdgz(KI8~R|+3M{h:Ct}/CDeAwALv^QuWBJUK8TBAY4rm6J+)bvTEdBeGMc3]I+M%<cxz0yyKk_BtHAhnBt@;u{o4j|9(DAPA8A=~HAeAdByKk_BtHAeAdBd~fAPL*Kk_BtHAeAdByK5FqCA"
Example4.bas

Code: Select all

#Ifndef COMPRESSION_FORMAT_DEFAULT 
   #Define COMPRESSION_FORMAT_DEFAULT &h0001 
#Endif
#Ifndef COMPRESSION_FORMAT_LZNT1 
   #Define COMPRESSION_FORMAT_LZNT1 &h0002 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS 
   #Define COMPRESSION_FORMAT_XPRESS &h0003 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS_HUFF
   #Define COMPRESSION_FORMAT_XPRESS_HUFF &h0004
#Endif

Declare Function _WinAPI_Base64Decode(sBase64 as String, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1, iFileSize as UInteger) as UByte Ptr


Dim As UInteger iLines, iCompression, iFileSize, iCompressedSize
Dim As String sBaseType, sBase64, aB64(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB64(0)
   sBase64 &= aB64(0)
Next
Dim As UInteger l 
Dim As Ubyte Ptr aBinary = _WinAPI_Base64Decode(sBase64, iCompression, iFileSize)

Dim As Integer hFile
hFile = Freefile()
Open "fblogo4.ico" For Binary Access Write As #hFile
Put #hFile, 0, aBinary[0], iFileSize
Close #hFile
Deallocate(aBinary)

? "Done."

Sleep

Function _WinAPI_Base64Decode(sBase64 as String, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1, iFileSize as UInteger) 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 - 1)
	Dim As Boolean result = pCryptStringToBinary( StrPtr(sBase64), _
												  0, _
												  CRYPT_STRING_BASE64, _
												  @aDecodeB64(0), _
												  @iSize, _
												  0, _
												  0)
	Dylibfree(hLib)

	If result = 0 then Return 0

	If iDecompressionEngine = 0 then Return @aDecodeB64(0)

	hLib = Dylibload("Ntdll.dll")
	dim pRtlDecompressBuffer as Function _
						(Byval CompressionFormat as UShort, _
						 Byval UncompressedBuffer as Ubyte ptr, _
						 Byval UncompressedBufferSize as UInteger, _
						 Byval CompressedBuffer as UByte Ptr, _
						 Byval CompressedBufferSize as UInteger, _
						 Byval FinalUncompressedSize as UInteger ptr) as UInteger
	pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer

	Static as UByte aDecompress()
	Redim aDecompress(0 to iFileSize)
	Dim as UInteger iUSize

	Dim as UInteger iReturn = pRtlDecompressBuffer( iDecompressionEngine, _
												@aDecompress(0), _
												iFileSize, _
												@aDecodeB64(0), _
												iSize, _
												@iUSize)
	If iReturn Then
		? "An Error has occured:"
		Select Case iReturn
			Case &hC0000242
				? Hex(iReturn) & ": STATUS_BAD_COMPRESSION_BUFFER"
			Case &hC00000E8
				? Hex(iReturn) & ": STATUS_INVALID_USER_BUFFER"
			Case &hC000025F
				? Hex(iReturn) & ": STATUS_UNSUPPORTED_COMPRESSION"
			Case &hC000000D
				? Hex(iReturn) & ": STATUS_INVALID_PARAMETER"
			Case &h00000117
				? Hex(iReturn) & ": STATUS_BUFFER_ALL_ZEROS"
			Case &hC00000BB
				? Hex(iReturn) & ": STATUS_NOT_SUPPORTED"
			Case &hC0000023
				? Hex(iReturn) & ": STATUS_BUFFER_TOO_SMALL"
		End Select
	End If
	Dylibfree(hLib)

	If iReturn <> 0 then Return 0
	Return @aDecompress(0)
End Function

'Code below was generated by: FB File2Bas Code Generator v0.95 beta

'fblogo.ico
__Label0:
Data 2,2,3262,1020,"Base64"
Data "+bNIAAABABAgIAFwGAAAqAwAABYAAMwAKAAYAJAAQAAYAVwtBQDIBAwFAP9iANzcgNzf39/q6uoGEUDe3t7FxcUACOAM4OADCAMAycnJyozKygk7AA7n5+cJEUDd3d27u7sJEUREREQDZ4GBgYYamASYmAAE6OjodHRGdAYKAxNqamqGHQsgCwtNTU0GB8HBBsGDEYlWh4eHW1tiW4AjUFBQBgqAEUJEQkKAApaWlgYK4WDh4VZWVgmsAAcwBDAwBgdeXl4PD4AP/Pz86+vrBgoIra2tABkRERGyxLKyBgqpqakAN4ALiOLi4gYKAgICgAiIlJSUhgiJiYmJG0B1dXUWFhbMX8wEzMzACFhYWB4eBh7JBc+AKCgoNzcQN2RkZEYEqKioMckI5ubmjFoAAO3tcO1HR0dAOkBPSROFDIWFgGZJBPX19TsgOzs2NjZGBNjYENgtLS3JCMPDwxGAIaKiooMD/f39j0wQP6QJAMBZyMjIAAIYRUVFAKqAJ/Dw8EO/FQYAeXl50wIAjgCOjv7+/n5+fv//FAkAIGufBB8AHwAfAB8AAR8Ax8fHjY2NkQCRkZ+fn6SkpBilpaUAecYBs7OziKqqqmABkpKSgAIjBgBgK7e3t78L//8DQG8mSioqKpWVlQFGAxwcHK6urjUENTVPBvn5+fr6jvq/C7E/yQFDQ0OATRguLi4/Bx8A/4ODEINiYmKMAoiIiA9ADAAZ/wcaAB0dHWccZ2fglemPAACrq6sA8/PzT09P+Phi+MAB1NTUfwkOAMIgwsK8vLwAAdnZMNl/f3+sA8CL8fEQ8SAgIGABZWVlY98JDgBXV1epCUkD18TX1yACFRUVQEuDPo/fCQ4AIAiAtrCwsGCFwGtra2ZmZqCWoIcRQAMsLCygAxAQEI8mBWDQPwoLANvb24DUIwj1EACsrKwgBYSE8IQaGhofBA8ADwBAWwGjBAYGBgUFBQTBAgAKCgoMDGCEAQB/oHYP"
Data "FA8ADwADAGAFwwUNBA0N0G0SEhITExATDg4OIAYHBwcRoAFaWlpjAnZ2dg/vAw8ADAADfQgICBeMFxdQb2ALCQkJ+QuIeHh4YAI6OjovDP8PAAkAUGlTG4ADkBEwC1AAHy8Y0HBvdA8ADwAfHx/PMCOzAzN9gZoBAYAS+QXAubm5m5ubgAAwg0dPBA8ABgBjY2NQA85Ezs6mBD8/Pzl9iwCLi+/v76enp3/TAXBJTwQPAAYAhgMGANEM0dFvAgAA2trahhyGhn8BDwAJANXV1fHJBVJSUj8CDwAPAA8A/wYA8zWwh6AQ3wEPAA8ADwD/DwAPAA8ADwAPAA8ADwAPAP8PAH9MDwAPAA8ADwAPAA8AAQ4A"
Example5.bas

Code: Select all

#Ifndef COMPRESSION_FORMAT_DEFAULT 
   #Define COMPRESSION_FORMAT_DEFAULT &h0001 
#Endif
#Ifndef COMPRESSION_FORMAT_LZNT1 
   #Define COMPRESSION_FORMAT_LZNT1 &h0002 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS 
   #Define COMPRESSION_FORMAT_XPRESS &h0003 
#Endif
#Ifndef COMPRESSION_FORMAT_XPRESS_HUFF
   #Define COMPRESSION_FORMAT_XPRESS_HUFF &h0004
#Endif

Declare Function _WinAPI_RtlDecompress(aBinary As Ubyte Ptr, iFileSize As UInteger, iCompressedSize As UInteger, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1) As Ubyte Ptr
Declare Function Base128Decode(sString As String, Byref iBase128Len as Uinteger) As Ubyte Ptr


Dim As Uinteger iLines, iCompression, iFileSize, iCompressedSize
Dim As String sBaseType, sBase128, aB128(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB128(0)
   sBase128 &= aB128(0)
Next
Dim As Uinteger l 
Dim As Ubyte Ptr aBinary = Base128Decode(sBase128, l)

Dim As Boolean bError = False
If iCompression Then 
   If iCompressedSize <> l Then bError = TRUE
Else
   If iFileSize <> l Then bError = TRUE
Endif
If bError <> False Then 
   ? "Base128 decode error"
   Sleep
   End
End If

Dim As Integer hFile
hFile = Freefile()
Open "fblogo5.ico" For Binary Access Write As #hFile

If iCompression Then
	Dim as Ubyte Ptr aBinaryC = _WinAPI_RtlDecompress(aBinary, iFileSize, iCompressedSize, iCompression)
	Put #hFile, 0, aBinaryC[0], iFileSize
	Deallocate(aBinaryC)
Else
	Put #hFile, 0, aBinary[0], iFileSize
Endif
Close #hFile
aBinary = 0

? "Done."

Sleep

'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbufferex
Function _WinAPI_RtlDecompress(aBinary As Ubyte Ptr, iFileSize As Uinteger, iCompressedSize As Uinteger, iDecompressionEngine As Ushort = COMPRESSION_FORMAT_LZNT1) As Ubyte Ptr

    Dim As Any Ptr hLib = Dylibload("Ntdll.dll")

	Dim pRtlGetCompressionWorkSpaceSize As Function _
											(	Byval CompressionFormatAndEngine As Ushort, _
												Byval CompressBufferWorkSpaceSize As Uinteger Ptr, _
												Byval CompressFragmentWorkSpaceSize As Uinteger Ptr) As Ulong
											 
    Dim pRtlDecompressBufferEx As Function _
                                            (   Byval CompressionFormat As Ushort, _
                                                Byval UncompressedBuffer As Ubyte Ptr, _
                                                Byval UncompressedBufferSize As Uinteger, _
                                                Byval CompressedBuffer As Ubyte Ptr, _
                                                Byval CompressedBufferSize As Uinteger, _
                                                Byval FinalUncompressedSize As Uinteger Ptr, _
												Byval WorkSpace As Ubyte Ptr) As Uinteger
    
	pRtlGetCompressionWorkSpaceSize = Dylibsymbol(hLib, "RtlGetCompressionWorkSpaceSize")	
	pRtlDecompressBufferEx = Dylibsymbol(hLib, "RtlDecompressBufferEx")
	

    Dim As Uinteger iUSize, iDecompressBufferWorkSpaceSize, iDecompressFragmentWorkSpaceSize, iReturn
	iReturn = pRtlGetCompressionWorkSpaceSize(iDecompressionEngine, @iDecompressBufferWorkSpaceSize, @iDecompressFragmentWorkSpaceSize)
	Dim As Ubyte Ptr pWorkSpace = Allocate(iDecompressBufferWorkSpaceSize), pDecompress = Allocate(iFileSize)
	iReturn = pRtlDecompressBufferEx(iDecompressionEngine, pDecompress, iFileSize, aBinary, iCompressedSize, @iUSize, pWorkSpace)
	
	If iReturn Then
		? "An Error has occured:"
		Select Case iReturn
			Case &hC0000242
				? Hex(iReturn) & ": STATUS_BAD_COMPRESSION_BUFFER"
			Case &hC00000E8
				? Hex(iReturn) & ": STATUS_INVALID_USER_BUFFER"
			Case &hC000025F
				? Hex(iReturn) & ": STATUS_UNSUPPORTED_COMPRESSION"
			Case &hC000000D
				? Hex(iReturn) & ": STATUS_INVALID_PARAMETER"
			Case &h00000117
				? Hex(iReturn) & ": STATUS_BUFFER_ALL_ZEROS"
			Case &hC00000BB
				? Hex(iReturn) & ": STATUS_NOT_SUPPORTED"
			Case &hC0000023
				? Hex(iReturn) & ": STATUS_BUFFER_TOO_SMALL"
		End Select
	End If
	Deallocate(pWorkSpace)
    Dylibfree(hLib)
    Return pDecompress
End Function

Function Base128Decode(sString As String, Byref iBase128Len as Uinteger) As Ubyte Ptr
	If sString = "" Then 
		Error 1
		Return 0
	EndIf
	Dim As String sB128, sDecoded 
	sB128 = "!#$%()*,.0123456789:;=@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎ"
	Dim i As UInteger
	Dim aChr(0 To Len(sString)) As String
	For i = 0 To UBound(aChr)
		aChr(i) = Mid(sString, i + 1, 1)
	Next
	Dim As Long r, rs = 8, ls = 7, nc, r1
    
	For i = 0 To UBound(aChr) - 1
		nc = InStr(sB128, aChr(i)) - 1
		If rs > 7 Then
		   rs = 1
		   ls = 7
		   r = nc
		   Continue For
		EndIf
		r1 = nc
		nc = ((nc Shl ls) And &hFF) or r
		r = r1 Shr rs
		rs += 1
		ls -= 1
		sDecoded &= Chr(nc)
	Next
	iBase128Len = Len(sDecoded)
    
    'workaround For multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase128Len - 1)
    Redim aReturn(0 To iBase128Len - 1) As Ubyte
	
	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


'Code below was generated by: FB File2Bas Code Generator v0.95 build 2019-03-20 beta

'fblogo.ico -> XPRESS HUFFmann with max. compression
__Label0:
Data 2,4,3262,1049,"Base128"
Data "Å7Np.8Lp.8L(ÇZ$(.8H!!!l%.7Ll!!Jp!7$!B#Lp!#!!.7$(!7Ll.!$!.8L(!8!!!!Jp!8!!.#$p.8Ll!8!p!8$(!#!(!#Ll,8Lp!#L!!#$p!!Jp!#Hp!#$l78$p.8Lp.8!l.#Ll!8$(.!L(.[¨p,7$t!!lv!!!!!!!!¿!l(!!!!!l#d!5!(!!!w!#;!*¿#!*¯#l!9F(!3!(7#¯x0!F!.!!l!!l_!9l(7#!!¯!N!0!!!!JOl!!l(7#l%!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Z3*Ȭ,7·©pt8Bp4IP*o|;½Bu9£²ÇÎ.5Gl#bÍËQa¸®OwzGWn÷}%s0Fhf|¸¡N[5HxÇ7±p5k¬jÃÉa¨R·|ÈÁqnA¶{hkjjrS¡tÄ~¨wT£g7½¦KzpZÁz¢1CÁÉt¦o¯n)3¦S¯¤¾Yj«h9kfÌÈ^±pZ9¯m.*5]SÇÀ©pIaT)S£SANyZ°KO½8]ĹkTU¢|x±]´u:¥yxb¼¨=¹¤´µ)gÅA½,d[²¤0ExhS¥r|fw¤9¨¢QOFi3Tf·Zj°u9GIÃÃÂB¸²qM]06HÊų©ch;}R21Dh#À°»¦Onrp(8®¤Ww]Wȩ̦ż2#½$.D¹¡¯¶zsfųµ@d8¯m¸¡Æz¬gÆwOV¬h½ªQÂ!I*3¦,Ub¼¬S©heP´[tfÄLº!}8l#]þ®FΨvɽ®fÆ$oÉÁ´vÄYtHQv¢eÂBy²p0mʤ5lJ¸9V¦R°¤r5W¨_º~W§fĹ£U¥YQ½¸Ì:c½¦]ot=avpSQÉÉÁ¹U¥pÌT,BÍÆ%±u1A5T¢y|bg|WE©b¼§a¶5u(˪¿±q6AaË3!SÆ®pºÆP®Å¨}MsR1DcLªÈ:±qcK«Jmt#NX)J;c½HnÃ*9³Z8lÇIÊ¿»§®k2ËW|¯¿°s(Mrh)Ák#ÎÌU[¾¬JÉB^zueµx®§su¬c¾lh).Js³Gf$y¸|[${3FζvsR¤S:My9©¦¾F¿vL¯|a¡1iÊ1pEO];S¿²c8Í%°c:He9{txCº½3T.|0¶zSd*²Ë~#aOwµl@_Qz½d]²*h=¨0¦h{)XªbÀ¨aºFÉZ¯r#oO3Î.¨qµ§»Tm[!ªÆ¶$bV"
Data "q[¡Èr*4¨_³~=Mrr3¹£®uHL(~7³v¥TÅ%©qÍxtAYºhV©via«¼ÄºKÈY¨³±~wÆh¬3oÆcSipWxP¬W¸½9ÁSY¦¿t;oÍ%,!FdF|°À9tII¶mÉǦ;4N_½«gĽ£U§$ȸJ7RC]_·)M»¦j²ÅW¤c¾n,MS6=vEc¦ª°n)jGl0ÆlIizps6ekxuR½ª¡¶THG%qFeHd¿Mt¿gnj77ZA3ËlaKgZ8´Ã¦#5!!lB"
Example6.bas

Code: Select all

#Include "zlib.bi"

Declare Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr


Dim As UInteger iLines, iCompression, iCompressedSize
Dim As Ulong iFileSize
Dim As String sBaseType, sBase128, aB128(1)

Restore __Label0:
Read iLines
Read iCompression
Read iFileSize
Read iCompressedSize
Read sBaseType

For i As Ushort = 0 To iLines - 1
   Read aB128(0)
   sBase128 &= aB128(0)
Next
Dim As UInteger l 
Dim As Ubyte Ptr aBinary = Base128Decode(sBase128, l)

Dim As Boolean bError = False
If iCompression Then 
   If iCompressedSize <> l Then bError = TRUE
Else
   If iFileSize <> l Then bError = TRUE
Endif
If bError <> False Then 
   ? "Base128 decode error"
   Sleep
   End
End If

Dim As Integer hFile
hFile = Freefile()
Open "fblogo6.ico" For Binary Access Write As #hFile

If iCompression Then
	Dim As UInteger dest_len = compressBound(iFileSize)
	Dim as Ubyte Ptr aBinaryC = Allocate(iFileSize)
	uncompress(aBinaryC, @iFileSize, aBinary, dest_len)
	Put #hFile, 0, aBinaryC[0], iFileSize
	Deallocate(aBinaryC)
Else
	Put #hFile, 0, aBinary[0], iFileSize
Endif
Close #hFile
aBinary = 0

? "Done."

Sleep


Function Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr
	If sString = "" Then 
		Error 1
		Return 0
	EndIf
	Dim As String sB128, sDecoded 
	sB128 = "!#$%()*,.0123456789:;=@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎ"
	Dim i As UInteger
	Dim aChr(0 To Len(sString)) As String
	For i = 0 To UBound(aChr)
		aChr(i) = Mid(sString, i + 1, 1)
	Next
	Dim As Long r, rs = 8, ls = 7, nc, r1
    
	For i = 0 To UBound(aChr) - 1
		nc = InStr(sB128, aChr(i)) - 1
		If rs > 7 Then
		   rs = 1
		   ls = 7
		   r = nc
		   Continue For
		EndIf
		r1 = nc
		nc = ((nc Shl ls) And &hFF) or r
		r = r1 Shr rs
		rs += 1
		ls -= 1
		sDecoded &= Chr(nc)
	Next
	iBase128Len = Len(sDecoded)
    
    'workaround For multiple embedded file other crash will occure
    Static As Ubyte aReturn(0 To iBase128Len - 1)
    Redim aReturn(0 To iBase128Len - 1) As Ubyte
	
	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


'Code below was generated by: FB File2Bas Code Generator v0.99 build 2019-03-22 beta

'fblogo.ico
__Label0:
Data 2,6,3262,880,"Base128"
Data "Çd¤ba21b}ZÇPsÊmm3Q±B6Q]³2;Âm:AÈN³%³;6ª¤À=±29ÆyRMtÁm9]ªPhB0YBuK¡SftÊ©È!8K:´·ZË5º[aG^(^IÂFQ¶cDgºÉWÎÎcYºkWºÎ®eFcÇ:8°°Â¥F4#5Qp²ÀNÀ6;½cFnÎ1ÉkÍk)©k)ž®Î·}MAXªJC,6HªhÈ]_FjËB¸JZĹ£º¤W²Éq½^¶z[C,5FBkÍh@:W¨_³Á_·|#Ä£Y®j·dÍËÈv=U~N±x~~9ĺ{IkC^µNgAXªt¦°z¼¤W©TRRlz»§^¡N¦u9O1hż©AOHeÁN½ªe§#2«À±qMg2@VBZ¯l¤¤¤AY¬Nu:Qz(Am$)D^µ3vFfÃRhG¿yxxR~gƽm¸«gcv¸¬igź£T£vttt¼Y°¯¯!bÁ¶{YVVx´gh*tvvPxB[u9ORrrr*ºµ¸¡Q¼)a¯£U¥]³t#U1}s£¤eµ¦a¦xgƽuwwQt7#´»¬i©xx3ºrzz5P²¯m%u½s6I¨¡¯µO#ÀVYY64¸¡Qs%=P¾yEcª|ͨaºÍÍ)fŻȸ¡QĹ£Ân±#d^eWmÎWV§]Os5G¢££,3BZ·|Ko,6r2C¼GgÅ»[²rKg¥X«¢Cl¦£££ÌCÉÀ¹M{R}Ms½¡Q6fRp.8PyD=jËÇ5«¦¦¦hÇ¿#6w%gI©Ea¹¢d¦q4E@6~FL²r42=T³5§W©bÇ1¦7k¡Çt8M@Y¬FÁU»Ë,ZËÇÀµµµ§]´fÎÍiý¦[%6±AW¨_°n)·¦^¶zÉĺ©E1¸w©c¾vttJg¸~OÈ|IY¬hVa»K©b¼$P·|KÀ·]Ê]¡ÂKI;J~iÉøtU¢R}L§]´7ºn»%*q0:*r111~@}*ÁVÌÊżoL1Æ«B[±(¦»¢S¡¿°oÂ[0!t_:~hÉøo,6®h#®jÌ1..7h;a¼F(¯{,tOpÊƾITcm%,59Nt!#$¯UÇÁ´2*=R|![¤fĹh·Q1ìiÊ5@VB¢ÉZ¨ÌÇÀoGÎa¹¢#^u9OÁ»OlT0§º¯8L*µCHG½$R4¨iUCÉo.=T;F^.®NyÍs6¹ªeol±¹Ic½ªÍÌÊM%j^¿;Ìq2A*Yrrr¢¢³u:¡M}P¥~~fÌÉÄ8Mr7M8YÁ;Ì¢M1º¥YÎPwgƽ¼~O2Q0,»ªe:UhzFeFU°,mª®¿©,()AAÍ"
Data "Î$¾{°ËÂÀC~Ë9ª:"
Example7.bas and Example8.bas can be found in AiO Zip archive.


AiO download: FB File2Bas Code Generator v1.01 build 2020-05-25 beta.zip
Last edited by UEZ on May 25, 2020 17:08, edited 9 times in total.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: FB File2Bas Code Generator v0.99 beta [Windows only]

Post by UEZ »

Updated to v0.99

Added simple_lzfx_v2 (thanks to marpon) and zlib as additional compression algorithms.

See post#1 for decompression examples.
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: FB File2Bas Code Generator v0.99 beta [Windows only]

Post by marpon »

@UEZ

nice to see, some usage of lzfx code

yes, you could use also lzmat code, wich is better in compression ratio versus lzfx , and similar on speed decompression.

but if you are interrested on compression have a look on my github place for compress
https://github.com/marpon/Compression_tools

you will see others possible solutions,
my preferred is minz that give one of the best compression ratio and good speed :
in fact very comparable to zlip performance, and probably better

today the freebasic code of the minz c, is not avalaible but you can use the static libs to use it on freebasic. (one example on github with static libs)
At the cost of some kbytes on your executable.

you can also use the static libs for zlib, the resulting executable will increase much more than with minz (also in github)
but no need for the dll to be intalled in the pc.

i'm curently testing a new one : lzoma wich gives a better compression ratio, at a slower compression time, but fast decompression
i've already the lib, and the decompressed code converted to freebasic (not sure, i will convert the compression part, too fuzzy c code)
i will put it soon in github

to finish, if you are really interrested on compression tools see here : https://github.com/powturbo/TurboBench


remarks on your project :
interresting to embedd ressources into exe
but in my vision if you use only windows system , why not use the RCDATA to do it
the process would be like the following

1 convert the files you want to embedd
2 define them on the rc file
3 use the win api functions to get them on the executable

the interrest is, if you modify the embedded ressource, nothing to change in your code.

in fact i never use raw data on my code, borring to copy/past the raw buffer to the code.

if you want to use different os than windows, you can use incbin assembler feature to do the inclusion for you .
You can find examples on that forum, search with incbin
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: FB File2Bas Code Generator v0.99 beta [Windows only]

Post by UEZ »

@marpon: thank you for your reply. I will definitely have a look to the other compression functions.

Well, there are many ways to add binary data to the compiled exe and one of these is this method. The reason why I've chosen it is historical because I've created something like this in the past for AutoIt and I like this way. ^^

That the code is limit to Windows only might be a disadvantage for the FreeBasic community but for me as a Windows only user it's ok. :-)

This code will generate the code to a file and/or to the clipboard. Thus it shouldn't be that much elaborate to modify it especially when you use separate files which will be included within your code. The disadvantage might be the length of the compiled exe which might be larger than using resources.
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: FB File2Bas Code Generator v0.99 beta [Windows only]

Post by marpon »

as in example a code to embeed files just using rcdata

as simple as that

Code: Select all

#include once "windows.bi"

'compile with -x "D:\freebasic\samples\res_embeed.exe" -w pedantic  -s console -v res_embeed.bas XXX_TEMP.RC > res_embeed.log 2>&1



'example of rc file named  XXX_TEMP.RC

/'  
	//_BEGIN_RC_
	// comment in RC with 2 slashs

	first_file      RCDATA    "blabla.txt"  			//  first file to embeed
	second_file	  	RCDATA    "test_coucou.log"			//  second file to embeed
	
	//_END_RC_
'/  

type mystring                                                       ' dummy string type to mimic the normal fbstring type
        data1   as zstring ptr                                      '  and make a simple cast for it
        len1    as integer
        size1   as integer
end type


function tostring(byval ub as ubyte ptr , byval ilen as long) as string
    dim         as mystring s_my
    s_my.data1 = cast(zstring ptr , ub)
    s_my.len1 = ilen
    s_my.size1 = ilen + 1
    dim as string ptr pret = cast(string ptr , @s_my)
    return * pret
end function

Private FUNCTION EmbeddedBuffer(byref ResName AS STRING , byref sBuffer as string) AS LONG
   dim lRet1             AS HRSRC
   dim lRet2             AS HGLOBAL
   dim dRet1             AS ULONG
   dim dRet2             AS LPVOID


   lRet1 = FindResource(NULL , strptr(ResName) , RT_RCDATA)
   IF lRet1 = NULL THEN return - 1               'could not find the res so exit
   dRet1 = SizeofResource(NULL , lRet1)
   '? dRet1
   IF dRet1 = 0 THEN return - 2
   lRet2 = LoadResource(NULL , lRet1)
   IF lRet2 = NULL THEN return - 3
   dRet2 = LockResource(lRet2)
   IF dRet2 = NULL THEN return - 4
   sBuffer = tostring(cast(ubyte ptr , dRet2) , dRet1)
   return dRet1
END FUNCTION

print "first file" : print: print
dim as string s1 

dim as long iret1 = EmbeddedBuffer( "first_file" , s1)


if iret1 > 0 THEN
	print left(s1, 250)
else
	print "error getting embedded data"	
END IF

print: print :print "second file" : print
iret1 = EmbeddedBuffer( "second_file" , s1)


if iret1 > 0 THEN
	print left(s1, 250)
else
	print "error getting embedded data"	
END IF
print: print: print "press any key to continue"

sleep
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: FB File2Bas Code Generator v0.99 beta [Windows only]

Post by marpon »

as on example, a code to embeed files just using incbin

Code: Select all


#Macro Macro_IncCommunEx(label , file , sectionName)
	dim label##_data as UByte Ptr
    dim label##_size as ULong
    #If __FB_DEBUG__
        asm jmp .LT_END_OF_FILE_##label##_DEBUG_JMP
    #Else
        asm .section sectionName                 		' Switch to/Create the specified section
    #EndIf
    asm .LT_START_OF_FILE_##label##:             		' Assign a label to the beginning of the file
    asm __##label##__start = .                   		' Include the file
    asm .incbin ##file
    asm __##label##__len = . - __##label##__start		' Mark the end of the the file
    asm .LT_END_OF_FILE_##label##:
    'asm .LONG 0 										'Pad it with a NULL Long (harmless, yet useful for text files)
    #If __FB_DEBUG__
        asm .LT_END_OF_FILE_##label##_DEBUG_JMP:
    #Else
        asm .section .text                       		' Switch back to the .text (code) section
        asm .balign 16                           		'was asm .balign 16
    #EndIf
	asm .LT_SKIP_FILE_##label##:
	asm mov dword ptr [label##_data] , offset .LT_START_OF_FILE_##label
	asm mov dword ptr [label##_size] , offset __##label##__len
	label##_ptr = label##_data
	label##_len = label##_size


#EndMacro

#Macro Macro_IncFileEx(label , file , sectionName)
    #ifndef __INC__##label##__DEF__
        #define __INC__##label##__DEF__
        #If __FUNCTION__ = "__FB_MAINPROC__"
            dim shared label##_ptr as UByte Ptr
			dim shared label##_len as ULong
            sub Sub_Inc_##label##()
                Macro_IncCommunEx( label , file , sectionName )
            end sub
            Sub_Inc_##label##()
        #else
			dim label##_ptr as UByte Ptr
			dim label##_len as ULong
            Macro_IncCommunEx( label , file , sectionName )
        #endif
    #else
        #error ===> error ##label## already defined
    #endif
#EndMacro

type mystring                                                       ' dummy string type to mimic the normal fbstring type
        data1   as zstring ptr                                      '  and make a simple cast for it
        len1    as integer
        size1   as integer
end type


function tostring(byval ub as ubyte ptr , byval ilen as long) as string
    dim         as mystring s_my
    s_my.data1 = cast(zstring ptr , ub)
    s_my.len1 = ilen
    s_my.size1 = ilen + 1
    dim as string ptr pret = cast(string ptr , @s_my)
    return * pret
end function


'use FILE1 as prefix
Macro_IncFileEx(FILE1 , "blabla.txt" , .Data)

'use FILE2 as prefix
Macro_IncFileEx(FILE2 , "test_coucou.log" , .Data)

print "first file" : print: print

dim as string s1
dim as long iret1 = FILE1_len
s1 = tostring(cast(ubyte ptr,FILE1_ptr), FILE1_len)

if iret1 > 0 THEN
	print left(s1, 250)
else
	print "error getting embedded data"	
END IF

print: print :print "second file" : print


iret1 = FILE2_len
s1 = tostring(cast(ubyte ptr,FILE2_ptr), FILE2_len)


if iret1 > 0 THEN
	print left(s1, 250)
else
	print "error getting embedded data"	
END IF
print: print: print "press any key to continue"

sleep


this one is portable not limited to windows and easier, do not need external rc file
Post Reply