Mega Code Archive
Showing progress while loading blobs from ib-fb with ibx
<![CDATA[
uses
Windows, SysUtils, Variants, Classes, Graphics,
IBHeader, IBBlob, IBIntf, IB, IBErrorcodes;
type
TCBBlobCallBackMode = (bcbmStart, bcbmProgress, bcbmEnd);
TCBBlobCallBack = procedure(ATotal, AReceived: Integer;
AMode: TCBBlobCallBackMode) of object;
//------------------------------------------------------------------------------
function cbGetBlobWithCallBack(ABlobID: TISC_Quad;
ADBHandle: PISC_DB_Handle;
ATRHandle: PISC_TR_Handle;
AFileName: string; ACallBack: TCBBlobCallBack): Boolean;
...interface
//------------------------------------------------------------------------------
function cbGetBlobWithCallBack(ABlobID: TISC_Quad;
ADBHandle: PISC_DB_Handle;
ATRHandle: PISC_TR_Handle;
AFileName: string; ACallBack: TCBBlobCallBack): Boolean;
var
LBlobHandle: TISC_BLOB_HANDLE;
LSeg, LSize, LTotal: LongInt;
LType: Short;
LBuffer: PChar;
LCurPos: LongInt;
LBytesRead, LSegLen: Word;
LLocalBuffer: PChar;
LStream: TMemoryStream;
begin
Result := False;
LBlobHandle := nil;
// open the blob file; especially get the BlobHandle
GetGDSLibrary.isc_open_blob2(StatusVector, ADBHandle, ATRHandle,
@LBlobHandle, @ABlobID, 0, nil);
try
// get the informations of the blob;
// segment count, segment size, total size, blob type
IBBlob.GetBlobInfo(@LBlobHandle, LSeg, LSize, LTotal, LType);
// raise the first callback
if Assigned(ACallBack) then
ACallBack(LTotal, 0, bcbmStart);
// assign the variables and allocate memory
LBuffer := nil;
ReallocMem(LBuffer, LTotal);
LLocalBuffer := LBuffer;
LCurPos := 0;
LSegLen := Word(DefaultBlobSegmentSize);
while (LCurPos < LTotal) do
begin
if (LCurPos + LSegLen > LTotal) then
LSegLen := LTotal - LCurPos;
// receive the segments
if not ((GetGDSLibrary.isc_get_segment(StatusVector, @LBlobHandle,
@LBytesRead, LSegLen, LLocalBuffer) = 0) or
(StatusVectorArray[1] = isc_segment)) then
IBDatabaseError;
Inc(LLocalBuffer, LBytesRead);
Inc(LCurPos, LBytesRead);
// raise the callback
if Assigned(ACallBack) then
ACallBack(LTotal, LBytesRead, bcbmProgress);
LBytesRead := 0;
end;
// raise the last callback
if Assigned(ACallBack) then
ACallBack(LTotal, LBytesRead, bcbmEnd);
// save the file
LStream := TMemoryStream.Create;
try
LStream.WriteBuffer(LBuffer ^, LTotal);
LStream.SaveToFile(AFileName);
finally
FreeAndNil(LStream);
end;
finally
// close the blob
GetGDSLibrary.isc_close_blob(StatusVector, @LBlobHandle);
Result := True;
end;
end;
// Beispielaufuf
// Samplecall
// ich habe auf dem Formular eine TISQL-Komponente liegen
// Die TISQL-Komponente habe ich vor dem getBlob mit ExecSQL aufgemacht
// Man kann auch TIBCUstomDataset-Komponenten verwenden
//
// I use an IBSQL component, but it is also possible to use an IBCustomDataset
procedure TTestForm.getBlob(ADestfile: string);
begin
// der aufruf unter verwendung von TIBSQL
// the call with IBSQL
cbGetBlobWithCallBack(IBSQLUpdates.FieldByName('Update_File').AsQuad,
IBSQLUpdates.DBHandle, IBSQLUpdates.TRHandle, ADestFile, blobCallBack);
{// die variante mit TIBDataset
// the alternative with IBCustomDataset
cbGetBlobWithCallBack(IBDSUpdates.Current.ByName('Update_File').AsQuad,
IBUpdates.DBHandle, IBUpdates.TRHandle, ADestFile, blobCallBack);}
end;
// nun noch der Callback
// zu testzwecken habe ich eine Progressbar auf das Formular gelegt
//
// The Callback
// Put a progressbar on you form testing purposes
procedure TTestForm.blobCallBack(ATotal, AReceived: Integer;
AMode: TCBBlobCallBackMode);
begin
case AMode of
bcbmStart: Progressbar1.Max := ATotal;
bcbmProgress: ProgressBar1.Value := AReceived;
bcbmEnd: ProgressBar1.Value := ATotal;
end;
end;
]]>