Storing .jpg in Access

[John King]

When .jpg is stored in an access database it is first rendered (turned into a .bmp/dib) and this rendering is stored with it - removing any storage advantage gained from converting the picture to .jpg - an important consideration given access's limit of 1Gb per mdb.


To overcome this, I renamed my .jpg files to .jpx files before inserting to the ole field. OK so far. Now I use a vb program to retrieve the records, data control and ole container. The image appears as an Icon in the ole container. Right clicking gives me the option to 'Edit Package'. I thus use the Object Packager to save my retrieved .jpx file to a file "picfile.jpg". I have an image control image1 on the form into which I load the picture with the following code behind the command button "image1.picture = LoadPicture("c:\abc\picfile.jpg")


I have achieved what I want ie Store a photograph in Access in .jpg format without the storage overhead of also storing the rendered image and be able to retrieve that photo and display it. (I do not want to store the .jpg in a directory and a referencein the db)


What I really want is to do all this in code - any ideas?

[siddharth_sp]

I could not understand your question very well...but what i could get is that
u want to store a JPEG pic in your access Database!!!!U don't want the Ref.
in the database but the image to be stored in access Database itself.....is i
am correct with what i say...then below is a piece of code which will help u
to solve your problem...Do check it:):)

'delete the temp file if it is already there
Kill GetTemporaryDirectory() & TEMPIMAGEFILENAME

'convert the ole object into a file
'Here Logo is a field in the table of type OLE
Call BlobToFile(objRecordSet.Fields("Logo"), GetTemporaryDirectory() & TEMPIMAGEFILENAME)

'load the image box
imgLogo.Picture = LoadPicture(GetTemporaryDirectory() & TEMPIMAGEFILENAME)

If Not Dir(GetTemporaryDirectory() & TEMPIMAGEFILENAME) = "" Then Kill GetTemporaryDirectory() & TEMPIMAGEFILENAME
Call SavePicture(imgLogo.Picture, GetTemporaryDirectory() & TEMPIMAGEFILENAME)
imgLogo.Picture = LoadPicture(GetTemporaryDirectory() & TEMPIMAGEFILENAME)
'update the record set
cmdLogo.Tag = GetTemporaryDirectory() & TEMPIMAGEFILENAME

'Below is a MOD..Please Insert the below code in a module
Option Explicit

Const BLOCK_SIZE = 16384

Sub BlobToFile(fld As ADODB.Field, ByVal FName As String, _
Optional FieldSize As Long = -1, _
Optional Threshold As Long = 1048576)
'
' Assumes file does not exist
' Data cannot exceed approx. 2Gb in size
'
Dim F As Long, bData() As Byte, sData As String
F = FreeFile
Open FName For Binary As #F
Select Case fld.Type
Case adLongVarBinary
If FieldSize = -1 Then ' blob field is of unknown size
WriteFromUnsizedBinary F, fld
Else ' blob field is of known size
If FieldSize > Threshold Then ' very large actual data
WriteFromBinary F, fld, FieldSize
Else ' smallish actual data
bData = fld.Value
Put #F, , bData ' PUT tacks on overhead if use fld.Value
End If
End If
Case adLongVarChar, adLongVarWChar
If FieldSize = -1 Then
WriteFromUnsizedText F, fld
Else
If FieldSize > Threshold Then
WriteFromText F, fld, FieldSize
Else
sData = fld.Value
Put #F, , sData ' PUT tacks on overhead if use fld.Value
End If
End If
End Select
Close #F
End Sub

Sub WriteFromBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FieldSize <> BytesRead
If FieldSize - BytesRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
BytesRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
BytesRead = BytesRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub

Sub WriteFromUnsizedBinary(ByVal F As Long, fld As ADODB.Field)
Dim Data() As Byte, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While LenB(Temp) = BLOCK_SIZE
End Sub

Sub WriteFromText(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data As String, CharsRead As Long
Do While FieldSize <> CharsRead
If FieldSize - CharsRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
CharsRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
CharsRead = CharsRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub

Sub WriteFromUnsizedText(ByVal F As Long, fld As ADODB.Field)
Dim Data As String, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While Len(Temp) = BLOCK_SIZE
End Sub

Sub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
Optional Threshold As Long = 1048576)
'
' Assumes file exists
' Assumes calling routine does the UPDATE
' File cannot exceed approx. 2Gb in size
'
Dim F As Long, Data() As Byte, FileSize As Long
F = FreeFile
Open FName For Binary As #F
FileSize = LOF(F)
Select Case fld.Type
Case adLongVarBinary
If FileSize > Threshold Then
ReadToBinary F, fld, FileSize
Else
Data = InputB(FileSize, F)
fld.Value = Data
End If
Case adLongVarChar, adLongVarWChar
If FileSize > Threshold Then
ReadToText F, fld, FileSize
Else
fld.Value = Input(FileSize, F)
End If
End Select
Close #F
End Sub

Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FileSize <> BytesRead
If FileSize - BytesRead < BLOCK_SIZE Then
Data = InputB(FileSize - BytesRead, F)
BytesRead = FileSize
Else
Data = InputB(BLOCK_SIZE, F)
BytesRead = BytesRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub

Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data As String, CharsRead As Long
Do While FileSize <> CharsRead
If FileSize - CharsRead < BLOCK_SIZE Then
Data = Input(FileSize - CharsRead, F)
CharsRead = FileSize
Else
Data = Input(BLOCK_SIZE, F)
CharsRead = CharsRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub


Public Function GetTemporaryDirectory() As String
' Purpose : to get the systems temporary path
' Description : uses the gettemppath api to get the systems temp path
=================================================

Dim strTempPath As String

strTempPath = Space$(1024)

Call GetTempPath(1024, strTempPath)
strTempPath = Trim$(strTempPath)
strTempPath = Left(strTempPath, Len(strTempPath) - 1)
GetTemporaryDirectory = CleanPath(strTempPath)

End Function

'Code for saving the selected file

'if an image was specified then save it
If Not cmdLogo.Tag = "" Then
If cmdLogo.Tag = "ClearMe" Then
objRecordSet!Logo = Null
Else
Call FileToBlob(cmdLogo.Tag, objRecordSet!Logo, 16384)

End If
objRecordSet.Update
Call CloseRecordSet(objRecordSet)
Call Sleep(1000)
End If

PLease let me know if any problems


Regards,
Sidds

S/W Developer
India.