hmadc.pas

Delphi三层原代码掩饰及补丁

unit hmADC;

interface

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

type
  TadcType = (atInsert, atUpdate, atCustom);
  TSqlFieldType = (ftS, ftD, ftT, ftN, ftM);
  // ftS  : String
  // ftD  : Date of String
  // ftT  : Time of String
  // ftN  : Integer
  // ftM  : Money

type
  THMADC = class(TADOCommand)
  private
    FRecordsAffected: integer;
    FieldList: TStringList;
    ValueList: TStringList;
    FCondition: string;
    FTableName: string;

    adcType: TadcType;
    FCheckSql: IStatus;
    procedure SetCondition(const Value: string);
    procedure SetTableName(const Value: string);
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Use(Database: string);
    procedure DropTable(Table: string);

    procedure BeginUpdate;
    procedure EndUpdate;

    procedure BeginInsert;
    procedure EndInsert;
    procedure Post;

    procedure AddField(Field: string; Value: string; FieldType:
      TSqlFieldType);
    procedure AddSField(Field: string; Value: string);
    procedure AddNField(Field: string; Value: string); overload;
    procedure AddNField(Field: string; Value: integer); overload;
    procedure AddMField(Field: string; Value: string); overload;
    procedure AddMField(Field: string; Value: Extended); overload;
    procedure AddDField(Field: string; Value: string); overload;
    procedure AddDField(Field: string; Value: TDate); overload;
    procedure AddTField(Field: string; Value: TDateTime); overload;
    procedure AddTField(Field: string; Value: string); overload;

    function Execute(const Command: WideString): _Recordset; overload;
    function Execute(Sql: THMSQL): _Recordset; overload;
    function execute(Sql:THMSqlStoreProc): _Recordset; overload;
    property RecordsAffected: integer read FRecordsAffected;

    property TableName: string read FTableName write SetTableName;
    property Condition: string read FCondition write SetCondition;

  published
    property CheckSql: IStatus read FCheckSql write FCheckSql;
  end;

implementation

{ THMADC }

constructor THMADC.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FieldList := TStringList.Create;
  ValueList := TStringList.Create;
  FCondition := '';
  FTableName := '';
  adcType := atCustom;
end;

destructor THMADC.Destroy;
begin
  FieldList.Free;
  ValueList.Free;
  inherited Destroy;
end;

procedure THMADC.AddField(Field, Value: string; FieldType: TSqlFieldType);
begin
  if Field = '' then
    raise Exception.Create('Field can not be empty.')
  else
    FieldList.Add(Field);

  if FieldType in [ftS, ftD, ftT] then
    ValueList.Add(ToSQLStr(Value))
  else
    ValueList.Add(ToSQLInt(Value))

end;

procedure THMADC.BeginUpdate;
begin
  adcType := atUpdate;
  FieldList.Clear;
  ValueList.Clear;
end;

procedure THMADC.EndUpdate;
var
  i: integer;
  s: string;
begin
  s := '';

  for i := 1 to FieldList.Count do
    s := CommaAdd(s, FieldList[i - 1] + '=' + ValueList[i - 1]);

  if FTableName = '' then
    begin
      raise Exception.Create('TableName is Empty.');
      exit;
    end;

  if (FieldList.count = 0) or (s = '') then
    begin
      raise Exception.Create('No Field to Update.');
      exit;
    end;

  s := 'Update ' + TableName + ' set ' + s;
  if FCondition <> '' then
    begin
      if At('where', lowercase(FCondition)) > 0 then
        s := s + ' ' + FCondition
      else
        s := s + ' where ' + FCondition;
    end;
  CommandText := s;
end;

procedure THMADC.BeginInsert;
begin
  adcType := atInsert;
  FieldList.Clear;
  ValueList.Clear;
end;

procedure THMADC.EndInsert;
var
  i: integer;
  s, s1, s2: string;
begin
  s1 := '';
  s2 := '';
  for i := 1 to FieldList.Count do
    s1 := CommaAdd(s1, FieldList[i - 1]);
  for i := 1 to ValueList.Count do
    s2 := CommaAdd(s2, ValueList[i - 1]);

  if FTableName = '' then
    begin
      raise Exception.Create('TableName is Empty.');
      exit;
    end;

  if (FieldList.count = 0) or (s1 = '') then
    begin
      raise Exception.Create('No Field to Update.');
      exit;
    end;

  s := 'Insert into ' + TableName + ' (' + s1 + ') Values (' + s2 + ')';
  if FCondition <> '' then
    begin
      if At('where', lowercase(FCondition)) > 0 then
        s := s + ' ' + FCondition
      else
        s := s + ' where ' + FCondition;
    end;
  CommandText := s;
end;

function THMADC.Execute(const Command: WideString): _Recordset;
begin
  CommandText := Command;
  if Assigned(CheckSql) and (FCheckSql <> nil) then
    begin
      CheckSql.AddScriptMsg(Name, CommandText);
    end;
  Execute(FRecordsAffected, EmptyParam);
end;

procedure THMADC.SetCondition(const Value: string);
begin
  FCondition := Value;
end;

procedure THMADC.SetTableName(const Value: string);
begin
  FTableName := Value;
end;

procedure THMADC.AddMField(Field: string; Value: Extended);
begin
  AddField(Field, FloattoStr(Value), ftM);
end;

procedure THMADC.AddMField(Field, Value: string);
begin
  AddField(Field, Value, ftM);
end;

procedure THMADC.AddNField(Field, Value: string);
begin
  AddField(Field, Value, ftN);
end;

procedure THMADC.AddNField(Field: string; Value: integer);
begin
  AddField(Field, InttoStr(Value), ftN);
end;

procedure THMADC.AddSField(Field, Value: string);
begin
  AddField(Field, Value, ftS);
end;

procedure THMADC.AddDField(Field, Value: string);
begin
  AddField(Field, Value, ftD);
end;

procedure THMADC.AddDField(Field: string; Value: TDate);
begin
  AddField(Field, DateToStr(Value), ftS);
end;

procedure THMADC.AddTField(Field: string; Value: TDateTime);
begin
  AddField(Field, TimeToTST(Value), ftT);
end;

procedure THMADC.AddTField(Field, Value: string);
begin
  AddField(Field, Value, ftT);
end;

procedure THMADC.Post;
begin
  Execute(FRecordsAffected, EmptyParam);
end;

procedure THMADC.Use(Database: string);
begin
  Execute('Use ' + Database);
end;

procedure THMADC.DropTable(Table: string);
begin
  Execute('Drop Table ' + Table);
end;

function THMADC.Execute(Sql: THMSQL): _Recordset;
begin
  Result := Execute(Sql.OutLines.Text);
end;

function THMADC.Execute(Sql: THMSqlStoreProc): _Recordset;
begin
  Result := Execute(Sql.StoreProc.Text);
end;

end.