hmprovider.pas

Delphi三层原代码掩饰及补丁

unit hmProvider;

interface

uses
  Windows, Messages, SysUtils, Classes, DB, DBClient, HMADQ, Provider,
  Variants, HMADN, AdoDB, hmStatusIntf;

type

  TUpdateTableState = (utInsert, utDelete, utUpdate);
  TOnUpdateField = procedure(Sender: TObject; SField, DField: TField; State: TUpdateTableState) of object;

  THMQueryProvider = class(TDataSetProvider)
  private
    FQuery: THMADQ;
    FComment: string;
    FKeyField: string;
    FOnUpdateField: TOnUpdateField;
    FOpenOnec: Boolean;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetConnection(const Value: TADOConnection);
    function GetConnection: TADOConnection;
    function GetSQL: Tstrings;
    procedure SetSQL(const Value: Tstrings);
    procedure SetComment(const Value: string);
    procedure SetKeyField(const Value: string);
    procedure SetOnUpdateField(const Value: TOnUpdateField);
    procedure SetOpenOnec(const Value: Boolean);
    function GetCheckSql: IStatus;
    procedure SetCheckSql(const Value: IStatus);
  protected
    procedure ShowDebug(Msg: string);
    procedure DoAfterApplyUpdates(var OwnerData: OleVariant); override;
    procedure DoBeforeApplyUpdates(var OwnerData: OleVariant); override;
    procedure DoAfterExecute(var OwnerData: OleVariant); override;
    procedure DoBeforeExecute(const CommandText: WideString; var Params, OwnerData: OleVariant); override;
    procedure DoAfterGetParams(var OwnerData: OleVariant); override;
    procedure DoBeforeGetParams(var OwnerData: OleVariant); override;
    procedure DoAfterGetRecords(var OwnerData: OleVariant); override;
    procedure DoBeforeGetRecords(Count: Integer; Options: Integer; const CommandText: WideString; var Params, OwnerData: OleVariant); override;
    procedure DoAfterRowRequest(var OwnerData: OleVariant); override;
    procedure DoBeforeRowRequest(var OwnerData: OleVariant); override;
    procedure DoGetTableName(DataSet: TDataSet; var TableName: string); override;
    procedure DoGetProviderAttributes(DataSet: TDataSet; List: TList); override;
    procedure DoOnGetData(var Data: OleVariant);
    procedure DoOnUpdateData(Delta: TPacketDataSet);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Close;
    procedure Open(Cmd: WideString);
    function DataRequest(Input: OleVariant): OleVariant; override;
    procedure DoOnUpdateField(SField: TField; DField: TField; State: TUpdateTableState);
    property Query: THMADQ read FQuery;
  published
    property Active: Boolean read GetActive write SetActive;
    property Connection: TADOConnection read GetConnection write SetConnection;
    property CheckSql: IStatus read GetCheckSql write SetCheckSql;
    property SQL: Tstrings read GetSQL write SetSQL;
    property Comment: string read FComment write SetComment;
    property KeyField: string read FKeyField write SetKeyField;
    property OpenOnec: Boolean read FOpenOnec write SetOpenOnec;
    property OnUpdateField: TOnUpdateField read FOnUpdateField write SetOnUpdateField;
  end;

implementation

{ THMQueryProvider }

procedure THMQueryProvider.Close;
begin
  FQuery.Close;
end;

function THMQueryProvider.GetActive: Boolean;
begin
  Result := FQuery.Active;
end;

procedure THMQueryProvider.Open(Cmd: WideString);
begin
  FQuery.Open(Cmd);
end;

procedure THMQueryProvider.SetActive(const Value: Boolean);
begin
  FQuery.Active := Value;
end;

constructor THMQueryProvider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FQuery := THMADQ.Create(Self);
  FQuery.Name := 'Query';
  Self.DataSet := FQuery;
  FComment := '';
  FOpenOnec := True;
end;

destructor THMQueryProvider.Destroy;
begin
  FQuery.Free;
  inherited Destroy;
end;

procedure THMQueryProvider.SetConnection(const Value: TADOConnection);
begin
  FQuery.Connection := Value;
end;

function THMQueryProvider.GetConnection: TADOConnection;
begin
  Result := FQuery.Connection;
end;

function THMQueryProvider.GetSQL: Tstrings;
begin
  Result := FQuery.SQL;
end;

procedure THMQueryProvider.SetSQL(const Value: Tstrings);
begin
  FQuery.SQL.Assign(Value);
end;

procedure THMQueryProvider.ShowDebug(Msg: string);
begin
(*  if Assigned(FQuery.CheckSql) then
    if FQuery.CheckSql.CheckSQL then
      FQuery.CheckSql.AddComment('<DSP - ' + Self.Name + '>:' + Msg);*)
end;

procedure THMQueryProvider.DoAfterApplyUpdates(var OwnerData: OleVariant);
begin
  ShowDebug('AfterApplyUpdates');
  inherited;
end;

procedure THMQueryProvider.DoAfterExecute(var OwnerData: OleVariant);
begin
  ShowDebug('AfterExecute');
  inherited;
end;

procedure THMQueryProvider.DoAfterGetParams(var OwnerData: OleVariant);
begin
  ShowDebug('AfterGetParams');
  inherited;
end;

procedure THMQueryProvider.DoAfterGetRecords(var OwnerData: OleVariant);
begin
  ShowDebug('AfterGetRecords');
  inherited;
end;

procedure THMQueryProvider.DoAfterRowRequest(var OwnerData: OleVariant);
begin
  ShowDebug('AfterRowRequest');
  inherited;
end;

procedure THMQueryProvider.DoBeforeApplyUpdates(var OwnerData: OleVariant);
begin
  ShowDebug('BeforeApplyUpdates');
  inherited;
end;

procedure THMQueryProvider.DoBeforeExecute(const CommandText: WideString;
  var Params, OwnerData: OleVariant);
begin
  ShowDebug('BeforeExecute');
  inherited;
end;

procedure THMQueryProvider.DoBeforeGetParams(var OwnerData: OleVariant);
begin
  ShowDebug('BeforeGetParams');
  inherited;
end;

procedure THMQueryProvider.DoBeforeGetRecords(Count, Options: Integer;
  const CommandText: WideString; var Params, OwnerData: OleVariant);
begin
  ShowDebug('BeforeGetRecords');
  if (FOpenOnec) and (FQuery.SQL.Count > 0) then
    if FQuery.Active then
      FQuery.Requery
    else
      FQuery.Open;
  inherited;
end;

procedure THMQueryProvider.DoBeforeRowRequest(var OwnerData: OleVariant);
begin
  ShowDebug('BeforeRowRequest');
  inherited;
end;

procedure THMQueryProvider.DoGetProviderAttributes(DataSet: TDataSet;
  List: TList);
begin
  ShowDebug('GetProviderAttributes');
  inherited;
end;

procedure THMQueryProvider.DoGetTableName(DataSet: TDataSet;
  var TableName: string);
begin
  ShowDebug('GetTableName');
  inherited;
end;

procedure THMQueryProvider.DoOnGetData(var Data: OleVariant);
begin
  ShowDebug('GetTableName');
  inherited DoOnGetData(Data);
end;

procedure THMQueryProvider.DoOnUpdateData(Delta: TPacketDataSet);
begin
  ShowDebug('OnUpdateData');
  inherited DoOnUpdateData(Delta);
end;

function THMQueryProvider.DataRequest(Input: OleVariant): OleVariant;
begin
  ShowDebug('OnDataRequest');
  Result := inherited DataRequest(Input);
end;

procedure THMQueryProvider.SetComment(const Value: string);
begin
  FComment := Value;
end;

procedure THMQueryProvider.SetKeyField(const Value: string);
begin
  FKeyField := Value;
end;

procedure THMQueryProvider.DoOnUpdateField(SField, DField: TField; State: TUpdateTableState);
begin
  if Assigned(FOnUpdateField) then FOnUpdateField(Self, SField, DField, State);
end;

procedure THMQueryProvider.SetOnUpdateField(const Value: TOnUpdateField);
begin
  FOnUpdateField := Value;
end;

procedure THMQueryProvider.SetOpenOnec(const Value: Boolean);
begin
  FOpenOnec := Value;
end;

function THMQueryProvider.GetCheckSql: IStatus;
begin
  Result:=FQuery.CheckSql;
end;

procedure THMQueryProvider.SetCheckSql(const Value: IStatus);
begin
  FQuery.CheckSql:=Value;
end;

end.