X3420CAV

1unit SQLLang;
2
3interface
4
5uses
6  System.Classes, System.SysUtils, System.Generics.Collections;
7
8type
9  TFieldType = (ftInteger, ftString, ftFloat, ftDateTime, ftBlob, ftBoolean, ftParam);
10
11  TDIType = (diInc, diDec, diDiv, diMul);
12
13  TWhereUnion = (wuAnd, wuOr, wuNotAnd, wuNotOr);
14
15  TField = record
16  private
17    function GetSQL: string;
18  public
19    FieldType: TFieldType;
20    FieldName: string;
21    PrimaryKey: Boolean;
22    AutoInc: Boolean;
23    NotNull: Boolean;
24    property SQL: string read GetSQL;
25  end;
26
27  TFields = TList<TField>;
28
29  TFieldNames = TStringList;
30
31  TUnionWhere = TStringList;
32
33  TInsertValue = record
34  public
35    FieldType: TFieldType;
36    FieldName: string;
37    Value: Variant;
38  end;
39
40  TInsertValues = TList<TInsertValue>;
41
42  TDIValue = record
43  public
44    FieldType: TFieldType;
45    DIType: TDIType;
46    FieldName: string;
47    Value: Variant;
48  end;
49
50  TDIValues = TList<TDIValue>;
51
52  TTable = class;
53
54  TInsertInto = class;
55
56  TUpdate = class;
57
58  TSelect = class;
59
60  TDelete = class;
61
62  TDropTable = class;
63
64  TUpdateBlob = class;
65
66  BaseSQL = class
67  private
68    FName: string;
69    procedure SetName(const Value: string);
70  public
71    property TableName: string read FName write SetName;
72  end;
73
74  SQL = class(BaseSQL)
75  private
76    FWhereStr: string;
77    FUWheres: TUnionWhere;
78    function GetWhere: string;
79    function InsertUnion(const Union: TWhereUnion): string;
80  public
81    function GetSQL: string; virtual; abstract;
82    procedure EndCreate; virtual;
83    procedure Clear; virtual;
84    procedure WhereParenthesesOpen(Union: TWhereUnion = wuAnd);
85    procedure WhereParenthesesClose;
86    procedure WhereFieldLike(const FieldName: string; const Value: string; const Union: TWhereUnion = wuAnd); overload;
87    procedure WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: TDateTime; const Union: TWhereUnion = wuAnd); overload;
88    procedure WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: Extended; const Union: TWhereUnion = wuAnd); overload;
89    procedure WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: Integer; const Union: TWhereUnion = wuAnd); overload;
90    procedure WhereFieldIsNull(const FieldName: string; const Union: TWhereUnion = wuAnd);
91    procedure WhereFieldIsNotNull(const FieldName: string; const Union: TWhereUnion = wuAnd);
92    procedure WhereField(const FieldName, Oper: string; const FieldValue: string; const Union: TWhereUnion = wuAnd); overload;
93    procedure WhereField(const FieldName, Oper: string; const FieldValue: Extended; const Union: TWhereUnion = wuAnd); overload;
94    procedure WhereField(const FieldName, Oper: string; const FieldValue: Integer; const Union: TWhereUnion = wuAnd); overload;
95    procedure WhereField(const FieldName, Oper: string; const FieldValue: TDateTime; const Union: TWhereUnion = wuAnd); overload;
96    procedure WhereField(const FieldName, Oper: string; const FieldValue: Boolean; const Union: TWhereUnion = wuAnd); overload;
97    procedure WhereFieldWOQ(const FieldName, Oper: string; const FieldValue: string; const Union: TWhereUnion = wuAnd);  //Без ковычек
98
99    procedure WhereFieldIN(const FieldName: string; const FieldValues: array of string; const Union: TWhereUnion = wuAnd); overload;
100    procedure WhereFieldIN(const FieldName: string; const FieldValues: array of Extended; const Union: TWhereUnion = wuAnd); overload;
101    procedure WhereFieldIN(const FieldName: string; const FieldValues: array of Integer; const Union: TWhereUnion = wuAnd); overload;
102    procedure WhereFieldIN(const FieldName: string; const FieldValues: array of TDateTime; const Union: TWhereUnion = wuAnd); overload;
103    procedure WhereFieldIN(const FieldName: string; const FieldValues: array of Boolean; const Union: TWhereUnion = wuAnd); overload;
104    procedure WhereFieldEqual(const FieldName: string; const FieldValue: string; const Union: TWhereUnion = wuAnd); overload;
105    procedure WhereFieldEqual(const FieldName: string; const FieldValue: Extended; const Union: TWhereUnion = wuAnd); overload;
106    procedure WhereFieldEqual(const FieldName: string; const FieldValue: Integer; const Union: TWhereUnion = wuAnd); overload;
107    procedure WhereFieldEqual(const FieldName: string; const FieldValue: TDateTime; const Union: TWhereUnion = wuAnd); overload;
108    procedure WhereFieldEqual(const FieldName: string; const FieldValue: Boolean; const Union: TWhereUnion = wuAnd); overload;
109    procedure WhereNotFieldEqual(const FieldName: string; const FieldValue: string; const Union: TWhereUnion = wuAnd); overload;
110    procedure WhereNotFieldEqual(const FieldName: string; const FieldValue: Extended; const Union: TWhereUnion = wuAnd); overload;
111    procedure WhereNotFieldEqual(const FieldName: string; const FieldValue: Integer; const Union: TWhereUnion = wuAnd); overload;
112    procedure WhereNotFieldEqual(const FieldName: string; const FieldValue: TDateTime; const Union: TWhereUnion = wuAnd); overload;
113    procedure WhereNotFieldEqual(const FieldName: string; const FieldValue: Boolean; const Union: TWhereUnion = wuAnd); overload;
114    procedure WhereExists(const Select: string; const Union: TWhereUnion = wuAnd);
115    procedure WhereStr(const Value: string);
116    constructor Create; virtual;
117    destructor Destroy; override;
118    property Where: string read GetWhere;
119  public
120    class function CreateField: TField;
121    class function CreateTable: TTable; overload;
122    class function CreateTable(TableName: string): TTable; overload;
123    class function InsertInto: TInsertInto; overload;
124    class function InsertInto(TableName: string): TInsertInto; overload;
125    class function Delete: TDelete; overload;
126    class function Delete(TableName: string): TDelete; overload;
127    class function DropTable: TDropTable;
128    class function Update: TUpdate; overload;
129    class function Update(TableName: string): TUpdate; overload;
130    class function Select: TSelect; overload;
131    class function Select(TableName: string): TSelect; overload;
132    class function UpdateBlob: TUpdateBlob; overload;
133    class function UpdateBlob(TableName: string): TUpdateBlob; overload;
134    class function UpdateBlob(TableName, FieldName: string): TUpdateBlob; overload;
135    //
136    class function PRAGMA(Key, Value: string): string;
137    class function SelectLastInsertID: string;
138    //
139  end;
140
141  TTable = class(BaseSQL)
142  private
143    function GetField(Index: Integer): TField;
144    procedure SetField(Index: Integer; const Value: TField);
145  protected
146    FFields: TFields;
147  public
148    function GetSQL: string; virtual;
149    procedure AddField(Name: string; FieldType: TFieldType; PrimaryKey: Boolean = False; NotNull: Boolean = False; AutoInc: Boolean = False); virtual;
150    procedure EndCreate; virtual;
151    procedure Clear; virtual;
152    constructor Create; overload; virtual;
153    constructor Create(pTableName: string); overload; virtual;
154    destructor Destroy; override;
155    property Fields[Index: Integer]: TField read GetField write SetField;
156    property TableName;
157  end;
158
159  TInsertInto = class(BaseSQL)
160  private
161    FDoubleDoubleQuote: Boolean;
162    procedure SetDoubleDoubleQuote(const Value: Boolean);
163  protected
164    FFieldValues: TInsertValues;
165  public
166    function GetSQL: string;
167    procedure EndCreate;
168    procedure Clear;
169    procedure AddValue(FieldName: string; FieldValue: Integer); overload;
170    procedure AddValue(FieldName: string; FieldValue: string); overload;
171    procedure AddValue(FieldName: string; FieldValue: Extended); overload;
172    procedure AddValue(FieldName: string; FieldValue: TDateTime); overload;
173    procedure AddValue(FieldName: string; FieldValue: Boolean); overload;
174    procedure AddValueAsParam(FieldName: string; ParamChar: string = ':'; CharOnly: Boolean = False);
175    constructor Create; virtual;
176    destructor Destroy; override;
177    property TableName;
178    property DoubleDoubleQuote: Boolean read FDoubleDoubleQuote write SetDoubleDoubleQuote default False;
179  end;
180
181  TUpdate = class(SQL)
182  private
183    FDoubleDoubleQuote: Boolean;
184    procedure SetDoubleDoubleQuote(const Value: Boolean);
185  protected
186    FFieldValues: TInsertValues;
187    FDIValues: TDIValues;
188  public
189    function GetSQL: string; override;
190    procedure Clear; override;
191    procedure AddValue(FieldName: string; FieldValue: Integer); overload;
192    procedure AddValue(FieldName: string; FieldValue: string); overload;
193    procedure AddValue(FieldName: string; FieldValue: Extended); overload;
194    procedure AddValue(FieldName: string; FieldValue: TDateTime); overload;
195    procedure AddValue(FieldName: string; FieldValue: Boolean); overload;
196    procedure IncValue(FieldName: string; Value: Integer); overload;
197    procedure IncValue(FieldName: string; Value: Extended); overload;
198    procedure DecValue(FieldName: string; Value: Integer); overload;
199    procedure DecValue(FieldName: string; Value: Extended); overload;
200    procedure MulValue(FieldName: string; Value: Integer); overload;
201    procedure MulValue(FieldName: string; Value: Extended); overload;
202    procedure DivValue(FieldName: string; Value: Integer); overload;
203    procedure DivValue(FieldName: string; Value: Extended); overload;
204    procedure AddValueAsParam(FieldName: string; ParamChar: string = ':'; CharOnly: Boolean = False);
205    constructor Create; override;
206    destructor Destroy; override;
207    property TableName;
208    property DoubleDoubleQuote: Boolean read FDoubleDoubleQuote write SetDoubleDoubleQuote;
209  end;
210
211  TSelect = class(SQL)
212  private
213    FOrderBy: TStringList;
214    FJoins: TStringList;
215    FLimitInt: Integer;
216    FDistinct: Boolean;
217    function GetField(Index: Integer): string;
218    procedure SetField(Index: Integer; const Value: string);
219    function GetOrderBy: string;
220  protected
221    FFields: TFieldNames;
222  public
223    function GetSQL: string; override;
224    procedure AddField(Name: string; IFNULL: string = '');
225    procedure AddFieldCount(Name: string; Alias: string = '');
226    procedure InnerJoin(JoinTable, BaseField, JoinField: string);
227    procedure LeftJoin(JoinTable, BaseField, JoinField: string; AndWhere: string = '');
228    procedure RightJoin(JoinTable, BaseField, JoinField: string);
229    procedure OrderBy(FieldName: string; DESC: Boolean = False);
230    procedure Clear; override;
231    constructor Create; override;
232    destructor Destroy; override;
233    property Fields[Index: Integer]: string read GetField write SetField;
234    property Distinct: Boolean read FDistinct write FDistinct;
235    property Limit: Integer read FLimitInt write FLimitInt;
236    property OrderByStr: string read GetOrderBy;
237    property TableName;
238  end;
239
240  TDelete = class(SQL)
241  public
242    function GetSQL: string; override;
243    procedure Clear; override;
244    constructor Create; override;
245    destructor Destroy; override;
246    property Where;
247    property TableName;
248  end;
249
250  TDropTable = class(BaseSQL)
251  public
252    function GetSQL: string;
253    procedure EndCreate;
254    procedure Clear;
255    constructor Create; virtual;
256    property TableName;
257  end;
258
259  TUpdateBlob = class(SQL)
260  private
261    FBlobField: string;
262  public
263    function GetSQL: string; override;
264    property BlobField: string read FBlobField write FBlobField;
265    property Where;
266    property TableName;
267  end;
268
269function Field(Name: string; FieldType: TFieldType; PrimaryKey, NotNull, AutoInc: Boolean): TField;
270
271function InsertValue(Name: string; FieldType: TFieldType; Value: Variant): TInsertValue;
272
273function FloatToSQLStr(Value: Extended): string;
274
275function FieldTypeToStr(Value: TFieldType): string;
276
277function FieldTypeToString(Value: TFieldType): string;
278
279implementation
280
281function FloatToSQLStr(Value: Extended): string;
282begin
283  Result := FloatToStr(Value);
284  Result := StringReplace(Result, ',', '.', [rfReplaceAll]);
285end;
286
287function BoolToSQLStr(Value: Boolean): string;
288begin
289  if Value then
290    Exit('1')
291  else
292    Exit('0');
293end;
294
295function FieldTypeToStr(Value: TFieldType): string;
296begin
297  case Value of
298    ftInteger:
299      Result := 'INTEGER';
300    ftString:
301      Result := 'TEXT';
302    ftFloat:
303      Result := 'REAL';
304    ftDateTime:
305      Result := 'REAL';
306    ftBlob:
307      Result := 'BLOB';
308    ftBoolean:
309      Result := 'INTEGER';
310  end;
311end;
312
313function FieldTypeToString(Value: TFieldType): string;
314begin
315  case Value of
316    ftInteger:
317      Result := 'ftInteger';
318    ftString:
319      Result := 'ftString';
320    ftFloat:
321      Result := 'ftFloat';
322    ftDateTime:
323      Result := 'ftDateTime';
324    ftBlob:
325      Result := 'ftBlob';
326    ftBoolean:
327      Result := 'ftBoolean';
328  end;
329end;
330
331function Field;
332begin
333  Result.FieldType := FieldType;
334  Result.FieldName := Name;
335  Result.PrimaryKey := PrimaryKey;
336  Result.AutoInc := AutoInc;
337  Result.NotNull := NotNull;
338end;
339
340function InsertValue(Name: string; FieldType: TFieldType; Value: Variant): TInsertValue; overload;
341begin
342  Result.FieldName := Name;
343  Result.FieldType := FieldType;
344  Result.Value := Value;
345end;
346
347function DIValue(Name: string; FieldType: TFieldType; DIType: TDIType; Value: Variant): TDIValue; overload;
348begin
349  Result.FieldName := Name;
350  Result.FieldType := FieldType;
351  Result.DIType := DIType;
352  Result.Value := Value;
353end;
354
355{ SQL }
356
357class function SQL.CreateField: TField;
358begin
359  Result := Field('', ftInteger, False, False, False);
360end;
361
362class function SQL.CreateTable: TTable;
363begin
364  Result := TTable.Create;
365end;
366
367class function SQL.Delete: TDelete;
368begin
369  Result := TDelete.Create;
370end;
371
372class function SQL.CreateTable(TableName: string): TTable;
373begin
374  Result := TTable.Create;
375  Result.TableName := TableName;
376end;
377
378class function SQL.Delete(TableName: string): TDelete;
379begin
380  Result := TDelete.Create;
381  Result.TableName := TableName;
382end;
383
384destructor SQL.Destroy;
385begin
386  FUWheres.Free;
387  inherited;
388end;
389
390class function SQL.DropTable: TDropTable;
391begin
392  Result := TDropTable.Create;
393end;
394
395class function SQL.InsertInto(TableName: string): TInsertInto;
396begin
397  Result := TInsertInto.Create;
398  Result.TableName := TableName;
399end;
400
401class function SQL.InsertInto: TInsertInto;
402begin
403  Result := TInsertInto.Create;
404end;
405
406class function SQL.PRAGMA(Key, Value: string): string;
407begin
408  Result := 'PRAGMA ' + Key + ' = "' + Value + '"';
409end;
410
411class function SQL.Select(TableName: string): TSelect;
412begin
413  Result := TSelect.Create;
414  Result.TableName := TableName;
415end;
416
417class function SQL.SelectLastInsertID: string;
418begin
419  Result := 'SELECT LAST_INSERT_ID();';
420end;
421
422class function SQL.Select: TSelect;
423begin
424  Result := TSelect.Create;
425end;
426
427class function SQL.Update: TUpdate;
428begin
429  Result := TUpdate.Create;
430end;
431
432class function SQL.Update(TableName: string): TUpdate;
433begin
434  Result := TUpdate.Create;
435  Result.TableName := TableName;
436end;
437
438class function SQL.UpdateBlob: TUpdateBlob;
439begin
440  Result := TUpdateBlob.Create;
441end;
442
443class function SQL.UpdateBlob(TableName: string): TUpdateBlob;
444begin
445  Result := TUpdateBlob.Create;
446  Result.TableName := TableName;
447end;
448
449class function SQL.UpdateBlob(TableName, FieldName: string): TUpdateBlob;
450begin
451  Result := TUpdateBlob.Create;
452  Result.TableName := TableName;
453  Result.BlobField := FieldName;
454end;
455
456{ TTable }
457
458constructor TTable.Create(pTableName: string);
459begin
460  Create;
461  TableName := pTableName;
462end;
463
464destructor TTable.Destroy;
465begin
466  FFields.Free;
467  inherited;
468end;
469
470constructor TTable.Create;
471begin
472  inherited;
473  FFields := TFields.Create;
474end;
475
476function TTable.GetField(Index: Integer): TField;
477begin
478  Result := FFields[Index];
479end;
480
481function TTable.GetSQL: string;
482var
483  i: Integer;
484begin
485  Result := 'CREATE TABLE ' + TableName + ' (';
486  for i := 0 to FFields.Count - 1 do
487  begin
488    Result := Result + FFields[i].GetSQL;
489    if i <> FFields.Count - 1 then
490      Result := Result + ', ';
491  end;
492  Result := Result + ')';
493end;
494
495procedure TTable.AddField;
496begin
497  FFields.Add(Field(Name, FieldType, PrimaryKey, NotNull, AutoInc));
498end;
499
500procedure TTable.Clear;
501begin
502  TableName := '';
503  FFields.Clear;
504end;
505
506procedure TTable.EndCreate;
507begin
508  Clear;
509  Free;
510end;
511
512procedure TTable.SetField(Index: Integer; const Value: TField);
513begin
514  FFields[Index] := Value;
515end;
516
517{ TField }
518
519function TField.GetSQL: string;
520begin
521  Result := FieldName + ' ' + FieldTypeToStr(FieldType);
522  if PrimaryKey then
523    Result := Result + ' PRIMARY KEY';
524  if NotNull then
525    Result := Result + ' NOT NULL';
526  if AutoInc then
527    Result := Result + ' AUTOINCREMENT';
528end;
529
530{ TInsertInto }
531
532constructor TInsertInto.Create;
533begin
534  inherited;
535  FDoubleDoubleQuote := False;
536  FFieldValues := TInsertValues.Create;
537end;
538
539destructor TInsertInto.Destroy;
540begin
541  FFieldValues.Free;
542  inherited;
543end;
544
545function TInsertInto.GetSQL: string;
546var
547  i: Integer;
548begin
549  Result := 'INSERT INTO ' + TableName + ' (';
550  for i := 0 to FFieldValues.Count - 1 do
551  begin
552    Result := Result + FFieldValues[i].FieldName;
553    if i <> FFieldValues.Count - 1 then
554      Result := Result + ', ';
555  end;
556  Result := Result + ') VALUES (';
557  for i := 0 to FFieldValues.Count - 1 do
558  begin
559    case FFieldValues[i].FieldType of
560      ftInteger:
561        Result := Result + QuotedStr(IntToStr(FFieldValues[i].Value));
562      ftString:
563        Result := Result + QuotedStr(FFieldValues[i].Value);
564      ftFloat:
565        Result := Result + QuotedStr(FloatToSQLStr(FFieldValues[i].Value));
566      ftDateTime:
567        Result := Result + QuotedStr(FloatToSQLStr(FFieldValues[i].Value));
568      ftBoolean:
569        Result := Result + QuotedStr(BoolToSQLStr(FFieldValues[i].Value));
570      ftParam:
571        Result := Result + FFieldValues[i].Value;
572    end;
573    if i <> FFieldValues.Count - 1 then
574      Result := Result + ', ';
575  end;
576  Result := Result + ')';
577end;
578
579procedure TInsertInto.SetDoubleDoubleQuote(const Value: Boolean);
580begin
581  FDoubleDoubleQuote := Value;
582end;
583
584procedure TInsertInto.AddValue(FieldName: string; FieldValue: Extended);
585begin
586  FFieldValues.Add(InsertValue(FieldName, ftFloat, FieldValue));
587end;
588
589procedure TInsertInto.AddValue(FieldName, FieldValue: string);
590begin
591  if FDoubleDoubleQuote then
592    FieldValue := StringReplace(FieldValue, '"', '""', [rfReplaceAll]);
593  FFieldValues.Add(InsertValue(FieldName, ftString, FieldValue));
594end;
595
596procedure TInsertInto.AddValue(FieldName: string; FieldValue: Integer);
597begin
598  FFieldValues.Add(InsertValue(FieldName, ftInteger, FieldValue));
599end;
600
601procedure TInsertInto.AddValue(FieldName: string; FieldValue: Boolean);
602begin
603  FFieldValues.Add(InsertValue(FieldName, ftBoolean, FieldValue));
604end;
605
606procedure TInsertInto.AddValueAsParam(FieldName: string; ParamChar: string = ':'; CharOnly: Boolean = False);
607begin
608  if CharOnly then
609    FFieldValues.Add(InsertValue(FieldName, ftParam, ParamChar))
610  else
611    FFieldValues.Add(InsertValue(FieldName, ftParam, ParamChar + FieldName));
612end;
613
614procedure TInsertInto.AddValue(FieldName: string; FieldValue: TDateTime);
615begin
616  FFieldValues.Add(InsertValue(FieldName, ftDateTime, FieldValue));
617end;
618
619procedure TInsertInto.Clear;
620begin
621  TableName := '';
622  FFieldValues.Clear;
623end;
624
625procedure TInsertInto.EndCreate;
626begin
627  Clear;
628  Free;
629end;
630
631{ TSelect }
632
633procedure TSelect.AddField(Name: string; IFNULL: string);
634begin
635  if IFNULL.IsEmpty then
636    FFields.Add(Name)
637  else
638    FFields.Add('IFNULL(' + Name + ', ' + IFNULL + ')');
639end;
640
641procedure TSelect.AddFieldCount(Name, Alias: string);
642begin
643  Name := 'COUNT(' + Name + ')';
644  if Alias <> '' then
645    Name := Name + ' as ' + Alias;
646  FFields.Add(Name);
647end;
648
649procedure TSelect.Clear;
650begin
651  FName := '';
652  FFields.Clear;
653  FJoins.Clear;
654  FOrderBy.Clear;
655end;
656
657constructor TSelect.Create;
658begin
659  inherited;
660  FFields := TFieldNames.Create;
661  FJoins := TStringList.Create;
662  FOrderBy := TStringList.Create;
663  FLimitInt := 0;
664end;
665
666destructor TSelect.Destroy;
667begin
668  FFields.Free;
669  FJoins.Free;
670  FOrderBy.Free;
671  inherited;
672end;
673
674function TSelect.GetField(Index: Integer): string;
675begin
676  Result := FFields[Index];
677end;
678
679function TSelect.GetOrderBy: string;
680var
681  i: Integer;
682begin
683  if FOrderBy.Count <= 0 then
684    Exit('');
685  Result := ' ORDER BY ';
686  for i := 0 to FOrderBy.Count - 1 do
687  begin
688    Result := Result + FOrderBy[i];
689    if i <> FOrderBy.Count - 1 then
690      Result := Result + ', ';
691  end;
692end;
693
694function TSelect.GetSQL: string;
695var
696  i: Integer;
697  FieldsStr, ALimit, AJoins: string;
698begin
699  if FLimitInt > 0 then
700    ALimit := ' LIMIT ' + IntToStr(FLimitInt);
701  if FDistinct then
702    Result := 'SELECT DISTINCT '
703  else
704    Result := 'SELECT ';
705  FieldsStr := '';
706  for i := 0 to FFields.Count - 1 do
707  begin
708    FieldsStr := FieldsStr + FFields[i];
709    if i <> FFields.Count - 1 then
710      FieldsStr := FieldsStr + ', ';
711  end;
712  AJoins := '';
713  for i := 0 to FJoins.Count - 1 do
714    AJoins := AJoins + FJoins[i] + ' ';
715  if AJoins <> '' then
716    AJoins := ' ' + AJoins;
717  Result := Result + FieldsStr + ' FROM ' + TableName + AJoins + Where + OrderByStr + ALimit;
718end;
719
720procedure TSelect.InnerJoin(JoinTable, BaseField, JoinField: string);
721begin
722  FJoins.Add('INNER JOIN ' + JoinTable + ' ON ' + FName + '.' + BaseField + '=' + JoinTable + '.' + JoinField);
723end;
724
725procedure TSelect.LeftJoin(JoinTable, BaseField, JoinField: string; AndWhere: string = '');
726var
727  tmp: string;
728begin
729  if AndWhere.Length > 0 then
730    tmp := ' and ' + AndWhere
731  else
732    tmp := '';
733  FJoins.Add('LEFT JOIN ' + JoinTable + ' ON ' + FName + '.' + BaseField + '=' + JoinTable + '.' + JoinField + tmp);
734end;
735
736procedure TSelect.OrderBy(FieldName: string; DESC: Boolean);
737begin
738  if DESC then
739    FieldName := FieldName + ' DESC';
740  FOrderBy.Add(FieldName);
741end;
742
743procedure TSelect.RightJoin(JoinTable, BaseField, JoinField: string);
744begin
745  FJoins.Add('RIGHT JOIN ' + JoinTable + ' ON ' + FName + '.' + BaseField + '=' + JoinTable + '.' + JoinField);
746end;
747
748procedure TSelect.SetField(Index: Integer; const Value: string);
749begin
750  FFields[Index] := Value;
751end;
752
753{ TDelete }
754
755procedure TDelete.Clear;
756begin
757  FName := '';
758end;
759
760constructor TDelete.Create;
761begin
762  inherited;
763end;
764
765destructor TDelete.Destroy;
766begin
767  //
768  inherited;
769end;
770
771function TDelete.GetSQL: string;
772begin
773  Result := 'DELETE FROM ' + FName + Where;
774end;
775
776{ TUpdate }
777
778procedure TUpdate.AddValue(FieldName: string; FieldValue: Extended);
779begin
780  FFieldValues.Add(InsertValue(FieldName, ftFloat, FieldValue));
781end;
782
783procedure TUpdate.AddValue(FieldName, FieldValue: string);
784begin
785  if FDoubleDoubleQuote then
786    FieldValue := StringReplace(FieldValue, '"', '""', [rfReplaceAll]);
787  FFieldValues.Add(InsertValue(FieldName, ftString, FieldValue));
788end;
789
790procedure TUpdate.AddValue(FieldName: string; FieldValue: Integer);
791begin
792  FFieldValues.Add(InsertValue(FieldName, ftInteger, FieldValue));
793end;
794
795procedure TUpdate.AddValue(FieldName: string; FieldValue: Boolean);
796begin
797  FFieldValues.Add(InsertValue(FieldName, ftBoolean, FieldValue));
798end;
799
800procedure TUpdate.AddValueAsParam(FieldName: string; ParamChar: string = ':'; CharOnly: Boolean = False);
801begin
802  if CharOnly then
803    FFieldValues.Add(InsertValue(FieldName, ftParam, ParamChar))
804  else
805    FFieldValues.Add(InsertValue(FieldName, ftParam, ParamChar + FieldName));
806end;
807
808procedure TUpdate.AddValue(FieldName: string; FieldValue: TDateTime);
809begin
810  FFieldValues.Add(InsertValue(FieldName, ftDateTime, FieldValue));
811end;
812
813procedure TUpdate.Clear;
814begin
815  TableName := '';
816  FFieldValues.Clear;
817end;
818
819constructor TUpdate.Create;
820begin
821  inherited;
822  FDoubleDoubleQuote := False;
823  FFieldValues := TInsertValues.Create;
824  FDIValues := TDIValues.Create;
825end;
826
827procedure TUpdate.DecValue(FieldName: string; Value: Extended);
828begin
829  FDIValues.Add(DIValue(FieldName, ftFloat, diDec, Value));
830end;
831
832destructor TUpdate.Destroy;
833begin
834  FFieldValues.Free;
835  FDIValues.Free;
836  inherited;
837end;
838
839procedure TUpdate.DivValue(FieldName: string; Value: Integer);
840begin
841  FDIValues.Add(DIValue(FieldName, ftInteger, diDiv, Value));
842end;
843
844procedure TUpdate.DivValue(FieldName: string; Value: Extended);
845begin
846  FDIValues.Add(DIValue(FieldName, ftFloat, diDiv, Value));
847end;
848
849procedure TUpdate.DecValue(FieldName: string; Value: Integer);
850begin
851  FDIValues.Add(DIValue(FieldName, ftInteger, diDec, Value));
852end;
853
854procedure TUpdate.IncValue(FieldName: string; Value: Extended);
855begin
856  FDIValues.Add(DIValue(FieldName, ftFloat, diInc, Value));
857end;
858
859procedure TUpdate.IncValue(FieldName: string; Value: Integer);
860begin
861  FDIValues.Add(DIValue(FieldName, ftInteger, diInc, Value));
862end;
863
864procedure TUpdate.MulValue(FieldName: string; Value: Integer);
865begin
866  FDIValues.Add(DIValue(FieldName, ftInteger, diMul, Value));
867end;
868
869procedure TUpdate.MulValue(FieldName: string; Value: Extended);
870begin
871  FDIValues.Add(DIValue(FieldName, ftFloat, diMul, Value));
872end;
873
874procedure TUpdate.SetDoubleDoubleQuote(const Value: Boolean);
875begin
876  FDoubleDoubleQuote := Value;
877end;
878
879function TUpdate.GetSQL: string;
880var
881  i: Integer;
882  str: string;
883begin
884  Result := 'UPDATE ' + TableName + ' SET ';
885  for i := 0 to FFieldValues.Count - 1 do
886  begin
887    str := '';
888    case FFieldValues[i].FieldType of
889      ftInteger:
890        str := QuotedStr(IntToStr(FFieldValues[i].Value));
891      ftString:
892        str := QuotedStr(FFieldValues[i].Value);
893      ftFloat:
894        str := QuotedStr(FloatToSQLStr(FFieldValues[i].Value));
895      ftDateTime:
896        str := QuotedStr(FloatToSQLStr(FFieldValues[i].Value));
897      ftBoolean:
898        str := QuotedStr(BoolToSQLStr(FFieldValues[i].Value));
899      ftParam:
900        str := FFieldValues[i].Value;
901    end;
902    Result := Result + FFieldValues[i].FieldName + ' = ' + str;
903    if i <> FFieldValues.Count - 1 then
904      Result := Result + ', ';
905  end;
906  for i := 0 to FDIValues.Count - 1 do
907  begin
908    str := '';
909    case FDIValues[i].FieldType of
910      ftInteger:
911        str := QuotedStr(IntToStr(FDIValues[i].Value));
912      ftFloat:
913        str := QuotedStr(FloatToSQLStr(FDIValues[i].Value));
914    end;
915    case FDIValues[i].DIType of
916      diInc:
917        Result := Result + FDIValues[i].FieldName + ' = ' + FDIValues[i].FieldName + ' + ' + str;
918      diDec:
919        Result := Result + FDIValues[i].FieldName + ' = ' + FDIValues[i].FieldName + ' - ' + str;
920      diMul:
921        Result := Result + FDIValues[i].FieldName + ' = ' + FDIValues[i].FieldName + ' * ' + str;
922      diDiv:
923        Result := Result + FDIValues[i].FieldName + ' = ' + FDIValues[i].FieldName + ' / ' + str;
924    end;
925    if i <> FDIValues.Count - 1 then
926      Result := Result + ', ';
927  end;
928  Result := Result + Where;
929end;
930
931{ TDropTable }
932
933procedure TDropTable.Clear;
934begin
935  TableName := '';
936end;
937
938constructor TDropTable.Create;
939begin
940  inherited;
941end;
942
943procedure TDropTable.EndCreate;
944begin
945  Clear;
946  Free;
947end;
948
949function TDropTable.GetSQL: string;
950begin
951  Result := 'DROP TABLE ' + TableName;
952end;
953
954{ SQL }
955
956procedure SQL.Clear;
957begin
958  FUWheres.Clear;
959end;
960
961constructor SQL.Create;
962begin
963  inherited;
964  FUWheres := TUnionWhere.Create;
965end;
966
967procedure SQL.EndCreate;
968begin
969  Clear;
970  Free;
971end;
972
973function SQL.GetWhere: string;
974var
975  i: Integer;
976begin
977  Result := '';
978  for i := 0 to FUWheres.Count - 1 do
979    Result := Result + FUWheres[i];
980  if FWhereStr <> '' then
981    Result := Result + ' ' + FWhereStr;
982  if Result <> '' then
983    Result := ' WHERE ' + Result;
984end;
985
986procedure BaseSQL.SetName(const Value: string);
987begin
988  FName := Value;
989end;
990
991procedure SQL.WhereExists(const Select: string; const Union: TWhereUnion);
992begin
993  FUWheres.Add(InsertUnion(Union) + ' EXISTS(' + Select + ')');
994end;
995
996procedure SQL.WhereField(const FieldName, Oper: string; const FieldValue: Extended; const Union: TWhereUnion);
997begin
998  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + QuotedStr(FloatToSQLStr(FieldValue)));
999end;
1000
1001procedure SQL.WhereField(const FieldName, Oper: string; const FieldValue: string; const Union: TWhereUnion);
1002begin
1003  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + QuotedStr(FieldValue));
1004end;
1005
1006procedure SQL.WhereField(const FieldName, Oper: string; const FieldValue: Integer; const Union: TWhereUnion);
1007begin
1008  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + QuotedStr(IntToStr(FieldValue)));
1009end;
1010
1011procedure SQL.WhereField(const FieldName, Oper: string; const FieldValue: Boolean; const Union: TWhereUnion);
1012begin
1013  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + QuotedStr(BoolToSQLStr(FieldValue)));
1014end;
1015
1016procedure SQL.WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: TDateTime; const Union: TWhereUnion);
1017begin
1018  FUWheres.Add(InsertUnion(Union) + FieldName + ' between ' + FloatToSQLStr(ValueLeft) + ' and ' + FloatToSQLStr(ValueRight));
1019end;
1020
1021procedure SQL.WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: Extended; const Union: TWhereUnion);
1022begin
1023  FUWheres.Add(InsertUnion(Union) + FieldName + ' between ' + FloatToSQLStr(ValueLeft) + ' and ' + FloatToSQLStr(ValueRight));
1024end;
1025
1026procedure SQL.WhereFieldBetween(const FieldName: string; const ValueLeft, ValueRight: Integer; const Union: TWhereUnion);
1027begin
1028  FUWheres.Add(InsertUnion(Union) + FieldName + ' between ' + IntToStr(ValueLeft) + ' and ' + IntToStr(ValueRight));
1029end;
1030
1031procedure SQL.WhereField(const FieldName, Oper: string; const FieldValue: TDateTime; const Union: TWhereUnion);
1032begin
1033  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + QuotedStr(FloatToSQLStr(FieldValue)));
1034end;
1035
1036procedure SQL.WhereFieldEqual(const FieldName: string; const FieldValue: string; const Union: TWhereUnion);
1037begin
1038  WhereField(FieldName, '=', FieldValue, Union);
1039end;
1040
1041procedure SQL.WhereFieldEqual(const FieldName: string; const FieldValue: Integer; const Union: TWhereUnion);
1042begin
1043  WhereField(FieldName, '=', FieldValue, Union);
1044end;
1045
1046procedure SQL.WhereFieldEqual(const FieldName: string; const FieldValue: Extended; const Union: TWhereUnion);
1047begin
1048  WhereField(FieldName, '=', FieldValue, Union);
1049end;
1050
1051procedure SQL.WhereFieldEqual(const FieldName: string; const FieldValue: Boolean; const Union: TWhereUnion);
1052begin
1053  WhereField(FieldName, '=', FieldValue, Union);
1054end;
1055
1056procedure SQL.WhereFieldIN(const FieldName: string; const FieldValues: array of Extended; const Union: TWhereUnion);
1057var
1058  FieldValue: string;
1059  i: Integer;
1060begin
1061  FieldValue := '';
1062  for i := Low(FieldValues) to High(FieldValues) do
1063  begin
1064    FieldValue := FieldValue + QuotedStr(FloatToSQLStr(FieldValues[i]));
1065    if i <> High(FieldValues) then
1066      FieldValue := FieldValue + ', ';
1067  end;
1068  WhereFieldWOQ(FieldName, ' IN ', '(' + FieldValue + ')', Union);
1069end;
1070
1071procedure SQL.WhereFieldIN(const FieldName: string; const FieldValues: array of string; const Union: TWhereUnion);
1072var
1073  FieldValue: string;
1074  i: Integer;
1075begin
1076  FieldValue := '';
1077  for i := Low(FieldValues) to High(FieldValues) do
1078  begin
1079    FieldValue := FieldValue + QuotedStr(FieldValues[i]);
1080    if i <> High(FieldValues) then
1081      FieldValue := FieldValue + ', ';
1082  end;
1083  WhereFieldWOQ(FieldName, ' IN ', '(' + FieldValue + ')', Union);
1084end;
1085
1086procedure SQL.WhereFieldIN(const FieldName: string; const FieldValues: array of Integer; const Union: TWhereUnion);
1087var
1088  FieldValue: string;
1089  i: Integer;
1090begin
1091  FieldValue := '';
1092  for i := Low(FieldValues) to High(FieldValues) do
1093  begin
1094    FieldValue := FieldValue + QuotedStr(IntToStr(FieldValues[i]));
1095    if i <> High(FieldValues) then
1096      FieldValue := FieldValue + ', ';
1097  end;
1098  WhereFieldWOQ(FieldName, ' IN ', '(' + FieldValue + ')', Union);
1099end;
1100
1101procedure SQL.WhereFieldIN(const FieldName: string; const FieldValues: array of Boolean; const Union: TWhereUnion);
1102var
1103  FieldValue: string;
1104  i: Integer;
1105begin
1106  FieldValue := '';
1107  for i := Low(FieldValues) to High(FieldValues) do
1108  begin
1109    FieldValue := FieldValue + QuotedStr(BoolToSQLStr(FieldValues[i]));
1110    if i <> High(FieldValues) then
1111      FieldValue := FieldValue + ', ';
1112  end;
1113  WhereFieldWOQ(FieldName, ' IN ', '(' + FieldValue + ')', Union);
1114end;
1115
1116procedure SQL.WhereFieldIsNotNull(const FieldName: string; const Union: TWhereUnion);
1117begin
1118  FUWheres.Add(InsertUnion(Union) + ' not ' + FieldName + ' is Null');
1119end;
1120
1121function SQL.InsertUnion(const Union: TWhereUnion): string;
1122begin
1123  case Union of
1124    wuAnd:
1125      Result := ' AND ';
1126    wuOr:
1127      Result := ' OR ';
1128    wuNotAnd:
1129      Result := ' NOT AND ';
1130    wuNotOr:
1131      Result := ' NOT OR ';
1132  end;
1133  if FUWheres.Count <= 0 then
1134    Result := ''
1135  else if FUWheres[FUWheres.Count - 1][Length(FUWheres[FUWheres.Count - 1])] = '(' then
1136    Result := '';
1137end;
1138
1139procedure SQL.WhereFieldIsNull(const FieldName: string; const Union: TWhereUnion);
1140begin
1141  FUWheres.Add(InsertUnion(Union) + FieldName + ' is Null');
1142end;
1143
1144procedure SQL.WhereFieldLike(const FieldName, Value: string;
1145  const Union: TWhereUnion);
1146begin
1147  FUWheres.Add(InsertUnion(Union) + FieldName + ' like '+QuotedStr(Value));
1148end;
1149
1150procedure SQL.WhereFieldIN(const FieldName: string; const FieldValues: array of TDateTime; const Union: TWhereUnion);
1151var
1152  FieldValue: string;
1153  i: Integer;
1154begin
1155  FieldValue := '';
1156  for i := Low(FieldValues) to High(FieldValues) do
1157  begin
1158    FieldValue := FieldValue + QuotedStr(FloatToSQLStr(FieldValues[i]));
1159    if i <> High(FieldValues) then
1160      FieldValue := FieldValue + ', ';
1161  end;
1162  WhereFieldWOQ(FieldName, ' IN ', '(' + FieldValue + ')', Union);
1163end;
1164
1165procedure SQL.WhereFieldWOQ(const FieldName, Oper, FieldValue: string; const Union: TWhereUnion);
1166begin
1167  FUWheres.Add(InsertUnion(Union) + FieldName + Oper + FieldValue);
1168end;
1169
1170procedure SQL.WhereFieldEqual(const FieldName: string; const FieldValue: TDateTime; const Union: TWhereUnion);
1171begin
1172  WhereField(FieldName, '=', FieldValue, Union);
1173end;
1174
1175procedure SQL.WhereNotFieldEqual(const FieldName: string; const FieldValue: Extended; const Union: TWhereUnion);
1176begin
1177  WhereField(FieldName, '<>', FieldValue, Union);
1178end;
1179
1180procedure SQL.WhereNotFieldEqual(const FieldName: string; const FieldValue: string; const Union: TWhereUnion);
1181begin
1182  WhereField(FieldName, '<>', FieldValue, Union);
1183end;
1184
1185procedure SQL.WhereNotFieldEqual(const FieldName: string; const FieldValue: Integer; const Union: TWhereUnion);
1186begin
1187  WhereField(FieldName, '<>', FieldValue, Union);
1188end;
1189
1190procedure SQL.WhereNotFieldEqual(const FieldName: string; const FieldValue: Boolean; const Union: TWhereUnion);
1191begin
1192  WhereField(FieldName, '<>', FieldValue, Union);
1193end;
1194
1195procedure SQL.WhereParenthesesClose;
1196begin
1197  FUWheres.Add(') ');
1198end;
1199
1200procedure SQL.WhereParenthesesOpen;
1201begin
1202  FUWheres.Add(InsertUnion(Union) + ' (');
1203end;
1204
1205procedure SQL.WhereStr(const Value: string);
1206begin
1207  FWhereStr := Value;
1208end;
1209
1210procedure SQL.WhereNotFieldEqual(const FieldName: string; const FieldValue: TDateTime; const Union: TWhereUnion);
1211begin
1212  WhereField(FieldName, '<>', FieldValue, Union);
1213end;
1214
1215{ TUpdateBlob }
1216
1217function TUpdateBlob.GetSQL: string;
1218begin
1219  Result := 'UPDATE ' + FName + ' SET ' + FBlobField + ' = ? ' + Where;
1220end;
1221
1222end.