zeoslib  UNKNOWN
 All Files
ZUpdateSqlEditor.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { UpdateSql property editor }
5 { }
6 { Originally written by Janos Fegyverneki }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZUpdateSqlEditor;
53 
54 interface
55 
56 {$I ZComponent.inc}
57 
58 uses
59 {$IFNDEF FPC}
60  DesignEditors,
61 {$ELSE}
62  PropEdits, Buttons, ComponentEditors,
63 {$ENDIF}
64  Forms, DB, ExtCtrls, StdCtrls, Controls, ComCtrls,
65  Classes, SysUtils, {$IFNDEF FPC}Windows, {$ELSE}LCLIntf, LResources, {$ENDIF}
66  Menus, ZAbstractDataset,
67 {$IFDEF UNIX}
68  {$IFNDEF FPC}
69  QMenus, QTypes, QExtCtrls, QStdCtrls, QControls, QComCtrls,
70  {$ENDIF}
71 {$ENDIF}
72  ZSqlUpdate;
73 
74 type
75 
76  TWaitMethod = procedure of object;
77 
78  { TZUpdateSQLEditForm }
79 
80  TZUpdateSQLEditForm = class(TForm)
81  Label2: TLabel;
82  Label3: TLabel;
83  Label4: TLabel;
84  GenerateButton: TButton;
85  Panel1: TPanel;
86  PrimaryKeyButton: TButton;
87  DefaultButton: TButton;
88  UpdateTableName: TComboBox;
89  FieldsPage: TTabSheet;
90  SQLPage: TTabSheet;
91  PageControl: TPageControl;
92  KeyFieldList: TListBox;
93  UpdateFieldList: TListBox;
94  GroupBox1: TGroupBox;
95  Label1: TLabel;
96  SQLMemo: TMemo;
97  StatementType: TRadioGroup;
98  QuoteFields: TCheckBox;
99  GetTableFieldsButton: TButton;
100  FieldListPopup: TPopupMenu;
101  miSelectAll: TMenuItem;
102  miClearAll: TMenuItem;
103  OkButton: TButton;
104  CancelButton: TButton;
105  HelpButton: TButton;
106  procedure FormCreate(Sender: TObject);
107  procedure FormResize(Sender: TObject);
108  procedure HelpButtonClick(Sender: TObject);
109  procedure StatementTypeClick(Sender: TObject);
110  procedure OkButtonClick(Sender: TObject);
111  procedure DefaultButtonClick(Sender: TObject);
112  procedure GenerateButtonClick(Sender: TObject);
113  procedure PrimaryKeyButtonClick(Sender: TObject);
114  procedure PageControlChanging(Sender: TObject;
115  var AllowChange: Boolean);
116  procedure FormDestroy(Sender: TObject);
117  procedure GetTableFieldsButtonClick(Sender: TObject);
118  procedure SettingsChanged(Sender: TObject);
119  procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
120  procedure UpdateTableNameChange(Sender: TObject);
121  procedure UpdateTableNameClick(Sender: TObject);
122  procedure SelectAllClick(Sender: TObject);
123  procedure ClearAllClick(Sender: TObject);
124  procedure SQLMemoKeyPress(Sender: TObject; var Key: Char);
125  private
126  StmtIndex: Integer;
127  DataSet: TZAbstractDataset;
128  QuoteChar: string;
129  ConnectionOpened: Boolean;
130  UpdateSQL: TZUpdateSQL;
131  FSettingsChanged: Boolean;
132  FDatasetDefaults: Boolean;
133  SQLText: array[TUpdateKind] of TStrings;
134  function GetTableRef(const TabName: string): string;
135  function Edit: Boolean;
136  procedure GenWhereClause(const TabAlias: string; KeyFields, SQL: TStrings);
137  procedure GenDeleteSQL(const TableName: string; KeyFields, SQL: TStrings);
138  procedure GenInsertSQL(const TableName: string; UpdateFields, SQL: TStrings);
139  procedure GenModifySQL(const TableName: string; KeyFields, UpdateFields,
140  SQL: TStrings);
141  procedure GenerateSQL;
142  procedure GetDataSetFieldNames;
143  procedure GetTableFieldNames;
144  procedure InitGenerateOptions;
145  procedure InitUpdateTableNames;
146  procedure SetButtonStates;
147  procedure SelectPrimaryKeyFields;
148  procedure SetDefaultSelections;
149  procedure ShowWait(WaitMethod: TWaitMethod);
150  end;
151 
152 { TSQLParser }
153 
154  TSQLToken = (stSymbol, stAlias, stNumber, stComma, stEQ, stOther, stLParen,
155  stRParen, stEnd, stSemiColon);
156 
157  TSQLParser = class
158  private
159  FText: string;
160  FSourcePtr: PChar;
161  FTokenPtr: PChar;
162  FTokenString: string;
163  FToken: TSQLToken;
164  FSymbolQuoted: Boolean;
165  FQuoteString: string;
166  function NextToken: TSQLToken;
167  function TokenSymbolIs(const S: string): Boolean;
168  procedure Reset;
169  public
170  constructor Create(const Text, QuoteString: string);
171  procedure GetSelectTableNames(List: TStrings);
172  procedure GetUpdateTableName(var TableName: string);
173  procedure GetUpdateFields(List: TStrings);
174  procedure GetWhereFields(List: TStrings);
175  end;
176 
177  TZUpdateSqlEditor = class(TComponentEditor)
178  public
179  procedure ExecuteVerb(Index: Integer); override;
180  function GetVerb(Index: Integer): string; override;
181  function GetVerbCount: Integer; override;
182  procedure Edit; override;
183  end;
184 
185 function EditUpdateSQL(AZUpdateSQL: TZUpdateSQL): Boolean;
186 
187 resourcestring
188  SSQLDataSetOpen = 'Unable to determine field names for %s';
189  SNoDataSet = 'No dataset association';
190  SSQLGenSelect = 'Must select at least one key field and one update field';
191  SSQLNotGenerated = 'Update SQL statements not generated, exit anyway?';
192 
193 implementation
194 
195 {$IFNDEF FPC}
196 {$R *.dfm}
197 {$ENDIF}
198 
199 uses Dialogs, {$IFNDEF FPC}LibHelp, {$ENDIF}TypInfo, ZCompatibility, ZSqlMetadata,
200  ZDbcIntfs, ZTokenizer, ZGenericSqlAnalyser, ZSelectSchema, ZDbcMetadata;
201 
202 function InternalQuoteIdentifier(const S, QuoteString: string): string;
203 begin
204  Result := S;
205  if Length(QuoteString) > 1 then
206  Result := QuoteString[1] + Result + QuoteString[2]
207  else if Length(QuoteString) = 1 then
208  Result := QuoteString[1] + Result + QuoteString[1];
209 end;
210 
211 { TZUpdateSqlEditor }
212 
213 procedure TZUpdateSqlEditor.ExecuteVerb(Index: Integer);
214 begin
215  if Index = 0 then
216  EditUpdateSQL(TZUpdateSQL(Component));
217 end;
218 
219 {$IFDEF FPC}
220  {$HINTS OFF}
221 {$ENDIF}
222 function TZUpdateSqlEditor.GetVerb(Index: Integer): string;
223 begin
224  Result := 'UpdateSql editor...';
225 end;
226 {$IFDEF FPC}
227  {$HINTS ON}
228 {$ENDIF}
229 
230 
231 function TZUpdateSqlEditor.GetVerbCount: Integer;
232 begin
233  Result := 1;
234 end;
235 
236 procedure TZUpdateSqlEditor.Edit;
237 begin
238  EditUpdateSQL(TZUpdateSQL(Component));
239 end;
240 
241 { Global Interface functions }
242 
243 function EditUpdateSQL(AZUpdateSQL: TZUpdateSQL): Boolean;
244 begin
245  with TZUpdateSQLEditForm.Create(Application) do
246  try
247  UpdateSQL := AZUpdateSQL;
248  Result := Edit;
249  finally
250  Free;
251  end;
252 end;
253 
254 { Utility Routines }
255 
256 procedure GetSelectedItems(ListBox: TListBox; List: TStrings);
257 var
258  I: Integer;
259 begin
260  List.Clear;
261  for I := 0 to ListBox.Items.Count - 1 do
262  if ListBox.Selected[I] then
263  List.AddObject(ListBox.Items[I], ListBox.Items.Objects[I]);
264 end;
265 
266 function SetSelectedItems(ListBox: TListBox; List: TStrings): Integer;
267 var
268  I: Integer;
269 begin
270  Result := 0;
271  ListBox.Items.BeginUpdate;
272  try
273  for I := 0 to ListBox.Items.Count - 1 do
274  if List.IndexOf(ListBox.Items[I]) > -1 then
275  begin
276  ListBox.Selected[I] := True;
277  Inc(Result);
278  end
279  else
280  ListBox.Selected[I] := False;
281  if ListBox.Items.Count > 0 then
282  begin
283  ListBox.ItemIndex := 0;
284  ListBox.TopIndex := 0;
285  end;
286  finally
287  ListBox.Items.EndUpdate;
288  end;
289 end;
290 
291 procedure SelectAll(ListBox: TListBox);
292 var
293  I: Integer;
294 begin
295  ListBox.Items.BeginUpdate;
296  try
297  with ListBox do
298  for I := 0 to Items.Count - 1 do
299  Selected[I] := True;
300  if ListBox.Items.Count > 0 then
301  begin
302  ListBox.ItemIndex := 0;
303  ListBox.TopIndex := 0;
304  end;
305  finally
306  ListBox.Items.EndUpdate;
307  end;
308 end;
309 
310 procedure GetDataKeyNames(Dataset: TDataset; ErrorName: string; List: TStrings);
311 var
312  I: Integer;
313 begin
314  with Dataset do
315  try
316  FieldDefs.Update;
317  List.BeginUpdate;
318  try
319  List.Clear;
320  for I := 0 to FieldDefs.Count - 1 do
321  {$IFNDEF FPC}
322  if not (FieldDefs[I].DataType in [Low(TBlobType)..High(TBlobType)]) then
323  {$ELSE}
324  if not (FieldDefs[I].DataType in [ftBlob..ftTypedBinary]) then
325  {$ENDIF}
326  List.AddObject(FieldDefs[I].Name, Pointer(not FieldDefs[I].Required));
327  finally
328  List.EndUpdate;
329  end;
330  except
331  if ErrorName <> '' then
332  MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
333  end;
334 end;
335 
336 procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
337 var
338  I: Integer;
339 begin
340  with Dataset do
341  try
342  FieldDefs.Update;
343  List.BeginUpdate;
344  try
345  List.Clear;
346  for I := 0 to FieldDefs.Count - 1 do
347  List.AddObject(FieldDefs[I].Name, Pointer(not FieldDefs[I].Required));
348  finally
349  List.EndUpdate;
350  end;
351  except
352  if ErrorName <> '' then
353  MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
354  end;
355 end;
356 
357 procedure ParseUpdateSQL(const SQL, QuoteString: string; var TableName: string;
358  UpdateFields: TStrings; WhereFields: TStrings);
359 begin
360  with TSQLParser.Create(SQL, QuoteString) do
361  try
362  GetUpdateTableName(TableName);
363  if Assigned(UpdateFields) then
364  begin
365  Reset;
366  GetUpdateFields(UpdateFields);
367  end;
368  if Assigned(WhereFields) then
369  begin
370  Reset;
371  GetWhereFields(WhereFields);
372  end;
373  finally
374  Free;
375  end;
376 end;
377 
378 { TSQLParser }
379 
380 constructor TSQLParser.Create(const Text, QuoteString: string);
381 begin
382  FText := Text;
383  FSourcePtr := PChar(Text);
384  FQuoteString := QuoteString;
385  if FQuoteString = '' then
386  FQuoteString := '""';
387  if Length(FQuoteString) = 1 then
388  FQuoteString := FQuoteString + FQuoteString;
389  NextToken;
390 end;
391 
392 function TSQLParser.NextToken: TSQLToken;
393 var
394  P, TokenStart: PChar;
395  IsParam: Boolean;
396 
397  {$IFNDEF FPC}
398  function IsKatakana(const Chr: Byte): Boolean;
399  begin
400  Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
401  end;
402  {$ENDIF}
403 
404 begin
405  if FToken = stEnd then SysUtils.Abort;
406  FTokenString := '';
407  FSymbolQuoted := False;
408  P := FSourcePtr;
409  while (P^ <> #0) and (P^ <= ' ') do Inc(P);
410  FTokenPtr := P;
411  case P^ of
412  'A'..'Z', 'a'..'z', '_', '$', #127..#255:
413  begin
414  TokenStart := P;
415  if not SysLocale.FarEast then
416  begin
417  Inc(P);
418  while CharInSet(P^, ['A'..'Z', 'a'..'z', '0'..'9', '_', '"', '$', #127..#255] ) do Inc(P);
419  if P^ = '.' then Inc(P);//!!! This must be added for syslocale fareast also
420  end
421  else
422  begin
423  while TRUE do
424  begin
425  if CharInSet(P^, ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$']) or
426  {$IFNDEF FPC}IsKatakana(Byte(P^)){$ELSE}False{$ENDIF} then
427  Inc(P)
428  else
429  if CharInSet(P^, LeadBytes) then
430  Inc(P, 2)
431  else
432  Break;
433  end;
434  end;
435  SetString(FTokenString, TokenStart, P - TokenStart);
436  FToken := stSymbol;
437  end;
438  '-', '0'..'9':
439  begin
440  TokenStart := P;
441  Inc(P);
442  while CharInSet(P^, ['0'..'9', '.', 'e', 'E', '+', '-'] )do Inc(P);
443  SetString(FTokenString, TokenStart, P - TokenStart);
444  FToken := stNumber;
445  end;
446  ',':
447  begin
448  Inc(P);
449  FToken := stComma;
450  end;
451  ';':
452  begin
453  Inc(P);
454  FToken := stSemiColon;
455  end;
456  '=':
457  begin
458  Inc(P);
459  FToken := stEQ;
460  end;
461  '(':
462  begin
463  Inc(P);
464  FToken := stLParen;
465  end;
466  ')':
467  begin
468  Inc(P);
469  FToken := stRParen;
470  end;
471  #0:
472  FToken := stEnd;
473  else
474  if P^ = FQuoteString[1] then
475  begin
476  Inc(P);
477  IsParam := P^ = ':';
478  if IsParam then Inc(P);
479  TokenStart := P;
480  while not CharInSet(P^, [FQuoteString[2], #0]) do Inc(P);
481  SetString(FTokenString, TokenStart, P - TokenStart);
482  Inc(P);
483  if P^ = '.' then
484  begin
485  FTokenString := FTokenString + '.';
486  Inc(P);
487  end;
488  Trim(FTokenString);
489  FToken := stSymbol;
490  FSymbolQuoted := True;
491  end
492  else
493  begin
494  FToken := stOther;
495  Inc(P);
496  end;
497  end;
498  FSourcePtr := P;
499  if (FToken = stSymbol) and
500  (FTokenString[Length(FTokenString)] = '.') then FToken := stAlias;
501  Result := FToken;
502 end;
503 
504 procedure TSQLParser.Reset;
505 begin
506  FSourcePtr := PChar(FText);
507  FToken := stSymbol;
508  NextToken;
509 end;
510 
511 function TSQLParser.TokenSymbolIs(const S: string): Boolean;
512 begin
513  Result := (FToken = stSymbol) and (CompareText(FTokenString, S) = 0);
514 end;
515 
516 procedure TSQLParser.GetSelectTableNames(List: TStrings);
517 begin
518  List.BeginUpdate;
519  try
520  List.Clear;
521  if TokenSymbolIs('SELECT') then { Do not localize }
522  try
523  while not TokenSymbolIs('FROM') do NextToken; { Do not localize }
524  NextToken;
525  while FToken = stSymbol do
526  begin
527  List.AddObject(FTokenString, Pointer(Integer(FSymbolQuoted)));
528  if NextToken = stSymbol then NextToken;
529  if FToken = stComma then NextToken
530  else break;
531  end;
532  except
533  end;
534  finally
535  List.EndUpdate;
536  end;
537 end;
538 
539 procedure TSQLParser.GetUpdateTableName(var TableName: string);
540 begin
541  if TokenSymbolIs('UPDATE') and (NextToken = stSymbol) then { Do not localize }
542  TableName := FTokenString else
543  TableName := '';
544 end;
545 
546 procedure TSQLParser.GetUpdateFields(List: TStrings);
547 begin
548  List.BeginUpdate;
549  try
550  List.Clear;
551  if TokenSymbolIs('UPDATE') then { Do not localize }
552  try
553  while not TokenSymbolIs('SET') do NextToken; { Do not localize }
554  NextToken;
555  while True do
556  begin
557  if FToken = stAlias then NextToken;
558  if FToken <> stSymbol then Break;
559  List.Add(FTokenString);
560  if NextToken <> stEQ then Break;
561  while NextToken <> stComma do
562  if TokenSymbolIs('WHERE') or TokenSymbolIs('UPDATE') then Exit;{ Do not localize }
563  NextToken;
564  end;
565  except
566  end;
567  finally
568  List.EndUpdate;
569  end;
570 end;
571 
572 procedure TSQLParser.GetWhereFields(List: TStrings);
573 begin
574  List.BeginUpdate;
575  try
576  List.Clear;
577  if TokenSymbolIs('UPDATE') then { Do not localize }
578  try
579  while not TokenSymbolIs('WHERE') do NextToken; { Do not localize }
580  NextToken;
581  while True do
582  begin
583  while FToken in [stLParen, stRParen, stAlias, stOther] do NextToken;
584  if FToken <> stSymbol then Break;
585  List.Add(FTokenString);
586  NextToken;
587  if (FToken <> stEQ) and not TokenSymbolIs('IS') then Break;
588  while true do
589  begin
590  NextToken;
591  if FToken in [stEnd, stSemiColon] then Exit; //!!!!stSemiColon should be the statement separator
592  if TokenSymbolIs('AND') then Break; { Do not localize }
593  end;
594  NextToken;
595  end;
596  except
597  end;
598  finally
599  List.EndUpdate;
600  end;
601 end;
602 
603 { TUpdateSQLEditor }
604 
605 { Private Methods }
606 
607 function TZUpdateSQLEditForm.Edit: Boolean;
608 var
609  Index: TUpdateKind;
610  DataSetName: string;
611 begin
612  Result := False;
613  ConnectionOpened := False;
614  if Assigned(UpdateSQL.DataSet) and (UpdateSQL.DataSet is TZAbstractDataset) then
615  begin
616  DataSet := TZAbstractDataset(UpdateSQL.DataSet);
617  DataSetName := Format('%s%s%s', [DataSet.Owner.Name, DotSep, DataSet.Name]);
618  if Assigned(DataSet.Connection) and not DataSet.Connection.Connected then
619  begin
620  DataSet.Connection.Connect;
621  ConnectionOpened := True;
622  end;
623  end else
624  DataSetName := SNoDataSet;
625  Caption := Format('%s%s%s (%s)', [UpdateSQL.Owner.Name, DotSep, UpdateSQL.Name, DataSetName]);
626  try
627  for Index := Low(TUpdateKind) to High(TUpdateKind) do
628  begin
629  SQLText[Index] := TStringList.Create;
630  SQLText[Index].Assign(UpdateSQL.SQL[Index]);
631  end;
632  StatementType.ItemIndex := 0;
633  StatementTypeClick(Self);
634  InitUpdateTableNames;
635  ShowWait(InitGenerateOptions);
636  PageControl.ActivePage := PageControl.Pages[0];
637  if ShowModal = mrOk then
638  begin
639  for Index := low(TUpdateKind) to high(TUpdateKind) do
640  UpdateSQL.SQL[Index] := SQLText[Index];
641  Result := True;
642  end;
643  finally
644  for Index := Low(TUpdateKind) to High(TUpdateKind) do
645  SQLText[Index].Free;
646  end;
647 end;
648 
649 procedure TZUpdateSQLEditForm.GenWhereClause(const TabAlias: string;
650  KeyFields, SQL: TStrings);
651 var
652  I: Integer;
653  BindText: string;
654  FieldName: string;
655  OldFieldName: string;
656 begin
657  SQL.Add('WHERE'); { Do not localize }
658  for I := 0 to KeyFields.Count - 1 do
659  begin
660  FieldName := KeyFields[I];
661  OldFieldName := 'OLD_' + FieldName;
662  if QuoteFields.Checked then
663  FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
664  if not Assigned(KeyFields.Objects[I]) then
665  BindText := Format(' %s%s = :%s', { Do not localize }
666  [TabAlias, FieldName, OldFieldName])
667  else
668  BindText := Format(' ((%0:s%1:s IS NULL AND :%2:s IS NULL) OR (%0:s%1:s = :%2:s))', { Do not localize }
669  [TabAlias, FieldName, OldFieldName]);
670  if I < KeyFields.Count - 1 then
671  BindText := Format('%s AND',[BindText]); { Do not localize }
672  SQL.Add(BindText);
673  end;
674 end;
675 
676 procedure TZUpdateSQLEditForm.GenDeleteSQL(const TableName: string;
677  KeyFields, SQL: TStrings);
678 begin
679  SQL.Add(Format('DELETE FROM %s', [TableName])); { Do not localize }
680  GenWhereClause(GetTableRef(TableName), KeyFields, SQL);
681 end;
682 
683 procedure TZUpdateSQLEditForm.GenInsertSQL(const TableName: string;
684  UpdateFields, SQL: TStrings);
685 
686  procedure GenFieldList(const TabName, ParamChar: String);
687  var
688  L: string;
689  I: integer;
690  Comma: string;
691  FieldName: string;
692  begin
693  L := ' (';
694  Comma := ', ';
695  for I := 0 to UpdateFields.Count - 1 do
696  begin
697  if I = UpdateFields.Count - 1 then Comma := '';
698  FieldName := UpdateFields[I];
699  if QuoteFields.Checked and (ParamChar = '') then
700  FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
701  L := Format('%s%s%s%s',[L, ParamChar, FieldName, Comma]);
702  if (Length(L) > 70) and (I <> UpdateFields.Count - 1) then
703  begin
704  SQL.Add(L);
705  L := ' ';
706  end;
707  end;
708  SQL.Add(L+')');
709  end;
710 
711 begin
712  SQL.Add(Format('INSERT INTO %s', [TableName])); { Do not localize }
713  GenFieldList(GetTableRef(TableName), '');
714  SQL.Add('VALUES'); { Do not localize }
715  GenFieldList('', ':');
716 end;
717 
718 procedure TZUpdateSQLEditForm.GenModifySQL(const TableName: string;
719  KeyFields, UpdateFields, SQL: TStrings);
720 var
721  I: integer;
722  Comma: string;
723  TableRef: string;
724  FieldName: string;
725 begin
726  SQL.Add(Format('UPDATE %s SET', [TableName])); { Do not localize }
727  Comma := ',';
728  TableRef := GetTableRef(TableName);
729  for I := 0 to UpdateFields.Count - 1 do
730  begin
731  if I = UpdateFields.Count -1 then Comma := '';
732  FieldName := UpdateFields[I];
733  if QuoteFields.Checked then
734  FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
735  SQL.Add(Format(' %s = :%s%s',
736  [FieldName, UpdateFields[I], Comma]));
737  end;
738  GenWhereClause(TableRef, KeyFields, SQL);
739 end;
740 
741 procedure TZUpdateSQLEditForm.GenerateSQL;
742 
743  function QuotedTableName(const BaseName: string): string;
744  begin
745  if QuoteFields.Checked then
746  Result := InternalQuoteIdentifier(BaseName, QuoteChar)
747  else
748  Result := BaseName;
749  end;
750 
751 var
752  KeyFields: TStringList;
753  UpdateFields: TStringList;
754  TableName: string;
755 begin
756  if (KeyFieldList.SelCount = 0) or (UpdateFieldList.SelCount = 0) then
757  raise Exception.Create(SSQLGenSelect);
758  KeyFields := TStringList.Create;
759  try
760  GetSelectedItems(KeyFieldList, KeyFields);
761  UpdateFields := TStringList.Create;
762  try
763  GetSelectedItems(UpdateFieldList, UpdateFields);
764  TableName := QuotedTableName(UpdateTableName.Text);
765  if (SQLText[ukDelete].Text <> '') or (SQLText[ukInsert].Text <> '') or (SQLText[ukModify].Text <> '') then
766  if MessageDlg('The SQL property is not empty. Do you want to clear it before the generation?', mtWarning, [mbYes, mbNo], 0) = mrYes then
767  begin
768  SQLText[ukDelete].Clear;
769  SQLText[ukInsert].Clear;
770  SQLText[ukModify].Clear;
771  end
772  else
773  begin
774  SQLText[ukDelete].Text := SQLText[ukDelete].Text + '';//!!!Statement separator should be added
775  SQLText[ukDelete].Add('');
776  SQLText[ukInsert].Text := SQLText[ukInsert].Text + '';//!!!Statement separator should be added
777  SQLText[ukInsert].Add('');
778  SQLText[ukModify].Text := SQLText[ukModify].Text + '';//!!!Statement separator should be added
779  SQLText[ukModify].Add('');
780  end;
781  GenDeleteSQL(TableName, KeyFields, SQLText[ukDelete]);
782  GenInsertSQL(TableName, UpdateFields, SQLText[ukInsert]);
783  GenModifySQL(TableName, KeyFields, UpdateFields,
784  SQLText[ukModify]);
785  SQLMemo.Modified := False;
786  StatementTypeClick(Self);
787  PageControl.SelectNextPage(True);
788  finally
789  UpdateFields.Free;
790  end;
791  finally
792  KeyFields.Free;
793  end;
794 end;
795 
796 procedure TZUpdateSQLEditForm.GetDataSetFieldNames;
797 begin
798  if Assigned(DataSet) and Assigned(Dataset.Connection) then
799  begin
800  GetDataKeyNames(DataSet, DataSet.Name, KeyFieldList.Items);
801  GetDataFieldNames(DataSet, DataSet.Name, UpdateFieldList.Items);
802  end;
803 end;
804 
805 procedure TZUpdateSQLEditForm.GetTableFieldNames;
806 var
807  ResultSet: IZResultSet;
808 begin
809  if Assigned(DataSet) and Assigned(DataSet.Connection) and Assigned(DataSet.Connection.dbcConnection)then
810  begin
811  KeyFieldList.Clear;
812  UpdateFieldList.Clear;
813  ResultSet := DataSet.Connection.DbcConnection.GetMetadata.GetColumns('', '', UpdateTableName.Text, '');
814  if Assigned(ResultSet) then
815  begin
816  while ResultSet.Next do
817  begin
818  if ResultSet.GetBooleanByName('SEARCHABLE') then
819  KeyFieldList.Items.AddObject(ResultSet.GetStringByName('COLUMN_NAME'), Pointer(ResultSet.GetIntByName('NULLABLE') <> 0));
820  if ResultSet.GetBooleanByName('WRITABLE') then
821  UpdateFieldList.Items.Add(ResultSet.GetStringByName('COLUMN_NAME')) ;
822  end;
823  end;
824  FDatasetDefaults := False;
825  end;
826 end;
827 
828 function TZUpdateSQLEditForm.GetTableRef(const TabName: string): string;
829 begin
830  if QuoteChar <> '' then
831  Result := TabName + '.' else
832  REsult := '';
833 end;
834 
835 procedure TZUpdateSQLEditForm.InitGenerateOptions;
836 var
837  UpdTabName: string;
838 
839  procedure InitFromDataSet;
840  begin
841  // If this is a Query with more than 1 table in the "from" clause then
842  // initialize the list of fields from the table rather than the dataset.
843  if (UpdateTableName.Items.Count > 1) then
844  GetTableFieldNames
845  else
846  begin
847  GetDataSetFieldNames;
848  FDatasetDefaults := True;
849  end;
850  SetDefaultSelections;
851  end;
852 
853  procedure InitFromUpdateSQL;
854  var
855  UpdFields,
856  WhFields: TStrings;
857  begin
858  UpdFields := TStringList.Create;
859  try
860  WhFields := TStringList.Create;
861  try
862  ParseUpdateSQL(SQLText[ukModify].Text, QuoteChar, UpdTabName, UpdFields, WhFields);
863  GetDataSetFieldNames;
864  if SetSelectedItems(UpdateFieldList, UpdFields) < 1 then
865  SelectAll(UpdateFieldList);
866  if SetSelectedItems(KeyFieldList, WhFields) < 1 then
867  SelectAll(KeyFieldList);
868  finally
869  WhFields.Free;
870  end;
871  finally
872  UpdFields.Free;
873  end;
874  end;
875 
876 begin
877  // If there are existing update SQL statements, try to initialize the
878  // dialog with the fields that correspond to them.
879  if SQLText[ukModify].Count > 0 then
880  begin
881  ParseUpdateSQL(SQLText[ukModify].Text, QuoteChar, UpdTabName, nil, nil);
882  // If the table name from the update statement is not part of the
883  // dataset, then initialize from the dataset instead.
884  if (UpdateTableName.Items.Count > 0) and
885  (UpdateTableName.Items.IndexOf(UpdTabName) > -1) then
886  begin
887  UpdateTableName.Text := UpdTabName;
888  InitFromUpdateSQL;
889  end else
890  begin
891  InitFromDataSet;
892  UpdateTableName.Items.Add(UpdTabName);
893  end;
894  end else
895  InitFromDataSet;
896  SetButtonStates;
897 end;
898 
899 type
900  THackDataSet = class(TZAbstractDataset);
901 
902 procedure TZUpdateSQLEditForm.InitUpdateTableNames;
903 var
904  I: Integer;
905  TableName: string;
906  Tokenizer: IZTokenizer;
907  StatementAnalyser: IZStatementAnalyser;
908  SelectSchema: IZSelectSchema;
909 begin
910  QuoteChar := '""';
911  if Assigned(DataSet) and Assigned(DataSet.Connection)
912  and Assigned(DataSet.Connection.DbcConnection)then
913  begin
914  QuoteChar := DataSet.Connection.DbcConnection.GetMetadata.GetDatabaseInfo.
915  GetIdentifierQuoteString;
916  if Length(QuoteChar) = 1 then
917  QuoteChar := QuoteChar + QuoteChar;
918  { Parses the Select statement and retrieves a schema object. }
919  Tokenizer := DataSet.Connection.DbcDriver.GetTokenizer;
920  StatementAnalyser := DataSet.Connection.DbcDriver.GetStatementAnalyser;
921  SelectSchema := StatementAnalyser.DefineSelectSchemaFromQuery(Tokenizer,
922  THackDataSet(DataSet).SQL.Text);
923  if Assigned(SelectSchema) then
924  begin
925  UpdateTableName.Clear;
926  for I := 0 to SelectSchema.TableCount - 1 do
927  UpdateTableName.Items.Add(SelectSchema.Tables[I].Table);//!!!Schema support
928  end;
929  end
930  else
931  if Assigned(Dataset) then
932  begin
933  TableName := '';
934  if SQLText[ukModify].Count > 0 then
935  ParseUpdateSql(SQLText[ukModify].Text, QuoteChar, TableName, nil, nil);
936  if TableName <> '' then
937  UpdateTableName.Items.Add(TableName);
938  end;
939  if UpdateTableName.Items.Count > 0 then
940  UpdateTableName.ItemIndex := 0;
941 end;
942 
943 procedure TZUpdateSQLEditForm.SetButtonStates;
944 begin
945  GetTableFieldsButton.Enabled := UpdateTableName.Text <> '';
946  PrimaryKeyButton.Enabled := GetTableFieldsButton.Enabled and
947  (KeyFieldList.Items.Count > 0);
948  GenerateButton.Enabled := GetTableFieldsButton.Enabled and
949  (UpdateFieldList.Items.Count > 0) and (KeyFieldList.Items.Count > 0);
950  DefaultButton.Enabled := Assigned(DataSet) and not FDatasetDefaults;
951 end;
952 
953 procedure TZUpdateSQLEditForm.SelectPrimaryKeyFields;
954 var
955  I: Integer;
956  Index: Integer;
957  PKeys: TZSQLMetadata;
958 begin
959  if KeyFieldList.Items.Count < 1 then Exit;
960  with Dataset do
961  begin
962  for I := 0 to KeyFieldList.Items.Count - 1 do
963  KeyFieldList.Selected[I] := False;
964  PKeys := TZSQLMetadata.Create(nil);
965  try
966  PKeys.Connection := Connection;
967  PKeys.TableName := UpdateTableName.Text;
968  PKeys.MetadataType := mdPrimaryKeys;
969  PKeys.Open;
970  PKeys.First;
971  while not PKeys.Eof do
972  begin
973  Index := KeyFieldList.Items.IndexOf(PKeys.FieldByName('COLUMN_NAME').AsString);
974  if Index > -1 then KeyFieldList.Selected[Index] := True;
975  PKeys.Next;
976  end;
977  finally
978  PKeys.Free;
979  end;
980  end;
981 end;
982 
983 procedure TZUpdateSQLEditForm.SetDefaultSelections;
984 var
985  DSFields: TStringList;
986 begin
987  if FDatasetDefaults or not Assigned(DataSet) then
988  begin
989  SelectAll(UpdateFieldList);
990  SelectAll(KeyFieldList);
991  end
992  else if (DataSet.FieldDefs.Count > 0) then
993  begin
994  DSFields := TStringList.Create;
995  try
996  GetDataFieldNames(DataSet, '', DSFields);
997  SetSelectedItems(KeyFieldList, DSFields);
998  SetSelectedItems(UpdateFieldList, DSFields);
999  finally
1000  DSFields.Free;
1001  end;
1002  end;
1003 end;
1004 
1005 procedure TZUpdateSQLEditForm.ShowWait(WaitMethod: TWaitMethod);
1006 begin
1007  Screen.Cursor := crHourGlass;
1008  try
1009  WaitMethod;
1010  finally
1011  Screen.Cursor := crDefault;
1012  end;
1013 end;
1014 
1015 { Event Handlers }
1016 
1017 procedure TZUpdateSQLEditForm.FormCreate(Sender: TObject);
1018 begin
1019 // HelpContext := hcDUpdateSQL;
1020 end;
1021 
1022 procedure TZUpdateSQLEditForm.FormResize(Sender: TObject);
1023 Var i: Integer;
1024 begin
1025  i := PageControl.Height - 92;
1026  If i < 0 Then i := 0;
1027  SQLMemo.Height := i;
1028 end;
1029 
1030 procedure TZUpdateSQLEditForm.HelpButtonClick(Sender: TObject);
1031 begin
1032  Application.HelpContext(HelpContext);
1033 end;
1034 
1035 procedure TZUpdateSQLEditForm.StatementTypeClick(Sender: TObject);
1036 begin
1037  if SQLMemo.Modified then
1038  SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
1039  StmtIndex := StatementType.ItemIndex;
1040  SQLMemo.Lines.Assign(SQLText[TUpdateKind(StmtIndex)]);
1041 end;
1042 
1043 procedure TZUpdateSQLEditForm.OkButtonClick(Sender: TObject);
1044 begin
1045  if SQLMemo.Modified then
1046  SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
1047 end;
1048 
1049 procedure TZUpdateSQLEditForm.DefaultButtonClick(Sender: TObject);
1050 begin
1051  with UpdateTableName do
1052  if Items.Count > 0 then ItemIndex := 0;
1053  ShowWait(GetDataSetFieldNames);
1054  FDatasetDefaults := True;
1055  SetDefaultSelections;
1056  KeyfieldList.SetFocus;
1057  SetButtonStates;
1058 end;
1059 
1060 procedure TZUpdateSQLEditForm.GenerateButtonClick(Sender: TObject);
1061 begin
1062  GenerateSQL;
1063  FSettingsChanged := False;
1064 end;
1065 
1066 procedure TZUpdateSQLEditForm.PrimaryKeyButtonClick(Sender: TObject);
1067 begin
1068  ShowWait(SelectPrimaryKeyFields);
1069  SettingsChanged(Sender);
1070 end;
1071 
1072 procedure TZUpdateSQLEditForm.PageControlChanging(Sender: TObject;
1073  var AllowChange: Boolean);
1074 begin
1075  if (PageControl.ActivePage = PageControl.Pages[0]) and
1076  not SQLPage.Enabled then
1077  AllowChange := False;
1078 end;
1079 
1080 procedure TZUpdateSQLEditForm.FormDestroy(Sender: TObject);
1081 begin
1082  if ConnectionOpened then
1083  DataSet.Connection.Disconnect;
1084 end;
1085 
1086 procedure TZUpdateSQLEditForm.GetTableFieldsButtonClick(Sender: TObject);
1087 begin
1088  ShowWait(GetTableFieldNames);
1089  SetDefaultSelections;
1090  SettingsChanged(Sender);
1091 end;
1092 
1093 procedure TZUpdateSQLEditForm.SettingsChanged(Sender: TObject);
1094 begin
1095  FSettingsChanged := True;
1096  FDatasetDefaults := False;
1097  SetButtonStates;
1098 end;
1099 
1100 procedure TZUpdateSQLEditForm.FormCloseQuery(Sender: TObject;
1101  var CanClose: Boolean);
1102 begin
1103  if (ModalResult = mrOK) and FSettingsChanged then
1104  CanClose := MessageDlg(SSQLNotGenerated, mtConfirmation,
1105  mbYesNoCancel, 0) = mrYes;
1106 end;
1107 
1108 procedure TZUpdateSQLEditForm.UpdateTableNameChange(Sender: TObject);
1109 begin
1110  SettingsChanged(Sender);
1111 end;
1112 
1113 procedure TZUpdateSQLEditForm.UpdateTableNameClick(Sender: TObject);
1114 begin
1115  if not Visible then Exit;
1116  GetTableFieldsButtonClick(Sender);
1117 end;
1118 
1119 procedure TZUpdateSQLEditForm.SelectAllClick(Sender: TObject);
1120 begin
1121  SelectAll(FieldListPopup.PopupComponent as TListBox);
1122 end;
1123 
1124 procedure TZUpdateSQLEditForm.ClearAllClick(Sender: TObject);
1125 var
1126  I: Integer;
1127 begin
1128  with FieldListPopup.PopupComponent as TListBox do
1129  begin
1130  Items.BeginUpdate;
1131  try
1132  for I := 0 to Items.Count - 1 do
1133  Selected[I] := False;
1134  finally
1135  Items.EndUpdate;
1136  end;
1137  end;
1138 end;
1139 
1140 procedure TZUpdateSQLEditForm.SQLMemoKeyPress(Sender: TObject;
1141  var Key: Char);
1142 begin
1143  if Key = #27 then Close;
1144 end;
1145 
1146 {$IFDEF FPC}
1147 initialization
1148 {$i ZUpdateSqlEditor.lrs}
1149 {$ENDIF}
1150 
1151 end.