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"
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!(¿!!"
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!$!!!"
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"
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"
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"
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ª:"
AiO download: FB File2Bas Code Generator v1.01 build 2020-05-25 beta.zip