用李维的这个方法吧！
新的CLIENTDATASET。
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.
