2010. szeptember 25., szombat

SQL Super INSERT/UPDATE Macro Class


Problem/Question/Abstract:

SQL Super INSERT/UPDATE Macro Class

Answer:

Ever got tired of dynamically generating SQL insert and update statements ?. Lots of virtually unreadable constructs such as things like .. (assume Data1:string Data2: integer Data3:TdateTime)

SqlCmd := 'insert into MyTable (Field1,Field2,Field2) values (' +  
                  QuotedStr(Data1) + ',' + IntToStr(Data2) + ',' + 'to_date('
                 + QuotedStr(FormatdateTime('dd/mm/yyyy',Data3)) + ','
                 + QuotedStr('dd/mm/yyyy') + '))';

{Horrible! and it gets worse as the column count gets higher}

This Class takes all the sweat out of this.

A single TQuery is created that handles ALL the SELECT,INSERT,UPDATE and DELETE operations.

FEATURES :

Support for ORACLE and MS-SQL (DateTimes are handled differently by these systems)
Would be grateful if anyone has Interbase,Informix or DB2 that can add functionality for these systems.

DebugMode which display the errant SQL statement and allows modification to correct it. The modified code can be cut to clipboard and is automatically saved to file LastSqlErr.sql on closing debug window.

Automatic error message dialogs or user handled errors via property LastErrorMess and LastSqlCommand.

Single value SQL select returns implemented AsString,AsInteger etc.

INSERT,UPDATE and DELETE super macro methods.


BASIC BUILDING PRIMITIVE FUNCTIONS :

There are a few primitive functions that are used by the Class, but are user callable if required.

    function SqlDateToStr(const Dte : TDateTime) : string;
    function StrToSqlDate(const DateStr : string) : TDateTime;

These functions are used to convert MS-SQL DateTimes to String and TDateTime. MS-SQL DateTimes are in format 'dd-MMM-yyyy hh:nn:ss.zzz'

   function sqlStr(...) : string;

This function is a super set of Borlands QuotedStr(). It has many overloads allowing the conversion of all required datatypes to a SQL string. Str quotes and trailing commas are handled (with comma being TRUE by default). One interesting oveload is an argument of "array of variant" which allows you to specify
an array of differing types to be converted to a SQL string list.

Examples:
   sqlStr('Harry');                 // Returns 'Harry', (Quotes are inculded)
   sqlStr(345.55);                   // Returns 345.55, (No Quotes)
   sqlStr(['GTR',8,Now]);     // 'GTR',8,'23-Oct-2002 13:44:23.000'


CLASS CONSTRUCTOR

Create(const DatabaseName : string; DatabaseSystemType : TSQLSystem);

    Used to create an instance of the object.
    eg.
    var MySql : TSQLCommand;
    MySql := TSQLCommand.Create(MyDb.DatabaseName,sysOracle);  // or
    MySql := TSQLCommand.Create('HELPDESK',sysOracle)
    DatabaseName is the DatabaseName of an open TDatabase Connection


CLASS PROPERTIES :

SqlQuery : TQuery                        -  Not normally used but can be set as a  TDatasource DataSet property for                                                                 TDBGrids etc.

LastErrorMess : string                  - Last Error message of a failed SQL statement

LastSQLCommand : string          - Last SQL statement of failed SQL

AutoErrorMessage : boolean       -  Auto display Error Dialogs [Yes/No]

DebugMode : boolean                   -  Pops up Errant SQL statement and allows mods

TerminateOnError : boolean        -  Terminate app is SQL staement error [Yes/No]

DatabaseName : string                    -  Set by constructor Create(), but can be  changed at runtime

DatabaseSystem : TSQLSystem     - Set by constructor Create(), but can be  Changed at run time


CLASS METHODS :

MISCELLANEOUS
SystemTime : TDateTime -  Returns System DateTime of the Database (System independent)

SystemUser : string            -  Returns Logged in Username of the Database (System independent)


SINGLE VALUE SELECT RETURNS
These function methods are designed to return a single value from a SQL query, such as AsString('select name from emp where id = 990') All the below methods have an alternate overloaded version that takes a select string + array of const formatting options. eg. AsString('select name from emp where id = %d',[990])
See Borlands Format() function for more info.

AsString(const SQLStatement : string) : string
AsInteger(const SQLStatement : string) : integer
AsFloat(const SQLStatement : string) : double
AsDateTime(const SQLStatement : string) : TDateTime


FREE FORM USER COMMANDS
These methods allow for ad-hoc user SQL constructs. The property SqlQury may be used with the commands after Open for Fields retieval or display in a TDBGrid by setting a TDataSource Dataset property to SqlQuery.
Once again FreeFormOpen and Exec have an alternate overloaded option of select string + array of const formatting options.

FreeFormOpen(const SQLStatement : string) : boolean -  Used to open a user ad-hoc query

FreeFormClose  - Used to close the ad-hoc query as opened by FreeFormOpen

Exec(const SQLStatement : string) : boolean  - Used for non cursor queries such as UPDATE etc.


DBMS MACRO COMMANDS
These commands take the sting out of SQL inserts and updates. The Column names are supplied as an array of strings. The update/insert values are specified in an array of variant. Specify tablename and where clause if required and the method will correctly format the SQL statement for the relevant system and execute it.

Insert(ColNames : array of string; Values : array of variant; const TableName : string) : boolean

Update(ColNames : array of string; Values : array of variant; const WhereClause : string; const TableName : string) : boolean

Delete(const WhereClause : string; const TableName : string) : boolean
    (Not that clever - here for completeness  can also be achieved via  Exec('delete from emp where id = 99') )


SIMPLIFIED EXAMPLE OF USE :

procedure MyUpdates;
var
  Name: string;
  SQL: TSQLCommand;
  ID: integer;
begin
  SQL := TSQL.Command.Create('MYBASE', sysOracle);
  SQL.DebugMode := true;
  Label1.Caption := SQL.SystemUser;
  Label2.Caption := SQL.SystemTime;
  ID := SQL.AsInteger('select ID from EMP where TAXNUM = 345');
  Name := SQL.AsString('select NAME from EMP where ID = %d', [ID]);

  SQL.Insert(['NAME', 'TAXDATE', 'ID', 'FLAG'],
    [Name, Now, ID, 0], 'NEWTAXTAB');

  SQL.Update(['TAXDATE', 'FLAG'],
    [Now, 5],
    'NAME = ' + sqlStr(Name, false), OLDTAXTAB);

  SQL.Delete('FLAG = 99', 'ARCTAXTAB');

  SQL.FreeFormOpen('select * from EMP);
    Label3.Caption := SQL.SqlQuery.Fields[0].AsString;
    MyDataSource.DataSet := SQL.SqlQuery;

    ...
    ...

    SQL.FreeFormClose;
    SQL.Free;
end;

Of course the return values of the inserts etc should be checked for TRUE and FALSE, but as stated it is a simplified example for clarity.



unit MahSql;

// =============================================================================
// Mike Heydon Sep 2002
// SQL programming aids
// There must be an open TDatabase connection
// =============================================================================

interface
uses Forms, StdCtrls, SysUtils, Dialogs, DBTables, Controls, DateUtils,
  ComCtrls, ExtCtrls, Buttons, Variants;

// NOTE : Uses DateUtils and Variants are Delphi 6 - remove for lower versions
type
  TSQLSystem = (sysOracle, sysMsSql); // Informix,DB2 users help appreciated here.

{TSQLCOMMAND CLASS}
  TSQLCommand = class(TObject)
  protected
    procedure ShowDebug;
    function OpenQuery(const Command: string;
                       CheckNull: boolean = true): boolean; virtual;
    function ExecQuery(const Command: string): boolean; virtual;
    function ExecFunc(const Func: string): string;
  private
    Memo: TMemo;
    Form: TForm;
    Status: TStatusBar;
    Panel: TPanel;
    btnRetry,
    btnClose: TBitBtn;
    FDatabaseSystem: TSQLSystem;
    FDebugID: char;
    FTerminateOnError,
    FDebugMode,
    FAutoErrorMessage: boolean;
    FLastSQLCommand,
    FLastErrorMess: string;
    Query: TQuery;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RetryClick(Sender: TObject);
    procedure SetDatabaseName(const NewValue: string);
    function GetDatabaseName: string;
  public
    constructor Create(const DatabaseName: string;
                       DatabaseSystemType: TSQLSystem);
    destructor Destroy; override;

    // Misc functions
    function SystemTime: TDateTime;
    function SystemUser: string;

    // Value returns calls - Always takes field[0] regardles of select cmd
    // Optional overload with formating eg.
    // AsString('select * from tab1 where N=%s and D=%d,['Fred',99]);
    function AsString(const SQLStatement: string): string; overload;
    function AsString(const SQLStatement: string;
                      FormatArguments: array of const): string; overload;
    function AsInteger(const SQLStatement: string): integer; overload;
    function AsInteger(const SQLStatement: string;
                       FormatArguments: array of const): integer; overload;
    function AsFloat(const SQLStatement: string): double; overload;
    function AsFloat(const SQLStatement: string;
                     FormatArguments: array of const): double; overload;
    function AsDateTime(const SQLStatement: string): TDateTime; overload;
    function AsDateTime(const SQLStatement: string;
                        FormatArguments: array of const): TDateTime; overload;

    // Free Form
    function FreeFormOpen(const SQLStatement: string): boolean; overload;
    function FreeFormOpen(const SQLStatement: string;
                          FormatArguments: array of const): boolean; overload;

    procedure FreeFormClose;

    function Exec(const SQLStatement: string): boolean; overload;
    function Exec(const SQLStatement: string;
                  FormatArguments: array of const): boolean; overload;

    // DBMS Inserts and Updates
    function Insert(ColNames: array of string;
                    Values: array of variant;
                    const TableName: string): boolean;

    function Update(ColNames: array of string;
                    Values: array of variant;
                    const WhereClause: string;
                    const TableName: string): boolean;

    function Delete(const WhereClause: string;
                    const TableName: string): boolean;

    // Properties
    property SqlQuery: TQuery read Query;
    property LastErrorMess: string read FLastErrorMess;
    property LastSQLCommand: string read FLastSQLCommand;
    property AutoErrorMessage: boolean read FAutoErrorMessage
                                       write FAutoErrorMessage;
    property DebugMode: boolean read FDebugMode write FDebugMode;
    property TerminateOnError: boolean read FTerminateOnError
                                       write FTerminateOnError;
    property DatabaseName: string read GetDatabaseName
                                  write SetDatabaseName;
    property DatabaseSystem: TSQLSystem read FDatabaseSystem
                                        write FDatabaseSystem;
  end;

  // ===================================
  // Primitive Class and User Functions
  // ===================================

  // Date routines
function SqlDateToStr(const Dte: TDateTime): string;
function StrToSqlDate(const DateStr: string): TDateTime;

// Quoted SQL string conversion routines
function sqlStr(Values: array of variant;
                DateTimeType: TSQLSystem = sysOracle): string; overload;
function sqlStr(Dte: TDateTime; DateTimeType: TSQLSystem;
                AddComma: boolean = true): string; overload;
function sqlStr(Dbl: double; NumDecimals: integer;
                AddComma: boolean = true): string; overload;
function sqlStr(const St: string; AddComma: boolean = true): string; overload;
function sqlStr(Num: integer; AddComma: boolean = true): string; overload;
function sqlStr(Flt: extended; AddComma: boolean = true): string; overload;
function sqlStr(Flt: extended; NumDecimals: integer;
                AddComma: boolean = true): string; overload;

// -----------------------------------------------------------------------------
implementation

const
  CrLf = #13#10; // Carriage Return / LineFeed pair

  // =========================
  // General Functions
  // =========================

  // ============================================
  // Return an MS-SQL date compatable string
  // ============================================

function SqlDateToStr(const Dte: TDateTime): string;
begin
  Result := FormatdateTime('dd-MMM-yyyy hh:nn:ss.zzz', Dte);
end;

// ============================================
// Return an SQL date from string
// Format 'dd-MMM-yyyy hh:nn:ss.zzz'
// ============================================

function StrToSqlDate(const DateStr: string): TDateTime;
var
  yyyy, dd, mm, hh, nn, ss, zzz: word;
  MMM: string;
  RetVar: TDateTime;
begin
  mm := 0;
  dd := StrToIntDef(copy(DateStr, 1, 2), 0);
  MMM := UpperCase(copy(DateStr, 4, 3));
  yyyy := StrToIntDef(copy(DateStr, 8, 4), 0);
  hh := StrToIntDef(copy(DateStr, 13, 2), 0);
  nn := StrToIntDef(copy(DateStr, 16, 2), 0);
  ss := StrToIntDef(copy(DateStr, 19, 2), 0);
  zzz := StrToIntDef(copy(DateStr, 22, 3), 0);

  if MMM = 'JAN' then
    mm := 1
  else if MMM = 'FEB' then
    mm := 2
  else if MMM = 'MAR' then
    mm := 3
  else if MMM = 'APR' then
    mm := 4
  else if MMM = 'MAY' then
    mm := 5
  else if MMM = 'JUN' then
    mm := 6
  else if MMM = 'JUL' then
    mm := 7
  else if MMM = 'AUG' then
    mm := 8
  else if MMM = 'SEP' then
    mm := 9
  else if MMM = 'OCT' then
    mm := 10
  else if MMM = 'NOV' then
    mm := 11
  else if MMM = 'DEC' then
    mm := 12;

  if not TryEncodeDateTime(yyyy, mm, dd, hh, nn, ss, zzz, Retvar) then
    RetVar := 0.0;

  Result := Retvar;
end;

// =================================================
// SQL string convertors - QuotedStr() Super Set
// =================================================

// TDATETIME

function sqlStr(Dte: TDateTime; DateTimeType: TSQLSystem;
  AddComma: boolean = true): string; overload;
var
  RetVar: string;
begin
  if DateTimeType = sysOracle then
    RetVar := 'to_date(' +
              QuotedStr(FormatdateTime('dd/mm/yyyy hh:nn:ss', Dte)) + ',' +
              QuotedStr('DD/MM/YYYY HH24:MI:SS') + ')'
  else
    RetVar := QuotedStr(SqlDateToStr(Dte));

  if AddComma then
    RetVar := Retvar + ',';
  Result := RetVar;
end;

// DOUBLE

function sqlStr(Dbl: double; NumDecimals: integer;
  AddComma: boolean = true): string; overload;
var
  Retvar: string;
begin
  RetVar := FormatFloat('###########0.' +
    StringOfChar('0', NumDecimals), Dbl);
  if AddComma then
    Retvar := Retvar + ',';
  Result := RetVar;
end;

// STRING

function sqlStr(const St: string;
  AddComma: boolean = true): string; overload;
var
  Retvar: string;
begin
  RetVar := QuotedStr(St);
  if AddComma then
    Retvar := RetVar + ',';
  Result := RetVar;
end;

// INTEGER

function sqlStr(Num: integer; AddComma: boolean = true): string; overload;
var
  RetVar: string;
begin
  RetVar := IntToStr(Num);
  if AddComma then
    RetVar := Retvar + ',';
  Result := RetVar;
end;

// EXTENDED

function sqlStr(Flt: extended; AddComma: boolean = true): string; overload;
var
  Retvar: string;
begin
  RetVar := FloatToStr(Flt);
  if AddComma then
    Retvar := Retvar + ',';
  Result := RetVar;
end;

// EXTENDED WITH PRECICISION

function sqlStr(Flt: extended; NumDecimals: integer;
  AddComma: boolean = true): string; overload;
var
  Retvar: string;
begin
  RetVar := FormatFloat('###########0.' +
    StringOfChar('0', NumDecimals), Flt);
  if AddComma then
    Retvar := Retvar + ',';
  Result := RetVar;
end;

// ARRAY OF VARIANT eg. [0,'Fred',45.44,'Married',Date]

function sqlStr(Values: array of variant;
  DateTimeType: TSQLSystem = sysOracle): string;
var
  RetVar: string;
  i: integer;
  VType: TVarType;
begin
  RetVar := '';

  for i := 0 to High(Values) do
  begin
    VType := VarType(Values[i]);

    case VType of
      varDate: RetVar := RetVar + sqlStr(TDateTime(Values[i]),
          DateTimeType, false);

      varInteger,
        varSmallint,
        varShortint,
        varByte,
        varWord,
        varLongword,
        varInt64: RetVar := RetVar + IntToStr(Values[i]);

      varSingle,
        varDouble,
        varCurrency: RetVar := RetVar + FloatToStr(Values[i]);

      varStrArg,
        varOleStr,
        varString: RetVar := RetVar + QuotedStr(Values[i]);
    else
      RetVar := RetVar + '????';
    end;

    RetVar := RetVar + ',';
  end;

  Delete(RetVar, length(RetVar), 1);
  Result := Retvar;
end;

// =============================================================================
// TSQLCommand Class
// =============================================================================

// =========================
// Construct & Destroy
// =========================

constructor TSQLCommand.Create(const DatabaseName: string;
  DatabaseSystemType: TSQLSystem);
begin
  Query := TQuery.Create(nil);
  Query.DatabaseName := DatabaseName;
  FLastErrorMess := '';
  FLastSQLCommand := '';
  FAutoErrorMessage := false;
  FDebugMode := false;
  FTerminateOnError := false;
  FDatabaseSystem := DatabaseSystemType;
end;

destructor TSQLCommand.Destroy;
begin
  Query.Free;
end;

// =============================
// Property Get/Set Methods
// =============================

procedure TSQLCommand.SetDatabaseName(const NewValue: string);
begin
  Query.Close;
  Query.DatabaseName := NewValue;
end;

function TSQLCommand.GetDatabaseName: string;
begin
  Result := Query.DatabaseName;
end;

// ==================================================
// Returns a string value from MS-SQL functions
// ==================================================

function TSQLCommand.ExecFunc(const Func: string): string;
var
  Value: string;
begin
  Value := '';

  if OpenQuery(Func, false) then
  begin
    SetLength(Value, Query.RecordSize + 1);
    Query.GetCurrentRecord(PChar(Value));
    SetLength(Value, StrLen(PChar(Value)));
  end;

  Query.Close;
  Result := Value;
end;

// =============================================================
// Show and Save Debug Statement if DebugMode = true - INTERNAL
// =============================================================

// Save on form close

procedure TSQLCommand.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Memo.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'LastSqlErr.sql');
end;

// Retry click

procedure TSQLCommand.RetryClick(Sender: TObject);
begin
  Query.SQL.Assign(memo.Lines);

  try
    if FDebugID = 'O' then
      Query.Open
    else
      Query.ExecSql;
    MessageDlg('SQL Command Ran OK', mtInformation, [mbOk], 0);
  except
    on E: Exception do
      MessageDlg('SQL Command Failed' + CrLf + CrLf + E.Message, mtError, [mbOk], 0);
  end;
end;

procedure TSQLCommand.ShowDebug;
var
  FName: string;
begin
  FName := ExtractFilePath(Application.ExeName) + 'LastSqlErr.sql';
  Form := TForm.Create(nil);
  Form.BorderIcons := Form.BorderIcons - [biMinimize];
  Status := TStatusBar.Create(Form);
  Status.Parent := Form;
  Status.SimplePanel := true;
  Status.SimpleText := '  ' + FName;
  Form.Height := 350;
  Form.Width := 600;
  Form.Caption := 'SQL Error';
  Form.Position := poScreenCenter;
  Panel := TPanel.Create(Form);
  Panel.Parent := Form;
  Panel.Align := alTop;
  Memo := TMemo.Create(Form);
  Memo.Parent := Form;
  Memo.Align := alClient;
  Memo.Font.Name := 'Courier New';
  Memo.Font.Size := 9;
  Memo.Lines.Assign(Query.SQL);
  btnClose := TBitBtn.Create(Form);
  btnClose.Parent := Panel;
  btnClose.Kind := bkClose;
  btnClose.Left := Form.Width - 90;
  btnClose.Top := 8;
  btnClose.Anchors := [akRight, akBottom];
  btnRetry := TBitBtn.Create(Form);
  btnRetry.Parent := Panel;
  btnRetry.Kind := bkRetry;
  btnRetry.Left := 8;
  btnRetry.Top := 8;
  btnRetry.ModalResult := mrNone;
  btnRetry.OnClick := RetryClick;
  Panel.Align := alBottom;
  Form.OnClose := FormClose;
  Form.ShowModal;
  Form.Free; // Free Form and all components in it
end;

// ===============================================
// Open the Query with error checking - INTERNAL
// ===============================================

function TSQLCommand.OpenQuery(const Command: string;
  CheckNull: boolean = true): boolean;
var
  Retvar,
    NullValue: boolean;
begin
  FDebugID := 'O';
  Retvar := false;
  Query.Close;
  FLastSQLCommand := Command;
  Query.SQL.Text := Command;

  try
    Query.Open;
    if CheckNull then
      NullValue := Query.EOF or Query.Fields[0].IsNull
    else
      NullValue := Query.EOF;

    if NullValue then
    begin
      FLastErrorMess := 'No Records in DataSet';
      if FAutoErrorMessage then
        MessageDlg('Open Query Failed!' + CrLf + CrLf + FLastErrorMess, mtError,
          [mbOk], 0);
    end
    else
      Retvar := true;
  except
    on E: Exception do
    begin
      FLastErrorMess := E.Message;
      if FAutoErrorMessage then
        MessageDlg('Open Query Failed!' + CrLf + CrLf + E.Message, mtError, [mbOk],
          0);
      if FDebugMode then
        ShowDebug;
      if FTerminateOnError then
      begin
        Application.Terminate;
        raise Exception.Create('');
      end;
    end;
  end;

  Result := Retvar;
end;

// ================================================
// Exec a query - UPDATE/INSERT etc - INTERNAL
// ================================================

function TSQLCommand.ExecQuery(const Command: string): boolean;
var
  Retvar: boolean;
begin
  FDebugID := 'E';
  Retvar := false;
  Query.Close;
  FLastSQLCommand := Command;
  Query.SQL.Text := Command;

  try
    Query.ExecSQL;
    Retvar := true;
  except
    on E: Exception do
    begin
      FLastErrorMess := E.Message;
      if FAutoErrorMessage then
        MessageDlg('Exec Query Failed!' + CrLf + CrLf + E.Message, mtError, [mbOk],
          0);
      if FDebugMode then
        ShowDebug;
      if FTerminateOnError then
      begin
        Application.Terminate;
        raise Exception.Create('');
      end;
    end;
  end;

  Result := Retvar;
end;

// ====================================================================
// Single Result sets with alternate overload of string/format array
// ====================================================================

// STRING

function TSQLCommand.AsString(const SQLStatement: string): string;
var
  Retvar: string;
begin
  Query.UniDirectional := true;

  if OpenQuery(SQLStatement) then
  begin
    Retvar := Query.Fields[0].AsString;
    Query.Close;
  end
  else
    Retvar := '';

  Result := Retvar;
end;

function TSQLCommand.AsString(const SQLStatement: string;
  FormatArguments: array of const): string;
begin
  Result := AsString(Format(SQLStatement, FormatArguments));
end;

// INTEGER

function TSQLCommand.AsInteger(const SQLStatement: string): integer;
var
  Retvar: integer;
begin
  Query.UniDirectional := true;

  if OpenQuery(SQLStatement) then
  begin
    Retvar := Query.Fields[0].AsInteger;
    Query.Close;
  end
  else
    Retvar := 0;

  Result := Retvar;
end;

function TSQLCommand.AsInteger(const SQLStatement: string;
  FormatArguments: array of const): integer;
begin
  Result := AsInteger(Format(SQLStatement, FormatArguments));
end;

// DOUBLE

function TSQLCommand.AsFloat(const SQLStatement: string): double;
var
  Retvar: double;
begin
  Query.UniDirectional := true;

  if OpenQuery(SQLStatement) then
  begin
    Retvar := Query.Fields[0].AsFloat;
    Query.Close;
  end
  else
    Retvar := 0.0;

  Result := Retvar;
end;

function TSQLCommand.AsFloat(const SQLStatement: string;
  FormatArguments: array of const): double;
begin
  Result := AsFloat(Format(SQLStatement, FormatArguments));
end;

// TDATETIME

function TSQLCommand.AsDateTime(const SQLStatement: string): TDateTime;
var
  Retvar: TDateTime;
begin
  Query.UniDirectional := true;

  if OpenQuery(SQLStatement) then
  begin
    Retvar := Query.Fields[0].AsDateTime;
    Query.Close;
  end
  else
    Retvar := 0.0;

  Result := Retvar;
end;

function TSQLCommand.AsDateTime(const SQLStatement: string;
  FormatArguments: array of const): TDateTime;
begin
  Result := AsDateTime(Format(SQLStatement, FormatArguments));
end;

// ====================================================
// Easy way to open and close free form statements
// ====================================================

function TSQLCommand.FreeFormOpen(const SQLStatement: string): boolean;
begin
  Query.UniDirectional := false;
  Result := OpenQuery(SQLStatement, false);
end;

function TSQLCommand.FreeFormOpen(const SQLStatement: string;
  FormatArguments: array of const): boolean;
begin
  Query.UniDirectional := false;
  Result := OpenQuery(Format(SQLStatement, FormatArguments), false);
end;

// CLOSE SQL

procedure TSQLCommand.FreeFormClose;
begin
  Query.Close;
end;

// EXEC SQL

function TSQLCommand.Exec(const SQLStatement: string): boolean;
begin
  Result := ExecQuery(SQLStatement);
end;

function TSQLCommand.Exec(const SQLStatement: string;
  FormatArguments: array of const): boolean;
begin
  Result := ExecQuery(Format(SQLStatement, FormatArguments));
end;

// ================================
// Inset/Update & Delete Commands
// ================================

// DBMS INSERT

function TSQLCommand.Insert(ColNames: array of string;
  Values: array of variant;
  const TableName: string): boolean;
var
  Cmd: string;
  VType: TVarType;
  Retvar: boolean;
  i: integer;
begin
  Query.UniDirectional := true;

  if (High(ColNames) = -1) or (High(Values) = -1) or
    (High(ColNames) <> High(Values)) then
  begin
    FLastErrorMess := 'Insert Statement ColNames()/Values() Mismatched';
    if FAutoErrorMessage then
      MessageDlg('Insert Failed!' + CrLf + CrLf + FLastErrorMess,
        mtError, [mbOk], 0);
    Retvar := false;
  end
  else
  begin
    Cmd := 'insert into ' + TableName + CrLf + '(' + ColNames[0];
    for i := 1 to High(ColNames) do
      Cmd := Cmd + ',' + ColNames[i];
    Cmd := Cmd + ')' + CrLf;
    Cmd := Cmd + 'values (';

    for i := 0 to High(Values) do
    begin
      VType := VarType(Values[i]);

      case VType of
        varDate: Cmd := Cmd + sqlStr(TDateTime(Values[i]),
            FDatabaseSystem, false);

        varInteger,
          varSmallint,
          varShortint,
          varByte,
          varWord,
          varLongword,
          varInt64: Cmd := Cmd + IntToStr(Values[i]);

        varSingle,
          varDouble,
          varCurrency: Cmd := Cmd + FloatToStr(Values[i]);

        varStrArg,
          varOleStr,
          varString: Cmd := Cmd + QuotedStr(Values[i]);
      else
        Cmd := Cmd + '????';
      end;

      Cmd := Cmd + ',';
    end;

    System.Delete(Cmd, length(Cmd), 1);
    Cmd := Cmd + ')';
    Retvar := ExecQuery(Cmd);
  end;

  Result := RetVar;
end;

// DBMS UPDATE

function TSQLCommand.Update(ColNames: array of string;
  Values: array of variant;
  const WhereClause: string;
  const TableName: string): boolean;
var
  Cmd, Parm: string;
  VType: TVarType;
  Retvar: boolean;
  i: integer;
begin
  Query.UniDirectional := true;

  if (High(ColNames) = -1) or (High(Values) = -1) or
    (High(ColNames) <> High(Values)) then
  begin
    FLastErrorMess := 'Update Statement ColNames()/Values() Mismatched';
    if FAutoErrorMessage then
      MessageDlg('Update Failed!' + CrLf + CrLf + FLastErrorMess,
        mtError, [mbOk], 0);
    Retvar := false;
  end
  else
  begin
    Cmd := 'update ' + TableName + ' set' + CrLf;

    for i := 0 to High(Values) do
    begin
      VType := VarType(Values[i]);

      case VType of
        varDate: Parm := sqlStr(TDateTime(Values[i]),
            FDatabaseSystem, false);

        varInteger,
          varSmallint,
          varShortint,
          varByte,
          varWord,
          varLongword,
          varInt64: Parm := IntToStr(Values[i]);

        varSingle,
          varDouble,
          varCurrency: Parm := FloatToStr(Values[i]);

        varStrArg,
          varOleStr,
          varString: Parm := QuotedStr(Values[i]);
      else
        Parm := '????';
      end;

      Cmd := Cmd + ColNames[i] + '=' + Parm + ',';
    end;

    System.Delete(Cmd, length(Cmd), 1);
    Cmd := Cmd + CrLf + 'where ' + WhereClause;
    Retvar := ExecQuery(Cmd);
  end;

  Result := RetVar;
end;

// DBMS DELETE

function TSQLCommand.Delete(const WhereClause: string;
  const TableName: string): boolean;
var
  Cmd: string;
begin
  Query.UniDirectional := true;
  Cmd := 'delete from ' + TableName + ' where ' + WhereClause;
  Result := ExecQuery(Cmd);
end;

// ============================
// Get the system date/time
// ============================

function TSQLCommand.SystemTime: TDateTime;
var
  Retvar: TDateTime;
begin
  Retvar := 0.0;
  Query.UniDirectional := true;

  if FDatabaseSystem = sysOracle then
  begin
    if OpenQuery('select sysdate from dual') then
      Retvar := Query.Fields[0].AsDateTime;
  end
  else
  begin
    if OpenQuery('select getdate()') then
      Retvar := Query.Fields[0].AsDateTime;
  end;

  Query.Close;
  Result := Retvar;
end;

// ============================
// Get the system user name
// ============================

function TSQLCommand.SystemUser: string;
var
  Retvar: string;
begin
  Retvar := '';
  Query.UniDirectional := true;

  if FDatabaseSystem = sysOracle then
  begin
    if OpenQuery('select user from dual') then
      Retvar := Query.Fields[0].AsString;
  end
  else
  begin
    Retvar := ExecFunc('select system_user');
  end;

  Query.Close;
  Result := Retvar;
end;
end.

Nincsenek megjegyzések:

Megjegyzés küldése