Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to use SQL Super INSERT/UPDATE Macro Class Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
SQL Super INSERT/UPDATE Macro Class 10-Oct-04
Category
Database-SQL
Language
Delphi All Versions
Views
844
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Heydon, Mike
Reference URL:
			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) 
1   
2   SqlCmd := 'insert into MyTable (Field1,Field2,Field2) values (' +   
3                     QuotedStr(Data1) + ',' + IntToStr(Data2) + ',' + 'to_date(' 
4                    + QuotedStr(FormatdateTime('dd/mm/yyyy',Data3)) + ',' 
5                    + 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. 

6       function SqlDateToStr(const Dte : TDateTime) : string; 
7       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: 
8   
9      sqlStr('Harry');                 // Returns 'Harry', (Quotes are inculded) 
10     sqlStr(345.55);                   // Returns 345.55, (No Quotes) 
11     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. 

12  AsString(const SQLStatement : string) : string 
13  AsInteger(const SQLStatement : string) : integer 
14  AsFloat(const SQLStatement : string) : double 
15  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 : 

16  procedure MyUpdates;
17  var
18    Name: string;
19    SQL: TSQLCommand;
20    ID: integer;
21  begin
22    SQL := TSQL.Command.Create('MYBASE', sysOracle);
23    SQL.DebugMode := true;
24    Label1.Caption := SQL.SystemUser;
25    Label2.Caption := SQL.SystemTime;
26    ID := SQL.AsInteger('select ID from EMP where TAXNUM = 345');
27    Name := SQL.AsString('select NAME from EMP where ID = %d', [ID]);
28  
29    SQL.Insert(['NAME', 'TAXDATE', 'ID', 'FLAG'],
30      [Name, Now, ID, 0], 'NEWTAXTAB');
31  
32    SQL.Update(['TAXDATE', 'FLAG'],
33      [Now, 5],
34      'NAME = ' + sqlStr(Name, false), OLDTAXTAB);
35  
36    SQL.Delete('FLAG = 99', 'ARCTAXTAB');
37  
38    SQL.FreeFormOpen('select * from EMP');
39      Label3.Caption := SQL.SqlQuery.Fields[0].AsString;
40      MyDataSource.DataSet := SQL.SqlQuery;
41  
42      ...
43      ...
44  
45      SQL.FreeFormClose;
46      SQL.Free;
47  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. 



48  unit MahSql;
49  
50  // =============================================================================
51  // Mike Heydon Sep 2002
52  // SQL programming aids
53  // There must be an open TDatabase connection
54  // =============================================================================
55  
56  interface
57  uses Forms, StdCtrls, SysUtils, Dialogs, DBTables, Controls, DateUtils,
58    ComCtrls, ExtCtrls, Buttons, Variants;
59  
60  // NOTE : Uses DateUtils and Variants are Delphi 6 - remove for lower versions
61  type
62    TSQLSystem = (sysOracle, sysMsSql); // Informix,DB2 users help appreciated here.
63  
64  {TSQLCOMMAND CLASS}
65    TSQLCommand = class(TObject)
66    protected
67      procedure ShowDebug;
68      function OpenQuery(const Command: string;
69                         CheckNull: boolean = true): boolean; virtual;
70      function ExecQuery(const Command: string): boolean; virtual;
71      function ExecFunc(const Func: string): string;
72    private
73      Memo: TMemo;
74      Form: TForm;
75      Status: TStatusBar;
76      Panel: TPanel;
77      btnRetry,
78      btnClose: TBitBtn;
79      FDatabaseSystem: TSQLSystem;
80      FDebugID: char;
81      FTerminateOnError,
82      FDebugMode,
83      FAutoErrorMessage: boolean;
84      FLastSQLCommand,
85      FLastErrorMess: string;
86      Query: TQuery;
87      procedure FormClose(Sender: TObject; var Action: TCloseAction);
88      procedure RetryClick(Sender: TObject);
89      procedure SetDatabaseName(const NewValue: string);
90      function GetDatabaseName: string;
91    public
92      constructor Create(const DatabaseName: string;
93                         DatabaseSystemType: TSQLSystem);
94      destructor Destroy; override;
95  
96      // Misc functions
97      function SystemTime: TDateTime;
98      function SystemUser: string;
99  
100     // Value returns calls - Always takes field[0] regardles of select cmd
101     // Optional overload with formating eg.
102     // AsString('select * from tab1 where N=%s and D=%d,['Fred',99]);
103     function AsString(const SQLStatement: string): string; overload;
104     function AsString(const SQLStatement: string;
105                       FormatArguments: array of const): string; overload;
106     function AsInteger(const SQLStatement: string): integer; overload;
107     function AsInteger(const SQLStatement: string;
108                        FormatArguments: array of const): integer; overload;
109     function AsFloat(const SQLStatement: string): double; overload;
110     function AsFloat(const SQLStatement: string;
111                      FormatArguments: array of const): double; overload;
112     function AsDateTime(const SQLStatement: string): TDateTime; overload;
113     function AsDateTime(const SQLStatement: string;
114                         FormatArguments: array of const): TDateTime; overload;
115 
116     // Free Form
117     function FreeFormOpen(const SQLStatement: string): boolean; overload;
118     function FreeFormOpen(const SQLStatement: string;
119                           FormatArguments: array of const): boolean; overload;
120 
121     procedure FreeFormClose;
122 
123     function Exec(const SQLStatement: string): boolean; overload;
124     function Exec(const SQLStatement: string;
125                   FormatArguments: array of const): boolean; overload;
126 
127     // DBMS Inserts and Updates
128     function Insert(ColNames: array of string;
129                     Values: array of variant;
130                     const TableName: string): boolean;
131 
132     function Update(ColNames: array of string;
133                     Values: array of variant;
134                     const WhereClause: string;
135                     const TableName: string): boolean;
136 
137     function Delete(const WhereClause: string;
138                     const TableName: string): boolean;
139 
140     // Properties
141     property SqlQuery: TQuery read Query;
142     property LastErrorMess: string read FLastErrorMess;
143     property LastSQLCommand: string read FLastSQLCommand;
144     property AutoErrorMessage: boolean read FAutoErrorMessage
145                                        write FAutoErrorMessage;
146     property DebugMode: boolean read FDebugMode write FDebugMode;
147     property TerminateOnError: boolean read FTerminateOnError
148                                        write FTerminateOnError;
149     property DatabaseName: string read GetDatabaseName
150                                   write SetDatabaseName;
151     property DatabaseSystem: TSQLSystem read FDatabaseSystem
152                                         write FDatabaseSystem;
153   end;
154 
155   // ===================================
156   // Primitive Class and User Functions
157   // ===================================
158 
159   // Date routines
160 function SqlDateToStr(const Dte: TDateTime): string;
161 function StrToSqlDate(const DateStr: string): TDateTime;
162 
163 // Quoted SQL string conversion routines
164 function sqlStr(Values: array of variant;
165                 DateTimeType: TSQLSystem = sysOracle): string; overload;
166 function sqlStr(Dte: TDateTime; DateTimeType: TSQLSystem;
167                 AddComma: boolean = true): string; overload;
168 function sqlStr(Dbl: double; NumDecimals: integer;
169                 AddComma: boolean = true): string; overload;
170 function sqlStr(const St: string; AddComma: boolean = true): string; overload;
171 function sqlStr(Num: integer; AddComma: boolean = true): string; overload;
172 function sqlStr(Flt: extended; AddComma: boolean = true): string; overload;
173 function sqlStr(Flt: extended; NumDecimals: integer;
174                 AddComma: boolean = true): string; overload;
175 
176 // -----------------------------------------------------------------------------
177 implementation
178 
179 const
180   CrLf = #13#10; // Carriage Return / LineFeed pair
181 
182   // =========================
183   // General Functions
184   // =========================
185 
186   // ============================================
187   // Return an MS-SQL date compatable string
188   // ============================================
189 
190 function SqlDateToStr(const Dte: TDateTime): string;
191 begin
192   Result := FormatdateTime('dd-MMM-yyyy hh:nn:ss.zzz', Dte);
193 end;
194 
195 // ============================================
196 // Return an SQL date from string
197 // Format 'dd-MMM-yyyy hh:nn:ss.zzz'
198 // ============================================
199 
200 function StrToSqlDate(const DateStr: string): TDateTime;
201 var
202   yyyy, dd, mm, hh, nn, ss, zzz: word;
203   MMM: string;
204   RetVar: TDateTime;
205 begin
206   mm := 0;
207   dd := StrToIntDef(copy(DateStr, 1, 2), 0);
208   MMM := UpperCase(copy(DateStr, 4, 3));
209   yyyy := StrToIntDef(copy(DateStr, 8, 4), 0);
210   hh := StrToIntDef(copy(DateStr, 13, 2), 0);
211   nn := StrToIntDef(copy(DateStr, 16, 2), 0);
212   ss := StrToIntDef(copy(DateStr, 19, 2), 0);
213   zzz := StrToIntDef(copy(DateStr, 22, 3), 0);
214 
215   if MMM = 'JAN' then
216     mm := 1
217   else if MMM = 'FEB' then
218     mm := 2
219   else if MMM = 'MAR' then
220     mm := 3
221   else if MMM = 'APR' then
222     mm := 4
223   else if MMM = 'MAY' then
224     mm := 5
225   else if MMM = 'JUN' then
226     mm := 6
227   else if MMM = 'JUL' then
228     mm := 7
229   else if MMM = 'AUG' then
230     mm := 8
231   else if MMM = 'SEP' then
232     mm := 9
233   else if MMM = 'OCT' then
234     mm := 10
235   else if MMM = 'NOV' then
236     mm := 11
237   else if MMM = 'DEC' then
238     mm := 12;
239 
240   if not TryEncodeDateTime(yyyy, mm, dd, hh, nn, ss, zzz, Retvar) then
241     RetVar := 0.0;
242 
243   Result := Retvar;
244 end;
245 
246 // =================================================
247 // SQL string convertors - QuotedStr() Super Set
248 // =================================================
249 
250 // TDATETIME
251 
252 function sqlStr(Dte: TDateTime; DateTimeType: TSQLSystem;
253   AddComma: boolean = true): string; overload;
254 var
255   RetVar: string;
256 begin
257   if DateTimeType = sysOracle then
258     RetVar := 'to_date(' +
259               QuotedStr(FormatdateTime('dd/mm/yyyy hh:nn:ss', Dte)) + ',' +
260               QuotedStr('DD/MM/YYYY HH24:MI:SS') + ')'
261   else
262     RetVar := QuotedStr(SqlDateToStr(Dte));
263 
264   if AddComma then
265     RetVar := Retvar + ',';
266   Result := RetVar;
267 end;
268 
269 // DOUBLE
270 
271 function sqlStr(Dbl: double; NumDecimals: integer;
272   AddComma: boolean = true): string; overload;
273 var
274   Retvar: string;
275 begin
276   RetVar := FormatFloat('###########0.' +
277     StringOfChar('0', NumDecimals), Dbl);
278   if AddComma then
279     Retvar := Retvar + ',';
280   Result := RetVar;
281 end;
282 
283 // STRING
284 
285 function sqlStr(const St: string;
286   AddComma: boolean = true): string; overload;
287 var
288   Retvar: string;
289 begin
290   RetVar := QuotedStr(St);
291   if AddComma then
292     Retvar := RetVar + ',';
293   Result := RetVar;
294 end;
295 
296 // INTEGER
297 
298 function sqlStr(Num: integer; AddComma: boolean = true): string; overload;
299 var
300   RetVar: string;
301 begin
302   RetVar := IntToStr(Num);
303   if AddComma then
304     RetVar := Retvar + ',';
305   Result := RetVar;
306 end;
307 
308 // EXTENDED
309 
310 function sqlStr(Flt: extended; AddComma: boolean = true): string; overload;
311 var
312   Retvar: string;
313 begin
314   RetVar := FloatToStr(Flt);
315   if AddComma then
316     Retvar := Retvar + ',';
317   Result := RetVar;
318 end;
319 
320 // EXTENDED WITH PRECICISION
321 
322 function sqlStr(Flt: extended; NumDecimals: integer;
323   AddComma: boolean = true): string; overload;
324 var
325   Retvar: string;
326 begin
327   RetVar := FormatFloat('###########0.' +
328     StringOfChar('0', NumDecimals), Flt);
329   if AddComma then
330     Retvar := Retvar + ',';
331   Result := RetVar;
332 end;
333 
334 // ARRAY OF VARIANT eg. [0,'Fred',45.44,'Married',Date]
335 
336 function sqlStr(Values: array of variant;
337   DateTimeType: TSQLSystem = sysOracle): string;
338 var
339   RetVar: string;
340   i: integer;
341   VType: TVarType;
342 begin
343   RetVar := '';
344 
345   for i := 0 to High(Values) do
346   begin
347     VType := VarType(Values[i]);
348 
349     case VType of
350       varDate: RetVar := RetVar + sqlStr(TDateTime(Values[i]),
351           DateTimeType, false);
352 
353       varInteger,
354         varSmallint,
355         varShortint,
356         varByte,
357         varWord,
358         varLongword,
359         varInt64: RetVar := RetVar + IntToStr(Values[i]);
360 
361       varSingle,
362         varDouble,
363         varCurrency: RetVar := RetVar + FloatToStr(Values[i]);
364 
365       varStrArg,
366         varOleStr,
367         varString: RetVar := RetVar + QuotedStr(Values[i]);
368     else
369       RetVar := RetVar + '????';
370     end;
371 
372     RetVar := RetVar + ',';
373   end;
374 
375   Delete(RetVar, length(RetVar), 1);
376   Result := Retvar;
377 end;
378 
379 // =============================================================================
380 // TSQLCommand Class
381 // =============================================================================
382 
383 // =========================
384 // Construct & Destroy
385 // =========================
386 
387 constructor TSQLCommand.Create(const DatabaseName: string;
388   DatabaseSystemType: TSQLSystem);
389 begin
390   Query := TQuery.Create(nil);
391   Query.DatabaseName := DatabaseName;
392   FLastErrorMess := '';
393   FLastSQLCommand := '';
394   FAutoErrorMessage := false;
395   FDebugMode := false;
396   FTerminateOnError := false;
397   FDatabaseSystem := DatabaseSystemType;
398 end;
399 
400 destructor TSQLCommand.Destroy;
401 begin
402   Query.Free;
403 end;
404 
405 // =============================
406 // Property Get/Set Methods
407 // =============================
408 
409 procedure TSQLCommand.SetDatabaseName(const NewValue: string);
410 begin
411   Query.Close;
412   Query.DatabaseName := NewValue;
413 end;
414 
415 function TSQLCommand.GetDatabaseName: string;
416 begin
417   Result := Query.DatabaseName;
418 end;
419 
420 // ==================================================
421 // Returns a string value from MS-SQL functions
422 // ==================================================
423 
424 function TSQLCommand.ExecFunc(const Func: string): string;
425 var
426   Value: string;
427 begin
428   Value := '';
429 
430   if OpenQuery(Func, false) then
431   begin
432     SetLength(Value, Query.RecordSize + 1);
433     Query.GetCurrentRecord(PChar(Value));
434     SetLength(Value, StrLen(PChar(Value)));
435   end;
436 
437   Query.Close;
438   Result := Value;
439 end;
440 
441 // =============================================================
442 // Show and Save Debug Statement if DebugMode = true - INTERNAL
443 // =============================================================
444 
445 // Save on form close
446 
447 procedure TSQLCommand.FormClose(Sender: TObject; var Action: TCloseAction);
448 begin
449   Memo.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'LastSqlErr.sql');
450 end;
451 
452 // Retry click
453 
454 procedure TSQLCommand.RetryClick(Sender: TObject);
455 begin
456   Query.SQL.Assign(memo.Lines);
457 
458   try
459     if FDebugID = 'O' then
460       Query.Open
461     else
462       Query.ExecSql;
463     MessageDlg('SQL Command Ran OK', mtInformation, [mbOk], 0);
464   except
465     on E: Exception do
466       MessageDlg('SQL Command Failed' + CrLf + CrLf + E.message, mtError, [mbOk], 
467 0);
468   end;
469 end;
470 
471 procedure TSQLCommand.ShowDebug;
472 var
473   FName: string;
474 begin
475   FName := ExtractFilePath(Application.ExeName) + 'LastSqlErr.sql';
476   Form := TForm.Create(nil);
477   Form.BorderIcons := Form.BorderIcons - [biMinimize];
478   Status := TStatusBar.Create(Form);
479   Status.Parent := Form;
480   Status.SimplePanel := true;
481   Status.SimpleText := '  ' + FName;
482   Form.Height := 350;
483   Form.Width := 600;
484   Form.Caption := 'SQL Error';
485   Form.Position := poScreenCenter;
486   Panel := TPanel.Create(Form);
487   Panel.Parent := Form;
488   Panel.Align := alTop;
489   Memo := TMemo.Create(Form);
490   Memo.Parent := Form;
491   Memo.Align := alClient;
492   Memo.Font.Name := 'Courier New';
493   Memo.Font.Size := 9;
494   Memo.Lines.Assign(Query.SQL);
495   btnClose := TBitBtn.Create(Form);
496   btnClose.Parent := Panel;
497   btnClose.Kind := bkClose;
498   btnClose.Left := Form.Width - 90;
499   btnClose.Top := 8;
500   btnClose.Anchors := [akRight, akBottom];
501   btnRetry := TBitBtn.Create(Form);
502   btnRetry.Parent := Panel;
503   btnRetry.Kind := bkRetry;
504   btnRetry.Left := 8;
505   btnRetry.Top := 8;
506   btnRetry.ModalResult := mrNone;
507   btnRetry.OnClick := RetryClick;
508   Panel.Align := alBottom;
509   Form.OnClose := FormClose;
510   Form.ShowModal;
511   Form.Free; // Free Form and all components in it
512 end;
513 
514 // ===============================================
515 // Open the Query with error checking - INTERNAL
516 // ===============================================
517 
518 function TSQLCommand.OpenQuery(const Command: string;
519   CheckNull: boolean = true): boolean;
520 var
521   Retvar,
522     NullValue: boolean;
523 begin
524   FDebugID := 'O';
525   Retvar := false;
526   Query.Close;
527   FLastSQLCommand := Command;
528   Query.SQL.Text := Command;
529 
530   try
531     Query.Open;
532     if CheckNull then
533       NullValue := Query.EOF or Query.Fields[0].IsNull
534     else
535       NullValue := Query.EOF;
536 
537     if NullValue then
538     begin
539       FLastErrorMess := 'No Records in DataSet';
540       if FAutoErrorMessage then
541         MessageDlg('Open Query Failed!' + CrLf + CrLf + FLastErrorMess, mtError,
542           [mbOk], 0);
543     end
544     else
545       Retvar := true;
546   except
547     on E: Exception do
548     begin
549       FLastErrorMess := E.message;
550       if FAutoErrorMessage then
551         MessageDlg('Open Query Failed!' + CrLf + CrLf + E.message, mtError, [mbOk],
552           0);
553       if FDebugMode then
554         ShowDebug;
555       if FTerminateOnError then
556       begin
557         Application.Terminate;
558         raise Exception.Create('');
559       end;
560     end;
561   end;
562 
563   Result := Retvar;
564 end;
565 
566 // ================================================
567 // Exec a query - UPDATE/INSERT etc - INTERNAL
568 // ================================================
569 
570 function TSQLCommand.ExecQuery(const Command: string): boolean;
571 var
572   Retvar: boolean;
573 begin
574   FDebugID := 'E';
575   Retvar := false;
576   Query.Close;
577   FLastSQLCommand := Command;
578   Query.SQL.Text := Command;
579 
580   try
581     Query.ExecSQL;
582     Retvar := true;
583   except
584     on E: Exception do
585     begin
586       FLastErrorMess := E.message;
587       if FAutoErrorMessage then
588         MessageDlg('Exec Query Failed!' + CrLf + CrLf + E.message, mtError, [mbOk],
589           0);
590       if FDebugMode then
591         ShowDebug;
592       if FTerminateOnError then
593       begin
594         Application.Terminate;
595         raise Exception.Create('');
596       end;
597     end;
598   end;
599 
600   Result := Retvar;
601 end;
602 
603 // ====================================================================
604 // Single Result sets with alternate overload of string/format array
605 // ====================================================================
606 
607 // STRING
608 
609 function TSQLCommand.AsString(const SQLStatement: string): string;
610 var
611   Retvar: string;
612 begin
613   Query.UniDirectional := true;
614 
615   if OpenQuery(SQLStatement) then
616   begin
617     Retvar := Query.Fields[0].AsString;
618     Query.Close;
619   end
620   else
621     Retvar := '';
622 
623   Result := Retvar;
624 end;
625 
626 function TSQLCommand.AsString(const SQLStatement: string;
627   FormatArguments: array of const): string;
628 begin
629   Result := AsString(Format(SQLStatement, FormatArguments));
630 end;
631 
632 // INTEGER
633 
634 function TSQLCommand.AsInteger(const SQLStatement: string): integer;
635 var
636   Retvar: integer;
637 begin
638   Query.UniDirectional := true;
639 
640   if OpenQuery(SQLStatement) then
641   begin
642     Retvar := Query.Fields[0].AsInteger;
643     Query.Close;
644   end
645   else
646     Retvar := 0;
647 
648   Result := Retvar;
649 end;
650 
651 function TSQLCommand.AsInteger(const SQLStatement: string;
652   FormatArguments: array of const): integer;
653 begin
654   Result := AsInteger(Format(SQLStatement, FormatArguments));
655 end;
656 
657 // DOUBLE
658 
659 function TSQLCommand.AsFloat(const SQLStatement: string): double;
660 var
661   Retvar: double;
662 begin
663   Query.UniDirectional := true;
664 
665   if OpenQuery(SQLStatement) then
666   begin
667     Retvar := Query.Fields[0].AsFloat;
668     Query.Close;
669   end
670   else
671     Retvar := 0.0;
672 
673   Result := Retvar;
674 end;
675 
676 function TSQLCommand.AsFloat(const SQLStatement: string;
677   FormatArguments: array of const): double;
678 begin
679   Result := AsFloat(Format(SQLStatement, FormatArguments));
680 end;
681 
682 // TDATETIME
683 
684 function TSQLCommand.AsDateTime(const SQLStatement: string): TDateTime;
685 var
686   Retvar: TDateTime;
687 begin
688   Query.UniDirectional := true;
689 
690   if OpenQuery(SQLStatement) then
691   begin
692     Retvar := Query.Fields[0].AsDateTime;
693     Query.Close;
694   end
695   else
696     Retvar := 0.0;
697 
698   Result := Retvar;
699 end;
700 
701 function TSQLCommand.AsDateTime(const SQLStatement: string;
702   FormatArguments: array of const): TDateTime;
703 begin
704   Result := AsDateTime(Format(SQLStatement, FormatArguments));
705 end;
706 
707 // ====================================================
708 // Easy way to open and close free form statements
709 // ====================================================
710 
711 function TSQLCommand.FreeFormOpen(const SQLStatement: string): boolean;
712 begin
713   Query.UniDirectional := false;
714   Result := OpenQuery(SQLStatement, false);
715 end;
716 
717 function TSQLCommand.FreeFormOpen(const SQLStatement: string;
718   FormatArguments: array of const): boolean;
719 begin
720   Query.UniDirectional := false;
721   Result := OpenQuery(Format(SQLStatement, FormatArguments), false);
722 end;
723 
724 // CLOSE SQL
725 
726 procedure TSQLCommand.FreeFormClose;
727 begin
728   Query.Close;
729 end;
730 
731 // EXEC SQL
732 
733 function TSQLCommand.Exec(const SQLStatement: string): boolean;
734 begin
735   Result := ExecQuery(SQLStatement);
736 end;
737 
738 function TSQLCommand.Exec(const SQLStatement: string;
739   FormatArguments: array of const): boolean;
740 begin
741   Result := ExecQuery(Format(SQLStatement, FormatArguments));
742 end;
743 
744 // ================================
745 // Inset/Update & Delete Commands
746 // ================================
747 
748 // DBMS INSERT
749 
750 function TSQLCommand.Insert(ColNames: array of string;
751   Values: array of variant;
752   const TableName: string): boolean;
753 var
754   Cmd: string;
755   VType: TVarType;
756   Retvar: boolean;
757   i: integer;
758 begin
759   Query.UniDirectional := true;
760 
761   if (High(ColNames) = -1) or (High(Values) = -1) or
762     (High(ColNames) <> High(Values)) then
763   begin
764     FLastErrorMess := 'Insert Statement ColNames()/Values() Mismatched';
765     if FAutoErrorMessage then
766       MessageDlg('Insert Failed!' + CrLf + CrLf + FLastErrorMess,
767         mtError, [mbOk], 0);
768     Retvar := false;
769   end
770   else
771   begin
772     Cmd := 'insert into ' + TableName + CrLf + '(' + ColNames[0];
773     for i := 1 to High(ColNames) do
774       Cmd := Cmd + ',' + ColNames[i];
775     Cmd := Cmd + ')' + CrLf;
776     Cmd := Cmd + 'values (';
777 
778     for i := 0 to High(Values) do
779     begin
780       VType := VarType(Values[i]);
781 
782       case VType of
783         varDate: Cmd := Cmd + sqlStr(TDateTime(Values[i]),
784             FDatabaseSystem, false);
785 
786         varInteger,
787           varSmallint,
788           varShortint,
789           varByte,
790           varWord,
791           varLongword,
792           varInt64: Cmd := Cmd + IntToStr(Values[i]);
793 
794         varSingle,
795           varDouble,
796           varCurrency: Cmd := Cmd + FloatToStr(Values[i]);
797 
798         varStrArg,
799           varOleStr,
800           varString: Cmd := Cmd + QuotedStr(Values[i]);
801       else
802         Cmd := Cmd + '????';
803       end;
804 
805       Cmd := Cmd + ',';
806     end;
807 
808     System.Delete(Cmd, length(Cmd), 1);
809     Cmd := Cmd + ')';
810     Retvar := ExecQuery(Cmd);
811   end;
812 
813   Result := RetVar;
814 end;
815 
816 // DBMS UPDATE
817 
818 function TSQLCommand.Update(ColNames: array of string;
819   Values: array of variant;
820   const WhereClause: string;
821   const TableName: string): boolean;
822 var
823   Cmd, Parm: string;
824   VType: TVarType;
825   Retvar: boolean;
826   i: integer;
827 begin
828   Query.UniDirectional := true;
829 
830   if (High(ColNames) = -1) or (High(Values) = -1) or
831     (High(ColNames) <> High(Values)) then
832   begin
833     FLastErrorMess := 'Update Statement ColNames()/Values() Mismatched';
834     if FAutoErrorMessage then
835       MessageDlg('Update Failed!' + CrLf + CrLf + FLastErrorMess,
836         mtError, [mbOk], 0);
837     Retvar := false;
838   end
839   else
840   begin
841     Cmd := 'update ' + TableName + ' set' + CrLf;
842 
843     for i := 0 to High(Values) do
844     begin
845       VType := VarType(Values[i]);
846 
847       case VType of
848         varDate: Parm := sqlStr(TDateTime(Values[i]),
849             FDatabaseSystem, false);
850 
851         varInteger,
852           varSmallint,
853           varShortint,
854           varByte,
855           varWord,
856           varLongword,
857           varInt64: Parm := IntToStr(Values[i]);
858 
859         varSingle,
860           varDouble,
861           varCurrency: Parm := FloatToStr(Values[i]);
862 
863         varStrArg,
864           varOleStr,
865           varString: Parm := QuotedStr(Values[i]);
866       else
867         Parm := '????';
868       end;
869 
870       Cmd := Cmd + ColNames[i] + '=' + Parm + ',';
871     end;
872 
873     System.Delete(Cmd, length(Cmd), 1);
874     Cmd := Cmd + CrLf + 'where ' + WhereClause;
875     Retvar := ExecQuery(Cmd);
876   end;
877 
878   Result := RetVar;
879 end;
880 
881 // DBMS DELETE
882 
883 function TSQLCommand.Delete(const WhereClause: string;
884   const TableName: string): boolean;
885 var
886   Cmd: string;
887 begin
888   Query.UniDirectional := true;
889   Cmd := 'delete from ' + TableName + ' where ' + WhereClause;
890   Result := ExecQuery(Cmd);
891 end;
892 
893 // ============================
894 // Get the system date/time
895 // ============================
896 
897 function TSQLCommand.SystemTime: TDateTime;
898 var
899   Retvar: TDateTime;
900 begin
901   Retvar := 0.0;
902   Query.UniDirectional := true;
903 
904   if FDatabaseSystem = sysOracle then
905   begin
906     if OpenQuery('select sysdate from dual') then
907       Retvar := Query.Fields[0].AsDateTime;
908   end
909   else
910   begin
911     if OpenQuery('select getdate()') then
912       Retvar := Query.Fields[0].AsDateTime;
913   end;
914 
915   Query.Close;
916   Result := Retvar;
917 end;
918 
919 // ============================
920 // Get the system user name
921 // ============================
922 
923 function TSQLCommand.SystemUser: string;
924 var
925   Retvar: string;
926 begin
927   Retvar := '';
928   Query.UniDirectional := true;
929 
930   if FDatabaseSystem = sysOracle then
931   begin
932     if OpenQuery('select user from dual') then
933       Retvar := Query.Fields[0].AsString;
934   end
935   else
936   begin
937     Retvar := ExecFunc('select system_user');
938   end;
939 
940   Query.Close;
941   Result := Retvar;
942 end;
943 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC