给ADOQuery增加LoadFromStream,LoadFromString等功能

扩展ADODataSet功能,增加LoadFromStream、SaveToStream、LoadFromString、SaveToString等方法:

unit MyADODataSet;

interface

uses
  Classes, ADODB, ADOInt, Variants;

type
  TMyADODataSet = class(TADODataSet)
  public
    function LoadFromStream(Stream: TStream): Boolean;
    function SaveToStream(Stream: TStream): Boolean;
    function LoadFromString(const Value: string): Boolean;
    function SaveToString(var Value: string): Boolean;
  end;

procedure Register;

implementation

type
  Recordset25 = interface(_Recordset)
    ['{00000556-0000-0010-8000-00AA006D2EA4} ']
    procedure Save(Destination: OleVariant; PersistFormat: PersistFormatEnum); safecall;
  end;

function TMyADODataSet.LoadFromStream(Stream: TStream): Boolean;
var
  mRecordSet: _Recordset;
begin
  Result := False;
  Close;
  DestroyFields;
  mRecordSet := CoRecordset.Create;
  try
    if mRecordSet.State = adStateOpen then
      mRecordSet.Close;
    Stream.Position := 0;
    mRecordSet.Open(TStreamAdapter.Create(Stream) as IUnknown, EmptyParam, adOpenStatic, adLockBatchOptimistic, adAsyncExecute);
    Stream.Position := 0;
    if not mRecordSet.BOF then
      mRecordSet.MoveFirst;
    RecordSet := mRecordSet;
    inherited OpenCursor(False);
    Resync([]);
    Result := True;
  except
//
  end;
end;

function TMyADODataSet.SaveToStream(Stream: TStream): Boolean;
var
  mRecordSet: Recordset25;
begin
  Result := False;
  if Recordset = nil then
    Exit;
  if Recordset.QueryInterface(Recordset25, mRecordSet) = 0 then
  try
    Stream.Position := 0;
    mRecordSet.Save(TStreamAdapter.Create(Stream) as IUnknown, adPersistXML);
    Stream.Position := 0;
    Result := True;
  except
//
  end;
end;

function TMyADODataSet.LoadFromString(const Value: string): Boolean;
var
  mStream: TStringStream;
begin
  Result := False;
  if Value = ' ' then
    Exit;
  mStream := TStringStream.Create(UTF8Encode(Value));
  try
    LoadFromStream(mStream);
    Result := True;
  finally
    mStream.Free;
  end;
end;

function TMyADODataSet.SaveToString(var Value: string): Boolean;
var
  mStream: TStringStream;
begin
  Result := False;
  mStream := TStringStream.Create(' ');
  try
    SaveToStream(mStream);
    mStream.Position := 0;
    Value := Utf8ToAnsi(mStream.ReadString(mStream.Size));
    Result := True;
  finally
    mStream.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('Standard ', [TMyADODataSet]);
end;

end.

 

posted @ 2022-10-04 00:15  IT情深  阅读(37)  评论(0编辑  收藏  举报