Showing progress while loading blobs from IB/FB with IBX
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 |
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; procedure TTestForm.getBlob(ADestfile: string); begin // the call with IBSQL cbGetBlobWithCallBack(IBSQLUpdates.FieldByName('Update_File').AsQuad, IBSQLUpdates.DBHandle, IBSQLUpdates.TRHandle, ADestFile, blobCallBack); {// the alternative with IBCustomDataset cbGetBlobWithCallBack(IBDSUpdates.Current.ByName('Update_File').AsQuad, IBUpdates.DBHandle, IBUpdates.TRHandle, ADestFile, blobCallBack);} end; // 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; |