"The Frog" <Mr************ @googlemail.com wrote in message
news:0c******** *************** ***********@g21 g2000hsh.google groups.com...
Hi Tony,
<SNIP>
I will have a play with the DLL option and storing it in the app
itself, and dragging it out when necessary. I will keep you posted
with the progress. Probably wont have the time till next week though
to post any code on this one.
Cheers and thanks for your help
The Frog
You can try this module if you like. I've been using it successfully for
years, to "create" DLL's, icons, pictures and gen. purpose binary data. The
two main routines are FileToBinaryDat a and BinaryDataToFil e. The module as
it stands is intended to live in a library mdb. If you wish to use it in a
FE, simply change all CodeDB references to CurrentDb.
It requires a table tblBinaryData, with the structure:
Item Text 50
Value OLE Object
Item is the primary key.
''' CODE START '''
Option Compare Database
'
Private Const TPL_SELECT = "Select Value From tblBinaryData Where Item='?'"
Public Function GetBinaryData(B yVal Item$) As String
'Returns a binary item from tblBinaryData as a string
On Error GoTo GetBinaryData_E rr
'
With CodeDb.OpenReco rdset(Replace(T PL_SELECT, "?", Item),
dbOpenSnapshot)
GetBinaryData = !Value
.Close
End With
GetBinaryData_E xit:
Exit Function
GetBinaryData_E rr:
Resume GetBinaryData_E xit
End Function
Public Function PutBinaryData(B yVal Item$, ByVal Value$) As Boolean
'Stores a binary item in tblBinaryData
'Returns True for success
On Error GoTo PutBinaryData_E rr
'
With CodeDb.OpenReco rdset("tblBinar yData", dbOpenDynaset)
.FindFirst "Item=" & Quoted(Item)
If .NoMatch Then
.AddNew
!Item = Item
Else
.Edit
End If
!Value = Value
.Update
.Close
End With
'
PutBinaryData = True
PutBinaryData_E xit:
Exit Function
PutBinaryData_E rr:
Resume PutBinaryData_E xit
End Function
Public Function DelBinaryData(B yVal Item$) As Boolean
'Deletes a binary item from tblBinaryData
'Returns True for success
On Error GoTo DelBinaryData_E rr
'
With CodeDb.OpenReco rdset(Replace(T PL_SELECT, "?", Item), dbOpenDynaset)
If .BOF Then Exit Function
.Delete
.Close
End With
'
DelBinaryData = True
DelBinaryData_E xit:
Exit Function
DelBinaryData_E rr:
Resume DelBinaryData_E xit
End Function
Public Function FileToBinaryDat a(ByVal File$, ByVal Item$) As Boolean
'Retrieves a binary item from a file and stores it in tblBinaryData
'Returns True for success
On Error GoTo FileToBinaryDat a_Err
'
b$ = BinFileToString (File)
If b = "" Then Exit Function
FileToBinaryDat a = PutBinaryData(I tem, b)
FileToBinaryDat a_Exit:
Exit Function
FileToBinaryDat a_Err:
Resume FileToBinaryDat a_Exit
End Function
Public Function BinaryDataToFil e(ByVal File$, ByVal Item$) As Boolean
'Retrieves a binary item from tblBinaryData and creates a file from it
'Returns True for success
On Error GoTo BinaryDataToFil e_Err
'
b$ = GetBinaryData(I tem)
If b = "" Then Exit Function
StringToBinFile b, File
'
BinaryDataToFil e = True
BinaryDataToFil e_Exit:
Exit Function
BinaryDataToFil e_Err:
Resume BinaryDataToFil e_Exit
End Function
Public Function BinFileToString (ByVal File) As String
'Returns a binary item retrieved from a file
On Error GoTo BinFileToString _Err
'
f% = FreeFile
Open File For Binary Access Read Lock Write As f%
b$ = Space$(LOF(f))
Get #f%, , b
Close f
'
BinFileToString = b
BinFileToString _Exit:
Exit Function
BinFileToString _Err:
MsgBox Err.Description , vbCritical, "modBinaryData. BinFileToString "
Resume BinFileToString _Exit
End Function
Public Function StringToBinFile (ByVal bin$, ByVal File$) As Boolean
'Creates a file from the passed string
'Returns True for success
On Error GoTo StringToBinFile _Err
'
If Dir(File) <"" Then Kill File
f% = FreeFile
Open File For Binary Access Write Lock Read As f
Put #f, , bin
Close f
'
StringToBinFile = True
StringToBinFile _Exit:
Exit Function
StringToBinFile _Err:
MsgBox Err.Description , vbCritical, "modBinaryData. StringToBinFile "
Resume StringToBinFile _Exit
End Function
''' CODE END '''
