ftclientdataset.pas

来自「就是这本书的随书代码。包括《实战Delphi 5.x-分布式多层应用系统篇》」· PAS 代码 · 共 123 行

unit FTClientDataSet;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, ActiveX, DSIntf, DBClient;

type
  TFTClientDataSet = class(TClientDataSet)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure WriteDeltaPacket(Stream: TStream; WriteSize: Boolean);
    procedure SaveDeltaToStream(Stream: TStream);
    procedure SaveDeltaPacket;
    procedure ClearDeltaPacket;
    procedure LoadDeltaFromStream(Stream: TStream);
    procedure ReadDeltaPacket(Stream: TStream; ReadSize: Boolean);
  public
    { Public declarations }
    procedure SaveToFileWithDelta(const FileName : string = 'TmpDeltaFile.dat');
    procedure LoadFromFileWithDelta(const FileName : string = 'TmpDeltaFile.dat');
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('龟驹Delphi 5', [TFTClientDataSet]);
end;

{ TFTClientDataSet }

procedure TFTClientDataSet.ClearDeltaPacket;
var
  aDataPacket : TDataPacket;
begin
  aDataPacket := VarToDataPacket(Delta);
  FreeDataPacket(aDataPacket);
end;

procedure TFTClientDataSet.SaveDeltaPacket;
var
  aDataPacket : TDataPacket;
begin
  aDataPacket := VarToDataPacket(Delta);
  if Assigned(DSBase) and (DataSetField = nil) then
    Check(DSBase.StreamDS(aDataPacket));
end;

procedure TFTClientDataSet.WriteDeltaPacket(Stream: TStream; WriteSize: Boolean);
var
  Size: Integer;
  DataPtr: Pointer;
begin
  if Active then
  begin
    CheckBrowseMode;
//    CheckProviderEOF;
    SaveDeltaPacket;
  end;
  if Assigned(VarToDataPacket(Delta)) then
  begin
    Size := DataPacketSize(VarToDataPacket(Delta));
    SafeArrayAccessData(VarToDataPacket(Delta), DataPtr);
    try
      if WriteSize then
        Stream.Write(Size, SizeOf(Size));
      Stream.Write(DataPtr^, Size);
    finally
      SafeArrayUnAccessData(VarToDataPacket(Delta));
    end;
    if Active then
      ClearDeltaPacket;
  end;
end;

procedure TFTClientDataSet.SaveDeltaToStream(Stream: TStream);
begin
  WriteDeltaPacket(Stream, False);
end;

procedure TFTClientDataSet.ReadDeltaPacket(Stream: TStream; ReadSize: Boolean);
var
  Size: Integer;
  DataPtr: Pointer;
  VarBound: TVarArrayBound;
  aClientDataset : TClientDataSet;
  aDataPacket : TDataPacket;
  sFieldNames : string;
  iCount, iFieldCount : Integer;
  vFieldValues : Variant;
  vOldValues, vNewValues : Variant;
  vChangedFields : Variant;
  oData : OleVariant;
begin
  if ReadSize then
    Stream.ReadBuffer(Size, SizeOf(Size)) else
    Size := Stream.Size - Stream.Position;
  if Size > 0 then
  begin
    FillChar(VarBound, SizeOf(VarBound), 0);
    VarBound.ElementCount := Size;
    aDataPacket := TDataPacket(SafeArrayCreate(varByte, 1, VarBound));
    try
      SafeArrayAccessData(aDataPacket, DataPtr);
      try
        Stream.Read(DataPtr^, Size);
      finally
        SafeArrayUnAccessData(aDataPacket);
      end;
    except
      ClearDeltaPacket;
      raise;
    end;

    //钵笆