ftclientdataset.pas

就是这本书的随书代码。包括《实战Delphi 5.x-分布式多层应用系统篇》

unit FTClientDataSet;

{$R-}

interface

uses Windows, SysUtils, ActiveX, Graphics, Classes, Controls, Forms, Db,
  BDE, DSIntf, DBCommon, StdVcl, DBClient;

type
  TFTClientDataSet = class(TClientDataSet)
  private
    FSaveAllRecords : Boolean;
    FOpeningFile: Boolean;
  protected
    procedure WriteDataPacket(Stream: TStream; WriteSize: Boolean;
  XMLFormat: Boolean = False);
    procedure CheckProviderEOF;
    procedure FetchMoreData(All: Boolean);
    procedure SaveDataPacket(XMLFormat: Boolean = False);
    procedure ClearSavedPacket;
    procedure SaveToStream(Stream: TStream; Format: TDataPacketFormat = dfBinary);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToFile(const FileName: string = 'TmpDataFile.dat';
  Format: TDataPacketFormat = dfBinary);
    procedure LoadFromFile(const FileName: string = 'TmpDataFile.dat');
  published
    property SaveAllRecords : Boolean read FSaveAllRecords write FSaveAllRecords default False;
 end;

procedure Register;

implementation

uses DBConsts, MidConst, ComObj, Provider, TypInfo;


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

constructor TFTClientDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSaveAllRecords := False;
  FOpeningFile := False;
end;

destructor TFTClientDataSet.Destroy;
begin
  inherited Destroy;
end;

procedure TFTClientDataSet.FetchMoreData(All: Boolean);
var
  Count: Integer;
  RecsOut: Integer;
begin
  if All then Count := AllRecords else Count := PacketRecords;
  if Count = 0 then Exit;
  AddDataPacket(DoGetRecords(Count, RecsOut, 0, '', Unassigned), RecsOut <> Count);
  ProviderEOF := RecsOut <> Count;
end;

procedure TFTClientDataSet.CheckProviderEOF;
begin
  if HasAppServer and not ProviderEOF and FetchOnDemand and (PacketRecords <> 0) then
    FetchMoreData(True);
end;

procedure TFTClientDataSet.SaveDataPacket(XMLFormat: Boolean = False);
const
  StreamMode: array[Boolean] of DWord = (xmlOFF, xmlON);
var
  DataPacket: TDataPacket;
begin
  DataPacket := VarToDataPacket(Data);
  if Assigned(DSBase) and (DataSetField = nil) then
  begin
    DSBase.SetProp(dspropXML_STREAMMODE, StreamMode[XMLFormat]);
    ClearSavedPacket;
    Check(DSBase.StreamDS(DataPacket));
  end;
end;

procedure TFTClientDataSet.ClearSavedPacket;
var
  DataPacket: TDataPacket;
begin
  DataPacket := VarToDataPacket(Delta);
  FreeDataPacket(DataPacket);
end;

procedure TFTClientDataSet.WriteDataPacket(Stream: TStream; WriteSize: Boolean;
  XMLFormat: Boolean = False);
var
  Size: Integer;
  DataPtr: Pointer;
begin
  if Active then
  begin
    CheckBrowseMode;
    if (FSaveAllRecords) then
      CheckProviderEOF;
    SaveDataPacket(XMLFormat);
  end;
  if Assigned(VarToDataPacket(Data)) then
  begin
    Size := DataPacketSize(VarToDataPacket(Data));
    SafeArrayAccessData(VarToDataPacket(Data), DataPtr);
    try
      if WriteSize then
        Stream.Write(Size, SizeOf(Size));
      Stream.Write(DataPtr^, Size);
    finally
      SafeArrayUnAccessData(VarToDataPacket(Data));
    end;
    if Active then ClearSavedPacket;
  end;
end;

procedure TFTClientDataSet.SaveToStream(Stream: TStream; Format: TDataPacketFormat = dfBinary);
begin
  WriteDataPacket(Stream, False, (Format=dfXML));
end;

procedure TFTClientDataSet.SaveToFile(const FileName: string = 'TmpDataFile.dat';
  Format: TDataPacketFormat = dfBinary);
var
  Stream: TStream;
begin
  if FileName = '' then
    Stream := TFileStream.Create(Self.FileName, fmCreate) else
    Stream := TFileStream.Create(FileName, fmCreate);
  try
    if LowerCase(ExtractFileExt(FileName)) = '.xml' then
      Format := dfXML;
    SaveToStream(Stream, Format);
  finally
    Stream.Free;
  end;
end;

procedure TFTClientDataSet.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Close;
  if FileName = '' then
    Stream := TFileStream.Create(Self.FileName, fmOpenRead) else
    Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    FOpeningFile := True;
    try
      LoadFromStream(Stream);
    finally
      FOpeningFile := False;
    end;
  finally
    Stream.Free;
  end;
end;

end.