IB/FB + IBX: Blob mit Fortschritsanzeige aus der DB holen

[CenBells]

Hallo Leute,

für die Update-Funktion einer Software von mir habe ich einen Firebirdserver im Internet laufen.
Dieser Firebirdserver verwaltet eine Datenbank, in der Informationen zu den Software-Updates gespeichert werden.
Die Patches sind in einem Blob-Feld gespeichert.

Die Anwender laden diese Patches herunter und führen lokal das Updateprogramm aus.
Da diese Binary-Patches mitunter recht groß werden können und die IBX-Komponenten selbst in Version 7.08 keine Möglichkeit bieten den Fortschritt anzuzeigen, habe ich mir für das "Herunterladen" der Patches eine Methode geschrieben, die einem das Anzeigen des Fortschritts durch eine Callback-Funktion erleichtert.

Hier das Interface und die Methode

Delphi-Quellcode:

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;

Und hier ein Beispielaufruf und das nutzen des Callbacks.

Delphi-Quellcode:

// 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
procedure TTestForm.getBlob(ADestfile: String);
begin
  // der aufruf unter verwendung von TIBSQL
  cbGetBlobWithCallBack(IBSQLUpdates.FieldByName('Update_File').AsQuad,
       IBSQLUpdates.DBHandle, IBSQLUpdates.TRHandle, ADestFile, blobCallBack);

  {// die variante mit TIBDataset
  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
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;

Damit ist es nun möglich dem Anwender den Fortschritt beim Empfangen eines großen Blobfeldes anzuzeigen.

Gruß und viel Erfolg
Ken