Mega Code Archive
SQL Super INSERTUPDATE Macro Class (Updated)
<![CDATA[
Title: SQL Super INSERT/UPDATE Macro Class (Updated)
Question: 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. The documentation is in the Answer field as it errors if this field is too long when you post an article.
Answer:
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;
(*----------------------------------------------------------------------------
DOCUMENTATION
This unit takes the hassle out of ad-hoc SQL queries. 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 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 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.
----------------------------------------------------------------------------*)
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; // Crriage 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.
]]>