madb.pas

三层cs结构实例 水平相当高的高人开发的软件 有要就留着用吧

unit MADB;

interface

uses
  SysUtils, Classes, Windows, Variants, ADODB, MAClient, MADBIntf;

type
  TMADOConnection = class(TADOConnection)
  private
    FTransLevel: Integer;
    FMConnection: TMAClient;
    function GetMEnabled: Boolean;
    procedure SetMEnabled(const Value: Boolean);
  protected
    procedure ConnectEvent(Sender: TObject);
    procedure DoConnect; override;
    procedure DoDisconnect; override;
    function GetConnected: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute(const CommandText: WideString; var RecordsAffected: Integer;
      const ExecuteOptions: TExecuteOptions = [eoExecuteNoRecords]); reintroduce; overload;
    function Execute(const CommandText: WideString; const CommandType: TCommandType = cmdText;
      const ExecuteOptions: TExecuteOptions = []): _Recordset; reintroduce; overload;
    function BeginTrans: Integer;
    procedure CommitTrans;
    procedure RollbackTrans;
    procedure BeginBatch;
    procedure CommitBatch;
    procedure RollbackBatch;
  published
    property Connected stored False;
    property MConnection: TMAClient read FMConnection write FMConnection;
    property MEnabled: Boolean read GetMEnabled write SetMEnabled stored False;
  end;

  TCustomMADODataset = class(TCustomADODataset)
  private
    function GetConnection: TMADOConnection;
  protected
    procedure InternalRefresh; override;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure SetConnection(const Value: TMADOConnection); reintroduce; virtual;
    property CommandText: WideString read GetCommandText write SetCommandText;
  public
    procedure UpdateBatch(AffectRecords: TAffectRecords = arAll);
  published
    property Connection: TMADOConnection read GetConnection write SetConnection;
  end;

  TMADODataset = class(TCustomMADODataset)
  published
    property CommandText;
    property CommandTimeout;
    property CommandType;
    property Parameters;
    property IndexFieldNames;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
  end;

  TMADOQuery = class(TCustomMADODataSet)
  private
    FSQL: TStrings;
    FRowsAffected: Integer;
    function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
  protected
    procedure QueryChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecSQL: Integer;
    property RowsAffected: Integer read FRowsAffected;
  published
    property CommandTimeout;
    property DataSource;
    property EnableBCD;
    property ParamCheck;
    property Parameters;
    property Prepared;
    property SQL: TStrings read GetSQL write SetSQL;
  end;

implementation

{ TMADOConnection }

procedure TMADOConnection.BeginBatch;
begin
  if MEnabled then
    FMConnection.BeginBatch;
end;

procedure TMADOConnection.CommitBatch;
begin
  if MEnabled then
  begin
    FMConnection.CommandTimeout := CommandTimeout * 1000;
    FMConnection.CommitBatch;
  end;
end;

constructor TMADOConnection.Create(AOwner: TComponent);
begin
  FMConnection := TMAClient.Create;
  FMConnection.OnConnected := ConnectEvent;
  FMConnection.OnDisconnected := ConnectEvent;
  inherited;
end;

procedure TMADOConnection.DoConnect;
begin
  if MEnabled and not (csDesigning in ComponentState) then
  begin
    FMConnection.ConnectTimeout := ConnectionTimeout * 1000;
    FMConnection.Connect;
  end else
    inherited DoConnect;
end;

procedure TMADOConnection.DoDisconnect;
begin
  if MEnabled then
    FMConnection.Disconnect
  else inherited;
end;

procedure TMADOConnection.Execute(const CommandText: WideString;
  var RecordsAffected: Integer; const ExecuteOptions: TExecuteOptions);
begin
  if MEnabled then
  begin
    FMConnection.CommandTimeout := CommandTimeout * 1000;
    RecordsAffected := FMConnection.Execute(CommandText);
  end else
    inherited;
end;

function TMADOConnection.Execute(const CommandText: WideString;
  const CommandType: TCommandType;
  const ExecuteOptions: TExecuteOptions): _Recordset;
begin
  if MEnabled then
  begin
    FMConnection.CommandTimeout := CommandTimeout * 1000;
    Result := FMConnection.LoadData(CommandText) as _Recordset;
  end else
  begin
    Result := CoRecordset.Create;
    Result.CursorLocation := adUseClient;
    Result.Open(CommandText, ConnectionObject, adOpenStatic, adLockBatchOptimistic, -1);
  end;
end;

function TMADOConnection.GetConnected: Boolean;
begin
  if MEnabled then
    Result := FMConnection.Connected
  else
    Result := inherited GetConnected;
end;

procedure TMADOConnection.RollbackBatch;
begin
  if MEnabled then
    FMConnection.RollbackBatch;
end;

function TMADOConnection.BeginTrans: Integer;
begin
  if MEnabled then
  begin
    Result := FMConnection.BeginTrans;
  end else
  begin
    if FTransLevel = 0 then
      inherited BeginTrans;
    Inc(FTransLevel);
    Result := FTransLevel;
  end;
end;

procedure TMADOConnection.CommitTrans;
begin
  if MEnabled then
  begin
    FMConnection.CommitTrans;
  end else
  begin
    Dec(FTransLevel);
    if FTransLevel = 0 then
      inherited CommitTrans;
  end;
end;

procedure TMADOConnection.RollbackTrans;
begin
  if MEnabled then
  begin
    FMConnection.RollbackTrans;
  end else
  begin
    Dec(FTransLevel);
    if FTransLevel = 0 then
      inherited RollbackTrans;
  end;
end;

function TMADOConnection.GetMEnabled: Boolean;
begin
  Result := FMConnection.Enabled;
end;

procedure TMADOConnection.SetMEnabled(const Value: Boolean);
begin
  FMConnection.Enabled := Value;
end;

procedure TMADOConnection.ConnectEvent(Sender: TObject);
begin
  if Connected then
  begin
    if Assigned(AfterConnect) then
      AfterConnect(Self);
  end else
    if Assigned(AfterDisconnect) then
      AfterDisconnect(Self);
end;

destructor TMADOConnection.Destroy;
begin
  inherited;
  FMConnection.Free;
end;

{ TCustomMADODataset }

function TCustomMADODataset.GetConnection: TMADOConnection;
begin
  Result := (inherited Connection) as TMADOConnection;
end;

procedure TCustomMADODataset.InternalRefresh;
var
  CurrPos: string;
begin
  DisableControls;
  try
    CurrPos := Bookmark;
    Close;
    Open;
    try
      Bookmark := CurrPos;
    except
    end;
  finally
    EnableControls;
  end;
end;

procedure TCustomMADODataset.OpenCursor(InfoQuery: Boolean);
begin
  if Connection.MEnabled and not (csDesigning in ComponentState) and
   ((Recordset = nil) or (Recordset.State = adStateClosed)) then
  begin
    Connection.MConnection.CommandTimeout := CommandTimeout * 1000;
    Connection.MConnection.OpenDataset(Self, CommandText);
  end
  else inherited;
end;

procedure TCustomMADODataset.SetConnection(const Value: TMADOConnection);
begin
  inherited SetConnection(Value);
end;

procedure TCustomMADODataset.UpdateBatch(AffectRecords: TAffectRecords);
var
  Current: OleVariant;
begin
  //if LockType = ltBatchOptimistic then
  if Connection.MEnabled and not (csDesigning in ComponentState) then
  begin
    CheckBrowseMode;
    Current := Recordset.Bookmark;
    Connection.MConnection.CommandTimeout := CommandTimeout * 1000;
    Connection.MConnection.PostDataset(Self);
    try
      Recordset.Bookmark := Current;
    except
    end;
    UpdateCursorPos;
    Resync([]);
  end else
    inherited;
end;


{ TMADOQuery }

constructor TMADOQuery.Create(AOwner: TComponent);
begin
  inherited;
  FSQL := TStringList.Create;
  TStringList(FSQL).OnChange := QueryChanged;
end;

destructor TMADOQuery.Destroy;
begin
  inherited;
  FreeAndNil(FSQL);
end;

function TMADOQuery.ExecSQL: Integer;
begin
  Connection.Execute(FSQL.Text, FRowsAffected);
  Result := FRowsAffected;
end;

function TMADOQuery.GetSQL: TStrings;
begin
  Result := FSQL;
end;

procedure TMADOQuery.QueryChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
    Close;
  CommandText := FSQL.Text;
end;

procedure TMADOQuery.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

end.