PDA

View Full Version : [SOLVED:] Display Image from Binary data without writing to file



Movian
10-14-2014, 07:02 AM
Hey,
so due to some new security requirements we are no longer allowed to store files on the file system and reference the location. We have to store the files in the database itself.....

I have implemented a setup that will allow me to import and export binary files to and from a database table varbinary(max) field...

however some of these items I would like to be able to have the user view without writing to a file again... for example if they store a png or gif image I would like to be able to retrieve the binary data and push that to an image control to show the file on the form without writing the image to disk then pointing the image control at that location.

down the road I would also like to be able to do this with PDF files but one step at a time.

As always any help/ suggestions / links are appreciated.

Movian
10-14-2014, 02:45 PM
as always after I post I don't just stop looking!

Still not there but have some progress, I had a brain wave and added a Microsoft Webbrowser ActiveX control to my form and with a little research I discovered this page

http://ben.lobaugh.net/blog/33713/using-binary-image-data-to-display-an-image-in-html

which provides information on displaying images from Base64 stings, after a little more research I discovered this set of functions

http://thydzik.com/vb6vba-functions-to-convert-binary-string-to-base64-string/

which should let me convert the binary string I get from the following functions

Function ReadBinaryFile(filename) Const adTypeBinary = 1

'Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")

'Specify stream type - we want To get binary data.
BinaryStream.Type = adTypeBinary

'Open the stream
BinaryStream.Open

'Load the file data from disk To stream object
BinaryStream.LoadFromFile filename

'Open the stream And get binary data from the object
ReadBinaryFile = BinaryStream.Read
End Function
Function ImportFile(BinaryData, filename As String, FileType As String)
Dim SQL As String
Dim Conn As ADODB.Connection
Dim RS As ADODB.Recordset
'Create SQL command To retrieve data
SQL = "SELECT * FROM tblFileStore WHERE 1=0"

'Get connection To SQL database
Set Conn = CurrentProject.Connection
Set RS = CreateObject("ADODB.Recordset")
RS.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText

'AddNew - new row To the recordset
RS.AddNew

'Set source BinaryData To BinaryColumn
RS("FileData") = BinaryData
RS("MedicalID") = Forms("frmMain").MedicalID
RS("FileName") = filename
RS("FileTYpe") = FileType
RS("CreationDate") = Date

'Use this code instead of previous line For ORACLE.
'RS("BinaryColumn").AppendChunk BinaryData
'Store data To database
RS.Update


'Or using one-row AddNew only - instead of AddNew + Update
'RS.AddNew Array("BinaryColumn", "Description"), _
' Array(BinaryData, Description)

'Get an ID of currently added row.
ImportFile = RS("FileID")
End Function

So I have the binary data available and the functions ready but am having some problems implementing the solution.....

I have implemented the following on a listbox double click (to select the file to display)


Private Sub LstFiles_DblClick(Cancel As Integer)If Not IsNull(Me.LstFiles) And Not Me.LstFiles = "" Then
Dim myrs As New ADODB.Recordset
Dim Stream As String


myrs.Open "SELECT * FROM tblFileStore WHERE FIleid = '" & Me.LstFiles & "'", CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Stream = "<Html><head></head><body>"
Stream = Stream & "<img srv='data:image/" & myrs("filetype") & ";base64," & encodeBase64(bin2Byte(myrs("FileData"))) & "'>"
Stream = Stream & "</body></html>"

Me.FileBrowser.Document.Open
Me.FileBrowser.Document.Write Stream
Me.FileBrowser.Document.Close
Me.FileBrowser.Refresh
On Error Resume Next
myrs.Close
Set myrs = Nothing
On Error GoTo 0
End If
End Sub

however this produces an error at the following line in bin2byte - Type mismatch


bytes(byteCount) = bytes(byteCount) + CLng(Mid$(sByte, 8 - i, 1)) * 2 ^ i

the image being used is a Gif image

just trying to slot together the last pieces of this puzzle!

Movian
10-15-2014, 06:39 AM
Ok so baby steps

have taken a step further and have the image displaying on the screen! the secret aparently was that I needed to setup an adodb.stream to handle the data coming back out of the varbinary(max) field.

have one small problem remaining though....


The following code will work, however it writes a copy of the file to disk (I was doing testing) binarystream.savefile myrs("Filedata") this then allows binarystream.read to function and pushes the data to the base64 encoding system that then outputs the correct format for displaying in HTML.

HOWEVER if I remove the file write line.... the binarystream.read returns nothing.... not sure why but as it stands the way I have it laid out the filesave seems to do something important to allow me to read the data correctly from the binary stream... as the whole point of the exercise is to display the file WITHOUT writing a file to disk this posses a problem.


Private Sub LstFiles_DblClick(Cancel As Integer)If Not IsNull(Me.LstFiles) And Not Me.LstFiles = "" Then
Dim myrs As New ADODB.Recordset
Dim Stream As String, ImageData As String
Dim binaryStream As New ADODB.Stream

myrs.Open "SELECT * FROM tblFileStore WHERE FileID = '" & Me.LstFiles & "'", CurrentProject.Connection, adOpenKeyset, adLockReadOnly

'Specify stream type - we want To save binary data.
binaryStream.Type = adTypeBinary

'Open the stream And write binary data To the object
binaryStream.Open
binaryStream.Write myrs("FileData")

binaryStream.SaveToFile "C:\"
'Start HTML generation
Stream = "<Html><head></head><body>"
Stream = Stream & "<img src=" & """" & "data:image/" & myrs("filetype") & ";base64," & encodeBase64(binaryStream.Read) & """" & ">"
Stream = Stream & "</body></html>"

Me.FileBrowser.Document.Open
Me.FileBrowser.Document.Write Stream
Me.FileBrowser.Document.Close
Me.FileBrowser.Refresh
On Error Resume Next
myrs.Close
Set myrs = Nothing
On Error GoTo 0

binaryStream.Close
End If
End Sub

I did also change to different functions for encoding the binary data.


Private Function encodeBase64(bytes) Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.createElement("tmp")
EL.DataType = "bin.base64"
' Set bytes, get encoded String
'Convert byte string to byte array

EL.nodeTypedValue = bytes
encodeBase64 = EL.text
End Function

Private Function decodeBase64(base64)
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.createElement("tmp")
EL.DataType = "bin.base64"
' Set encoded String, get bytes
EL.text = base64
decodeBase64 = EL.nodeTypedValue
End Function

Movian
10-15-2014, 07:18 AM
Ok after MORE research it appears that after a write to the stream the current position is left at the end of the stream for some reason..... so when you use the read command it reads from the current possition and gets nothing ... because its at the end.

replacing the binarystream.savetofile line with the following


binarystream.position = 0

resolved the problem as this sets the current position back to the start of the stream and allows the read to go from that position.

Hope this will help someone else in the future!!! ^_^