I like more the method to load from memory directly instead of saving it first to disk. :-)
Here my version using base64 and compression to embed an image to exe and load it directly from mem using your code just for comparison with this method of this topic.
Code: Select all
#Include "bob.bas"
#Include Once "crt/String.bi"
'needed for lzmat
Type info_t
g_inbuf As Ubyte Ptr
g_outbuf As Ubyte Ptr
g_inbuf_pos As Long
g_outbuf_pos As Long
g_bit_buf As Long
g_bit_count As Long
End Type
#Define A_BITS_DEF 1 '' 1 xx 2
#Define B_BITS_DEF 2 '' 01 xx 2
#Define C_BITS_DEF 3 '' 001 xx 2
#Define D_BITS_DEF 5 '' 0001 xxx 3
#Define E_BITS_DEF 7 '' 00001 xxxxx 5
#Define F_BITS_DEF 9 '' 00000 xxxxxxxxx 9
#Define A_DEF (1 Shl A_BITS_DEF)
#Define B_DEF ((1 Shl B_BITS_DEF) + A_DEF)
#Define C_DEF ((1 Shl C_BITS_DEF) + B_DEF)
#Define D_DEF ((1 Shl D_BITS_DEF) + C_DEF)
#Define E_DEF ((1 Shl E_BITS_DEF) + D_DEF)
#Define F_DEF ((1 Shl F_BITS_DEF) + E_DEF)
#Define SLOT_BITS_DEF 4
#Define NUM_SLOTS_DEF (1 Shl SLOT_BITS_DEF)
#Define W_BITS_DEF 19
#Macro FILL_OUT_MACRO(xbuf , d1 , d2)
xbuf[d1] = xbuf[d2]
d1 += 1
d2 += 1
#Endmacro
Private Sub init_bits(Byval inbuf As Ubyte Ptr, Byval outbuf As Ubyte Ptr, Byval tinfo As info_t Ptr)
tinfo->g_bit_count = 0
tinfo->g_bit_buf = 0
tinfo->g_inbuf_pos = 0
tinfo->g_outbuf_pos = 0
tinfo->g_inbuf = inbuf
tinfo->g_outbuf = outbuf
End Sub
Private Function get_bits(Byval n As Long, Byval tinfo As info_t Ptr) As Long
While tinfo->g_bit_count < n
tinfo->g_bit_buf Or= tinfo->g_inbuf[tinfo->g_inbuf_pos] Shl tinfo->g_bit_count
tinfo->g_inbuf_pos += 1
tinfo->g_bit_count += 8
Wend
Dim x As Long = tinfo->g_bit_buf And ((1 Shl n) - 1)
tinfo->g_bit_buf Shr= n
tinfo->g_bit_count -= n
Return x
End Function
Private Function lzmat_uncompress(Byval outbuf As Ubyte Ptr, Byval outsize As Long, Byval inbuf As Ubyte Ptr) As Long
If inbuf = NULL Then
'fprintf(stderr, !"Compressed buffer corrupted!\n")
Return -1
End If
If outsize < 1 Or outbuf = NULL Then
'fprintf(stderr, !"Decompression buffer corrupted: size=%d\n", outsize)
Return -2
End If
Dim tinfo As info_t
init_bits(inbuf + 4, NULL, @tinfo)
Dim p As Long = 0
While p < outsize
If get_bits(1, @tinfo) Then
Dim len0 As Long
If get_bits(1, @tinfo) Then
len0 = get_bits(A_BITS_DEF, @tinfo)
Elseif get_bits(1, @tinfo) Then
len0 = get_bits(B_BITS_DEF, @tinfo) + A_DEF
Elseif get_bits(1, @tinfo) Then
len0 = get_bits(C_BITS_DEF, @tinfo) + B_DEF
Elseif get_bits(1, @tinfo) Then
len0 = get_bits(D_BITS_DEF, @tinfo) + C_DEF
Elseif get_bits(1, @tinfo) Then
len0 = get_bits(E_BITS_DEF, @tinfo) + D_DEF
Else
len0 = get_bits(F_BITS_DEF, @tinfo) + E_DEF
End If
Dim log0 As Long = get_bits(SLOT_BITS_DEF, @tinfo) + (W_BITS_DEF - NUM_SLOTS_DEF)
Dim s As Long = (Not Iif(log0 > (W_BITS_DEF - NUM_SLOTS_DEF), _
get_bits(log0, @tinfo) + (1 Shl log0), _
get_bits(W_BITS_DEF - (NUM_SLOTS_DEF - 1), @tinfo))) + p
If s < 0 Then
'fprintf(stderr, !"Compressed buffer corrupted: s=%d\n", s)
Return -3
End If
FILL_OUT_MACRO(outbuf, p, s)
FILL_OUT_MACRO(outbuf, p, s)
FILL_OUT_MACRO(outbuf, p, s)
While len0 <> 0
FILL_OUT_MACRO(outbuf, p, s)
len0 -= 1
Wend
Else
outbuf[p] = get_bits(8, @tinfo)
p += 1
End If
Wend
Return p
End Function
'original code by D.J.Peters
Function Base64Decode(sString As String, Byref iBase64Len As Uinteger) As Ubyte Ptr
#Define P0(p) Instr(B64, Chr(sString[n + p])) - 1
Dim As String*64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim As String sDecoded
Dim As Long nChars = Len(sString) - 1
If nChars < 0 Then Return 0
For n As Long = 0 To nChars Step 4
Var b = P0(1), c = P0(2), d = P0(3)
If b >-1 Then
Var a = P0(0)
sDecoded += Chr((a Shl 2 + b Shr 4))
End If
If c > -1 Then sDecoded += Chr((b Shl 4 + c Shr 2))
If d > -1 Then sDecoded += Chr((c Shl 6 + d ))
Next
iBase64Len = Len(sDecoded)
'workaround For multiple embedded file other crash will occure
Static As Ubyte aReturn(0 To iBase64Len - 1)
Redim aReturn(0 To iBase64Len - 1) As Ubyte
For i As Ulong = 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
Function reverse(Byref im As Ulong Ptr) As Any Ptr
#Define ppset(_x,_y,colour) *Cptr(Ulong Ptr,row+ (_y)*pitch+ (_x) Shl 2) =(colour)
#Define ppoint(_x,_y) *Cptr(Ulong Ptr,row + (_y)*pitch + (_x) Shl 2)
Dim As Integer pitch
Dim As Any Ptr row
Dim As Ulong Ptr pixel
Dim As Integer dx,dy,sz
Imageinfo im,dx,dy,,pitch,row,sz
' ' leopard's way...
dx -= 1 : dy -= 1
Dim As Ulong tempclr
For y As Integer=0 To dy
For x As Integer=0 To dx \ 2
tempclr = ppoint(x,y)
ppset (x,y,ppoint((dx)-x,y))
ppset ((dx)-x,y,tempclr)
Next x
Next y
Return im
End Function
Function bmpload(s As Ubyte Ptr, l As Ulong) As Ulong Ptr
Static As Ulong Ptr u : u=New Ulong[l-1]
u[0]=7
u[1]=4
u[2]=*Cast(Ulong Ptr,@s[18])
u[3]=*Cast(Ulong Ptr,@s[22])
u[4]=(u[2]*4)
u[5]=0
u[6]=0
u[7]=0
Dim As Long ctr=7
Var k=Iif(u[2] Mod 16=0,1,0)
For n As Long=8 To l+6 Step 3+k
ctr+=1
u[ctr]=*Cast(Ulong Ptr,@s[55-k+n])
Next
ctr -= 7
u=reverse(u)
For n As Long=8 To ctr\2
Swap u[n],u[ctr-n]
Next
Return u
End Function
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 = Base64Decode(sBase64, iCompressedSize)
Dim As Ubyte Ptr aBinaryC = Allocate(iFileSize)
lzmat_uncompress(aBinaryC, iFileSize, aBinary)
Screenres 200, 200, 32,, 8 'GFX_NO_FRAME
Put(0, 0), bmpload(aBinaryC, iFileSize), Pset
Sleep
Deallocate(aBinaryC)
aBinary = 0
sBase64 = ""
Btw, a funny effect on my avatar image when commenting out ppset (x,y,ppoint((dx)-x,y)) in the reverse function:
