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/us...-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-...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!