Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

 
Option Explicit Const BlockSize = 32768 '************************************************************** ' FUNCTION: ReadBLOB() ' ' PURPOSE: ' Reads a BLOB from a disk file and stores the contents in the ' specified table and field. ' ' PREREQUISITES: ' The specified table with the OLE object field to contain the ' binary data must be opened in Visual Basic code (Access Basic ' code in Microsoft Access 2.0 and earlier) and the correct record ' navigated to prior to calling the ReadBLOB() function. ' ' ARGUMENTS: ' Source - The path and filename of the binary information ' to be read and stored. ' T - The table object to store the data in. ' Field - The OLE object field in table T to store the data in. ' ' RETURN: ' The number of bytes read from the Source file. '************************************************************** Function ReadBLOB(Source As String, T As Recordset, sField As String) Dim NumBlocks As Integer, SourceFile As Integer, i As Integer Dim FileLength As Long, LeftOver As Long Dim FileData As String Dim RetVal As Variant ' On Error GoTo Err_ReadBLOB ' Open the source file. SourceFile = FreeFile Open Source For Binary Access Read As SourceFile ' Get the length of the file. FileLength = LOF(SourceFile) If FileLength = 0 Then ReadBLOB = 0 Exit Function End If ' Calculate the number of blocks to read and leftover bytes. NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize ' SysCmd is used to manipulate status bar meter. RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", _ FileLength \ 1000) ' Put first record in edit mode. ' T.MoveFirst ' T.Edit T.AddNew ' Read the leftover data, writing it to the table. FileData = String$(LeftOver, 32) Get SourceFile, , FileData T(sField).AppendChunk (FileData) RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000) ' Read the remaining blocks of data, writing them to the table. FileData = String$(BlockSize, 32) For i = 1 To NumBlocks Get SourceFile, , FileData T(sField).AppendChunk (FileData) RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000) Next i ' Update the record and terminate function. T.Update RetVal = SysCmd(acSysCmdRemoveMeter) Close SourceFile ReadBLOB = FileLength Exit Function Err_ReadBLOB: ReadBLOB = -Err MsgBox "ReadBLOB Error " & Err & " : " & Error$ Exit Function End Function '************************************************************** ' FUNCTION: WriteBLOB() ' ' PURPOSE: ' Writes BLOB information stored in the specified table and field ' to the specified disk file. ' ' PREREQUISITES: ' The specified table with the OLE object field containing the ' binary data must be opened in Visual Basic code (Access Basic ' code in Microsoft Access 2.0 or earlier) and the correct ' record navigated to prior to calling the WriteBLOB() function. ' ' ARGUMENTS: ' T - The table object containing the binary information. ' sField - The OLE object field in table T containing the ' binary information to write. ' Destination - The path and filename to write the binary ' information to. ' ' ' RETURN: ' The number of bytes written to the destination file. '************************************************************** Function WriteBLOB(T As Recordset, sField As String, _ Destination As String) Dim NumBlocks As Integer, DestFile As Integer, i As Integer Dim FileLength As Long, LeftOver As Long Dim FileData As String Dim RetVal As Variant On Error GoTo Err_WriteBLOB ' Get the size of the field. FileLength = T(sField).FieldSize() If FileLength = 0 Then WriteBLOB = 0 Exit Function End If ' Calculate number of blocks to write and leftover bytes. NumBlocks = FileLength \ BlockSize LeftOver = FileLength Mod BlockSize ' Remove any existing destination file. DestFile = FreeFile Open Destination For Output As DestFile Close DestFile ' Open the destination file. Open Destination For Binary As DestFile ' SysCmd is used to manipulate the status bar meter. RetVal = SysCmd(acSysCmdInitMeter, _ "Writing BLOB", FileLength / 1000) ' Write the leftover data to the output file. FileData = T(sField).GetChunk(0, LeftOver) Put DestFile, , FileData ' Update the status bar meter. RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000) ' Write the remaining blocks of data to the output file. For i = 1 To NumBlocks ' Reads a chunk and writes it to output file. FileData = T(sField).GetChunk((i - 1) * BlockSize _ + LeftOver, BlockSize) Put DestFile, , FileData RetVal = SysCmd(acSysCmdUpdateMeter, _ ((i - 1) * BlockSize + LeftOver) / 1000) Next i ' Terminates function RetVal = SysCmd(acSysCmdRemoveMeter) RetVal = SysCmd(acSysCmdRemoveMeter) Close DestFile WriteBLOB = FileLength Exit Function Err_WriteBLOB: WriteBLOB = -Err MsgBox "WriteBLOB Error " & Err & " : " & Error$ Exit Function End Function '************************************************************** ' SUB: CopyFile ' ' PURPOSE: ' Demonstrates how to use ReadBLOB() and WriteBLOB(). ' ' PREREQUISITES: ' A table called BLOB that contains an OLE Object field called ' Blob. ' ' ARGUMENTS: ' Source - The path and filename of the information to copy. ' Destination - The path and filename of the file to write ' the binary information to. ' ' EXAMPLE: ' CopyFile "c:\windows\winfile.hlp", "c:\windows\winfil_1.hlp" '************************************************************** Sub CopyFile(Source As String, Destination As String) Dim BytesRead As Variant, BytesWritten As Variant Dim msg As String Dim db As Database Dim T As Recordset ' Open the BLOB table. Set db = CurrentDb() Set T = db.OpenRecordset("BLOB", dbOpenTable) ' Create a new record and move to it. T.AddNew T.Update T.MoveLast BytesRead = ReadBLOB(Source, T, "Blob") msg = "Finished reading """ & Source & """" msg = msg & Chr$(13) & ".. " & BytesRead & " bytes read." MsgBox msg, 64, "Copy File" BytesWritten = WriteBLOB(T, "Blob", Destination) msg = "Finished writing """ & Destination & """" msg = msg & Chr$(13) & ".. " & BytesWritten & " bytes written." MsgBox msg, 64, "Copy File" End Sub

Mail To: info@3pc.com