hmadq.pas

Delphi三层原代码掩饰及补丁

unit hmADQ;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, hmOleDataSet,
  Db, ADODB, HMStrTools, hmStatusIntf, StdCtrls, HMSqlTools, hmSqlStoreProc;

type
  THMOleADOQuery = class(THMCustomOleADOQuery)
  public
    procedure LoadSql(Sql: WideString); override; safecall;
    procedure LoadSqlAndOpen(Sql: WideString); override; safecall;
  end;

  THMADQ = class(TADOQuery)
  private
    FTrimString: TTrimStyle;
    FCheckSql: IStatus;
    FOleQuery: THMOleADOQuery;
    function GetDV(index: string): TDateTime;
    function GetFV(index: string): Double;
    function GetIV(index: string): integer;
    function GetSV(index: string): string;
    function GetBV(index: string): Boolean;
    procedure SetDV(index: string; const Value: TDateTime);
    procedure SetFV(index: string; const Value: Double);
    procedure SetIV(index: string; const Value: integer);
    procedure SetSV(index: string; const Value: string);
    procedure SetBV(index: string; const Value: Boolean);
    procedure SetTrimString(const Value: TTrimStyle);
    function GetLastIden: integer;
    function GetSqlLastIden: string;
    function GetIQuery: IHMOleADOQuery;
    { Private declarations }
  protected
    procedure SetActive(Value: Boolean); override;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure Open(Command: string); overload;
    procedure Open(Sql: THMSQL); overload;
    procedure Open(Sql: THMSqlStoreProc); overload;
    procedure OpenIden; overload;
    procedure OpenIden(TableName: string); overload;
    procedure OpenIden(TableName: string; IDFieldName: string); overload;
    procedure FindDatabases;
    procedure FindTables;
    procedure Close; reintroduce;
    function IsCursorOpen: Boolean; override;
    function IsNull(index: string): Boolean;
    function NotEmpty: Boolean;
    function RealNotEmpty: Boolean;
    procedure Next; reintroduce;
    procedure First; reintroduce;
    procedure Prev;
    procedure Last; reintroduce;
    property LastIden: integer read GetLastIden;
    property SqlLastIden: string read GetSqlLastIden;

    property SV[index: string]: string read GetSV write SetSV;
    property IV[index: string]: integer read GetIV write SetIV;
    property DV[index: string]: TDateTime read GetDV write SetDV;
    property FV[index: string]: Double read GetFV write SetFV;
    property BV[index: string]: Boolean read GetBV write SetBV;
  published
    property TrimString: TTrimStyle read FTrimString write SetTrimString;
    property CheckSql: IStatus read FCheckSql write FCheckSql;
    property IDataSet:IHMOleADOQuery read GetIQuery;
  end;

implementation

{ THMADQ }

procedure THMADQ.Close;
begin
  if Active then
    inherited First;
  if Active then
    inherited Close;
end;

procedure THMADQ.FindDatabases;
begin
  Open('sp_Databases');
end;

procedure THMADQ.FindTables;
begin
  Open('sp_Tables @Table_Type="''Table'',''View''"');
end;

procedure THMADQ.First;
begin
  if Active then inherited First;
end;

function THMADQ.GetBV(index: string): Boolean;
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    Result := FindField(index).AsBoolean;
end;

function THMADQ.GetDV(index: string): TDateTime;
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    Result := FindField(index).AsDateTime;
end;

function THMADQ.GetFV(index: string): Double;
begin
  Result := FindField(index).AsFloat;
end;

function THMADQ.GetIV(index: string): integer;
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    Result := FindField(index).AsInteger;
end;

function THMADQ.GetLastIden: integer;
begin
  Result := GetIV('iden');
end;

function THMADQ.GetSqlLastIden: string;
begin
  Result := GetSV('iden');
end;

function THMADQ.GetSV(index: string): string;
const
  tms: array[TTrimStyle] of integer = (NotTrim, TrimAll, TrimLeft, TrimRight);
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    begin
      if FTrimString = tsNotTrim then
        Result := FindField(index).AsString
      else
        Result := Trim(FindField(index).AsString, tms[FTrimString]);
    end;
end;

function THMADQ.IsCursorOpen: Boolean;
begin
  Result := inherited IsCursorOpen;
end;

function THMADQ.IsNull(index: string): Boolean;
begin
  Result := FindField(index).IsNull;
end;

procedure THMADQ.Last;
begin
  if Active then inherited Last;
end;

procedure THMADQ.Next;
begin
  if Active then inherited Next;
end;

function THMADQ.NotEmpty: Boolean;
begin
  Result := not IsEmpty;
end;

procedure THMADQ.Open(Command: string);
begin
  if active then
    Close;
  SQL.Text := Command;
  Open;
end;

procedure THMADQ.Open(Sql: THMSQL);
begin
  if active then
    Close;
  Self.SQL.Assign(Sql.OutLines);
  Open;
end;

procedure THMADQ.OpenIden;
begin
  Open('Select @@IDENTITY as Iden');
end;

procedure THMADQ.OpenIden(TableName: string);
begin
  Open('Select IDENT_CURRENT(''' + TableName + ''') as iden');
end;

procedure THMADQ.Open(Sql: THMSqlStoreProc);
begin
  if active then
    Close;
  Self.SQL.Assign(Sql.StoreProc);
  Open;
end;

procedure THMADQ.OpenIden(TableName, IDFieldName: string);
begin
  Open('Select Max(' + IDFieldName + ') as iden from ' + TableName);
end;

procedure THMADQ.Prev;
begin
  if Active then Prior;
end;

function THMADQ.RealNotEmpty: Boolean;
begin
  Result := Active and NotEmpty and (RecordCount > 0);
end;

procedure THMADQ.SetActive(Value: Boolean);
begin
  if Value and Assigned(CheckSql) and (FCheckSql <> nil) then
    begin
      CheckSql.AddScriptMsg(Name, Sql.Text);
    end;
  inherited SetActive(Value);
end;

procedure THMADQ.SetBV(index: string; const Value: Boolean);
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    FindField(index).AsBoolean := Value;
end;

procedure THMADQ.SetDV(index: string; const Value: TDateTime);
begin
  FindField(index).AsDateTime := Value;
end;

procedure THMADQ.SetFV(index: string; const Value: Double);
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    FindField(index).AsFloat := Value;
end;

procedure THMADQ.SetIV(index: string; const Value: integer);
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    FindField(index).AsInteger := Value;
end;

procedure THMADQ.SetSV(index: string; const Value: string);
begin
  if FindField(index) = nil then
    raise Exception.Create('Field ' + index + ' is not find.')
  else
    FindField(index).AsString := Value;
end;

procedure THMADQ.SetTrimString(const Value: TTrimStyle);
begin
  FTrimString := Value;
end;

constructor THMADQ.Create(AOwner: TComponent);
begin
  inherited;
  FOleQuery:=THMOleADOQuery.Create(Self);
end;

destructor THMADQ.Destroy;
begin
  FOleQuery.Free;
  inherited;
end;

function THMADQ.GetIQuery: IHMOleADOQuery;
begin
  Result:=FOleQuery;
end;

{ THMOleADOQuery }

procedure THMOleADOQuery.LoadSql(Sql: WideString);
begin
  (Parent as THMADQ).SQL.Text := Sql;
end;

procedure THMOleADOQuery.LoadSqlAndOpen(Sql: WideString);
begin
  (Parent as THMADQ).Close;
  (Parent as THMADQ).SQL.Text := Sql;
  (Parent as THMADQ).Open;
end;

end.