Converting a Gif To String To Byte Array..

junderhill99
06-02-2005, 12:41 AM
Hi
Been mulling over this one for a while so I thought I'd reach out..

So here's the thing: what I would like to do, is open a small transparent gif in a text editor, (assuming conversion to ascii here), copy the string and assign it to a string variable within vb, and then have that converted in turn to a byte array. The image is passed to winsock in response to a loopback request (hosts file), and returns the small transparent gif. (popup blocker)
Now I have something that works now, I simply renamed the .gif to .dat and use a binary read to load it into the byte array, but what I want to do is use a string within vb, and so do away with the external file dependance.

Here's what I have that IS working..

Working Example 1:

Dim bytArray() As Byte
Dim lSize As Long
Dim MyFile As String

On Local Error Resume Next

MyFile = App.Path & "\fill.dat"
With frmMenu.wskAdv(requestID) //winsock
lSize = FileLen(MyFile)
ReDim bytArray(1 To lSize) As Byte
Open MyFile For Binary Access Read As #1 //file
Get #1, 1, bytArray()
.SendData bytArray //more winsock
Close #1
End With

AdCount = AdCount + 1 //counters and such
Update_Tray
MsgWaitObj 100
frmMenu.wskAdv(requestID).Close
Unload frmMenu.wskAdv(requestID)

On Error GoTo 0
I thought some variation of the following would work, but for reasons that are unclear to me, it doesn't..

Not Working 2:

With frmMenu.wskAdv(requestID)

//image text as taken from notepad
bFillStr = "GIF89a  ! ,   Q ;"
ReDim bytArray(Len(bFillStr) - 1)

For lSize = 1 To Len(bFillStr)
bytArray(lSize - 1) = Asc(Mid(bFillStr, lSize, 1))
Next lSize

.SendData bytArray()
.Close
End With

MsgWaitObj 100
frmMenu.wskAdv(requestID).Close
Unload frmMenu.wskAdv(requestID)


So what I don't understand is why the first one works, but not the second.. I have tried using StrConv, and turning it into unicode before processing the string, and many variations on the above code, but can't seem to get it working..

Any ideas??

Appreciate the help
JohnYou can use .. tags to mark up your code. See here (http://www.xtremevbtalk.com/misc.php?do=bbcode) for more about tags.

RoofRabbit
06-02-2005, 02:09 AM
I believe you can only send the standard ascii characters but not characters like "  ! ,   ". The "" usually indicates a zero value byte but could be any undisplayable character. To send exact data, you have to know the values of these exactly.
If you already have the data in a byte array, just send the bytes as strings.

Quickly done code:

Dim ByteArray(7) As Byte
'
Dim TS As String
'
Private Sub Form_Load()
Dim i As Integer
ByteArray(0) = 46
ByteArray(1) = 191
ByteArray(2) = 212
ByteArray(3) = 3
ByteArray(4) = 19
ByteArray(5) = 7
ByteArray(6) = 96
ByteArray(7) = 184
TS = ""
For i = 0 To 6
TS = TS & ByteArray(i) & ","
Next i
TS = TS & ByteArray(7)
Label1.Caption = TS
End Sub

Diurnal
06-02-2005, 09:39 AM
If you are trying to create your own hex string or even just a byte array, use the Input$() function on your file and then convert the string into a byte array using the StrConv() function. You can work on the array and use it to create a hex string of the byte array:

'Open a file and dump the bytes to the debug window.

Dim hFile As Integer
Dim i As Long, j As Long
Dim b() As Byte
Dim sText As String

'Get a handle.
hFile = FreeFile()

'Get the file data.
Open sFile For Binary As hFile
sText = Input$(LOF(hFile), hFile)
Close hFile

'Convert the text into a byte array.
b() = StrConv(sText, vbFromUnicode)

'Change the decimal bytes into a hex string with spaces between characters.
sText = Space$(3 * (UBound(b()) + 1))
j = 1
For i = 1 To UBound(b())
Mid$(sText, j, 2) = Right$("00" & Hex$(b(i)), 2)
j = j + 3
Next i

'Print the output.
Debug.Print sText

junderhill99
06-02-2005, 03:52 PM
k, here's what I have done so far..
I used the hex conversion to change the gif file to a string of hex chars.

<vb>
Dim hFile As Integer
Dim i As Long, j As Long
Dim b() As Byte
Dim sText As String
Dim sFile As String

sFile = "D:\Component Flat\fill2.dat"
hFile = FreeFile()

Open sFile For Binary As hFile
sText = Input$(LOF(hFile), hFile)
Close hFile

b() = StrConv(sText, vbFromUnicode)
sText = Space$(3 * (UBound(b()) + 1))
j = 1
For i = 1 To UBound(b())
Mid$(sText, j, 2) = Right$("00" & Hex$(b(i)), 2)
j = j + 3
Next i

Open "c:\testout.txt" For Append As #1
Print #1, sText
Close #1
</vb>

But a question here, the hex output adds some spaces and a carriage return to the text file that are not added as hex chars, I put a counter on the original sub, (that opens the .dat image file), and it counts 143 char, the hex version counts 140.. so what/where are the missing hex chars??

I then put together this sub with the hex string, but alas.. still not working:

<vb>
Dim BytArr() As Byte
Dim sTest As String
Dim aTest() As String
Dim i As Long
Dim lSize As Long

sTest = "49 46 38 39 61 14 00 14 00 B3 00 00 66 FF 00 A5 FF 69 DA " & _
"FF C1 7D FF 27 BF FF 95 F4 FF ED 8B FF 3D 9B FF 58 CD FF " & _
"AB B2 FF 7F 6A FF 07 FF FF FF 00 00 00 00 00 00 00 00 00 " & _
"00 00 00 21 F9 04 05 14 00 0B 00 2C 00 00 00 00 14 00 14 " & _
"00 00 04 3B 70 C9 49 AB BD 38 EB CD BB 5F 06 40 09 00 C1 " & _
"01 C6 A4 0C 1D 01 08 4B 00 14 DE F0 02 C9 B7 00 80 A2 2F " & _
"07 00 E2 C7 F3 7D 6C A4 5C EB 15 9B 75 50 2A D6 26 34 2A " & _
"FD AE D8 EC 26 02 00 3B"


aTest = Split(sTest, " ")
lSize = UBound(aTest) 'shy three characters, first lsize(see top of post), count is 143

With frmMenu.wskAdv(requestID)
ReDim BytArr(1 To lSize)
For i = 1 To lSize
BytArr(i) = CLng("&H" & aTest(i))
Next i
.SendData BytArr()
End With

AdCount = AdCount + 1 'close connection/counters/tray update
Update_Tray
MsgWaitObj 100
frmMenu.wskAdv(requestID).Close
Unload frmMenu.wskAdv(requestID)
</vb>

Not sure why this version is not working, I suspect it is either the conversion back to decimal, or the missing characters..

Any ideas??

Thanks
John

Diurnal
06-02-2005, 05:28 PM
Maybe it's best not to involve StrConv and stick with byte arrays. I changed the code to create a byte array from the gif image and copy that array to a file. Then a string is created from the byte array and saved as a text file. This string is then converted back into a byte array and saved as a gif image. I hope this helps:

Option Explicit

Private Sub Form_Load()
Call DumpHex("d:\testgif.gif")
End Sub

Private Sub DumpHex(ByVal sFile As String)
'Input a file to dump in hex.

Dim hFile As Integer
Dim i As Long, j As Long
Dim b() As Byte
Dim bNew() As Byte
Dim sText As String

'Get the file data into a byte array.
hFile = FreeFile()
Open sFile For Binary As hFile
ReDim b(0 To LOF(hFile) - 1)
For i = 0 To UBound(b())
Get hFile, i + 1, b(i)
Next i
Close hFile

'Save a copy of the gif file from the byte array.
hFile = FreeFile()
Open "D:\Copy.gif" For Binary As hFile
For i = 0 To UBound(b())
Put hFile, i + 1, b(i)
Next i
Close hFile

'Convert the byte array to a readable hex string.
sText = Space$(2 * (UBound(b()) + 1))
j = 1
For i = 0 To UBound(b())
Mid$(sText, j, 2) = Right$("00" & Hex$(b(i)), 2)
j = j + 2
Next i

'Save a copy of the readable hex string.
hFile = FreeFile()
Open "D:\DumpHex.txt" For Binary As hFile
Put hFile, , sText
Debug.Print LOF(hFile)
Close hFile

'Convert the readable hex string into a byte array.
j = 0
ReDim bNew(0 To Len(sText) \ 2)
For i = 1 To Len(sText) Step 2
bNew(j) = CLng("&H" & Mid$(sText, i, 2))
j = j + 1
Next i

'Save the byte array as gif image
hFile = FreeFile()
Open "D:\DumpHex.gif" For Binary As hFile
For i = 0 To UBound(bNew())
Put hFile, i + 1, bNew(i)
Next i
Debug.Print LOF(hFile)
Close hFile

End Sub

junderhill99
06-02-2005, 07:11 PM
Maybe it's best not to involve StrConv and stick with byte arrays. I changed the code to create a byte array from the gif image and copy that array to a file. Then a string is created from the byte array and saved as a text file. This string is then converted back into a byte array and saved as a gif image. I hope this helps:

Option Explicit

Private Sub Form_Load()
Call DumpHex("d:\testgif.gif")
End Sub

Private Sub DumpHex(ByVal sFile As String)
'Input a file to dump in hex.

Dim hFile As Integer
Dim i As Long, j As Long
Dim b() As Byte
Dim bNew() As Byte
Dim sText As String

'Get the file data into a byte array.
hFile = FreeFile()
Open sFile For Binary As hFile
ReDim b(0 To LOF(hFile) - 1)
For i = 0 To UBound(b())
Get hFile, i + 1, b(i)
Next i
Close hFile

'Save a copy of the gif file from the byte array.
hFile = FreeFile()
Open "D:\Copy.gif" For Binary As hFile
For i = 0 To UBound(b())
Put hFile, i + 1, b(i)
Next i
Close hFile

'Convert the byte array to a readable hex string.
sText = Space$(2 * (UBound(b()) + 1))
j = 1
For i = 0 To UBound(b())
Mid$(sText, j, 2) = Right$("00" & Hex$(b(i)), 2)
j = j + 2
Next i

'Save a copy of the readable hex string.
hFile = FreeFile()
Open "D:\DumpHex.txt" For Binary As hFile
Put hFile, , sText
Debug.Print LOF(hFile)
Close hFile

'Convert the readable hex string into a byte array.
j = 0
ReDim bNew(0 To Len(sText) \ 2)
For i = 1 To Len(sText) Step 2
bNew(j) = CLng("&H" & Mid$(sText, i, 2))
j = j + 1
Next i

'Save the byte array as gif image
hFile = FreeFile()
Open "D:\DumpHex.gif" For Binary As hFile
For i = 0 To UBound(bNew())
Put hFile, i + 1, bNew(i)
Next i
Debug.Print LOF(hFile)
Close hFile

End Sub



Hi Diurnal
This is exactly what I was looking for..
Thanks for your help, it sure saved me a lot of time.
The sub, (if anyone is interested came out as:


Public Sub Request_Data(ByVal requestID As Long)

Dim BytArr() As Byte
Dim sText As String
Dim i As Long
Dim j As Long

On Local Error Resume Next

sText = "47494638396114001400B3000066FF00A5FF69DAFFC17DFF27BFFF95F4FFED8BFF" & _
"3D9BFF58CDFFABB2FF7F6AFF07FFFFFF00000000000000000000000021F9040514" & _
"000B002C000000001400140000043B70C949ABBD38EBCDBB5F06400900C101C6A4" & _
"0C1D01084B0014DEF002C9B70080A22F0700E2C7F37D6CA45CEB159B75502AD626" & _
"342AFDAED8EC2602003B" 'green x

'sText = "47494638396101000100910000000000FFFFFFFFFFFF00000" & _
'"021F90405140002002C00000000010001000002025401003B" invisible

With frmMenu.wskAdv(requestID)

j = 0
ReDim BytArr(0 To Len(sText) \ 2)
For i = 1 To Len(sText) Step 2
BytArr(j) = CLng("&H" & Mid$(sText, i, 2))
j = j + 1
Next i

.SendData BytArr
End With

AdCount = AdCount + 1
Update_Tray
MsgWaitObj 100
frmMenu.wskAdv(requestID).Close
Unload frmMenu.wskAdv(requestID)

On Error GoTo 0

End Sub


Part of an ad blocker feature in a much (much..) larger program..
Essentially, the hosts file resolves well known ad delivery sites,
ex. 127.0.0.1 ad.doubleclick.net
When the winsock interface gets a request from the loopback address, it
returns a 1x1 invisible gif.
The last thing I had to write into this was the byte array/hex bit, as I didn't wan't to rely on a resource when I knew it could be done programmatically.

Thanks again, you were a great help
John

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum