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.
|
