00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { UpdateSql property editor }
00005 { }
00006 { Originally written by Janos Fegyverneki }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZUpdateSqlEditor;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 DesignEditors,
00063 {$ELSE}
00064 {$IFDEF FPC}
00065 PropEdits, Buttons, ComponentEditors,
00066 {$ELSE}
00067 DsgnIntf,
00068 {$ENDIF}
00069 {$ENDIF}
00070 Forms, DB, ExtCtrls, StdCtrls, Controls, ComCtrls,
00071 Classes, SysUtils, {$IFNDEF FPC}Windows, {$ELSE}LCLIntf, LResources, {$ENDIF}
00072 Menus, ZConnection, ZAbstractDataset,
00073 {$IFDEF UNIX}
00074 {$IFNDEF FPC}
00075 QMenus, QTypes, QExtCtrls, QStdCtrls, QControls, QComCtrls,
00076 {$ENDIF}
00077 {$ENDIF}
00078 ZSqlUpdate;
00079
00080 type
00081
00082 TWaitMethod = procedure of object;
00083
00084 { TZUpdateSQLEditForm }
00085
00086 TZUpdateSQLEditForm = class(TForm)
00087 Label2: TLabel;
00088 Label3: TLabel;
00089 Label4: TLabel;
00090 OkButton: TButton;
00091 CancelButton: TButton;
00092 HelpButton: TButton;
00093 GenerateButton: TButton;
00094 PrimaryKeyButton: TButton;
00095 DefaultButton: TButton;
00096 UpdateTableName: TComboBox;
00097 FieldsPage: TTabSheet;
00098 SQLPage: TTabSheet;
00099 PageControl: TPageControl;
00100 KeyFieldList: TListBox;
00101 UpdateFieldList: TListBox;
00102 GroupBox1: TGroupBox;
00103 Label1: TLabel;
00104 SQLMemo: TMemo;
00105 StatementType: TRadioGroup;
00106 QuoteFields: TCheckBox;
00107 GetTableFieldsButton: TButton;
00108 FieldListPopup: TPopupMenu;
00109 miSelectAll: TMenuItem;
00110 miClearAll: TMenuItem;
00111 procedure FormCreate(Sender: TObject);
00112 procedure HelpButtonClick(Sender: TObject);
00113 procedure StatementTypeClick(Sender: TObject);
00114 procedure OkButtonClick(Sender: TObject);
00115 procedure DefaultButtonClick(Sender: TObject);
00116 procedure GenerateButtonClick(Sender: TObject);
00117 procedure PrimaryKeyButtonClick(Sender: TObject);
00118 procedure PageControlChanging(Sender: TObject;
00119 var AllowChange: Boolean);
00120 procedure FormDestroy(Sender: TObject);
00121 procedure GetTableFieldsButtonClick(Sender: TObject);
00122 procedure SettingsChanged(Sender: TObject);
00123 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
00124 procedure UpdateTableNameChange(Sender: TObject);
00125 procedure UpdateTableNameClick(Sender: TObject);
00126 procedure SelectAllClick(Sender: TObject);
00127 procedure ClearAllClick(Sender: TObject);
00128 procedure SQLMemoKeyPress(Sender: TObject; var Key: Char);
00129 private
00130 StmtIndex: Integer;
00131 DataSet: TZAbstractDataset;
00132 QuoteChar: string;
00133 ConnectionOpened: Boolean;
00134 UpdateSQL: TZUpdateSQL;
00135 FSettingsChanged: Boolean;
00136 FDatasetDefaults: Boolean;
00137 SQLText: array[TUpdateKind] of TStrings;
00138 function GetTableRef(const TabName: string): string;
00139 function Edit: Boolean;
00140 procedure GenWhereClause(const TabAlias: string; KeyFields, SQL: TStrings);
00141 procedure GenDeleteSQL(const TableName: string; KeyFields, SQL: TStrings);
00142 procedure GenInsertSQL(const TableName: string; UpdateFields, SQL: TStrings);
00143 procedure GenModifySQL(const TableName: string; KeyFields, UpdateFields,
00144 SQL: TStrings);
00145 procedure GenerateSQL;
00146 procedure GetDataSetFieldNames;
00147 procedure GetTableFieldNames;
00148 procedure InitGenerateOptions;
00149 procedure InitUpdateTableNames;
00150 procedure SetButtonStates;
00151 procedure SelectPrimaryKeyFields;
00152 procedure SetDefaultSelections;
00153 procedure ShowWait(WaitMethod: TWaitMethod);
00154 end;
00155
00156 { TSQLParser }
00157
00158 TSQLToken = (stSymbol, stAlias, stNumber, stComma, stEQ, stOther, stLParen,
00159 stRParen, stEnd, stSemiColon);
00160
00161 TSQLParser = class
00162 private
00163 FText: string;
00164 FSourcePtr: PChar;
00165 FTokenPtr: PChar;
00166 FTokenString: string;
00167 FToken: TSQLToken;
00168 FSymbolQuoted: Boolean;
00169 FQuoteString: string;
00170 function NextToken: TSQLToken;
00171 function TokenSymbolIs(const S: string): Boolean;
00172 procedure Reset;
00173 public
00174 constructor Create(const Text, QuoteString: string);
00175 procedure GetSelectTableNames(List: TStrings);
00176 procedure GetUpdateTableName(var TableName: string);
00177 procedure GetUpdateFields(List: TStrings);
00178 procedure GetWhereFields(List: TStrings);
00179 end;
00180
00181 TZUpdateSqlEditor = class(TComponentEditor)
00182 public
00183 procedure ExecuteVerb(Index: Integer); override;
00184 function GetVerb(Index: Integer): string; override;
00185 function GetVerbCount: Integer; override;
00186 procedure Edit; override;
00187 end;
00188
00189 function EditUpdateSQL(AZUpdateSQL: TZUpdateSQL): Boolean;
00190
00191 resourcestring
00192 SSQLDataSetOpen = 'Unable to determine field names for %s';
00193 SNoDataSet = 'No dataset association';
00194 SSQLGenSelect = 'Must select at least one key field and one update field';
00195 SSQLNotGenerated = 'Update SQL statements not generated, exit anyway?';
00196
00197 implementation
00198
00199 {$IFNDEF FPC}
00200 {$R *.dfm}
00201 {$ENDIF}
00202
00203 uses Dialogs, {$IFNDEF FPC}LibHelp, {$ENDIF}TypInfo, ZSqlMetadata,
00204 ZDbcIntfs, ZTokenizer, ZGenericSqlAnalyser, ZSelectSchema, ZDbcMetadata;
00205
00206 function InternalQuoteIdentifier(const S, QuoteString: string): string;
00207 begin
00208 Result := S;
00209 if Length(QuoteString) > 1 then
00210 Result := QuoteString[1] + Result + QuoteString[2]
00211 else if Length(QuoteString) = 1 then
00212 Result := QuoteString[1] + Result + QuoteString[1];
00213 end;
00214
00215 { TZUpdateSqlEditor }
00216
00217 procedure TZUpdateSqlEditor.ExecuteVerb(Index: Integer);
00218 begin
00219 if Index = 0 then
00220 EditUpdateSQL(TZUpdateSQL(Component));
00221 end;
00222
00223 function TZUpdateSqlEditor.GetVerb(Index: Integer): string;
00224 begin
00225 Result := 'UpdateSql editor...';
00226 end;
00227
00228 function TZUpdateSqlEditor.GetVerbCount: Integer;
00229 begin
00230 Result := 1;
00231 end;
00232
00233 procedure TZUpdateSqlEditor.Edit;
00234 begin
00235 EditUpdateSQL(TZUpdateSQL(Component));
00236 end;
00237
00238 { Global Interface functions }
00239
00240 function EditUpdateSQL(AZUpdateSQL: TZUpdateSQL): Boolean;
00241 begin
00242 with TZUpdateSQLEditForm.Create(Application) do
00243 try
00244 UpdateSQL := AZUpdateSQL;
00245 Result := Edit;
00246 finally
00247 Free;
00248 end;
00249 end;
00250
00251 { Utility Routines }
00252
00253 procedure GetSelectedItems(ListBox: TListBox; List: TStrings);
00254 var
00255 I: Integer;
00256 begin
00257 List.Clear;
00258 for I := 0 to ListBox.Items.Count - 1 do
00259 if ListBox.Selected[I] then
00260 List.AddObject(ListBox.Items[I], ListBox.Items.Objects[I]);
00261 end;
00262
00263 function SetSelectedItems(ListBox: TListBox; List: TStrings): Integer;
00264 var
00265 I: Integer;
00266 begin
00267 Result := 0;
00268 ListBox.Items.BeginUpdate;
00269 try
00270 for I := 0 to ListBox.Items.Count - 1 do
00271 if List.IndexOf(ListBox.Items[I]) > -1 then
00272 begin
00273 ListBox.Selected[I] := True;
00274 Inc(Result);
00275 end
00276 else
00277 ListBox.Selected[I] := False;
00278 if ListBox.Items.Count > 0 then
00279 begin
00280 ListBox.ItemIndex := 0;
00281 ListBox.TopIndex := 0;
00282 end;
00283 finally
00284 ListBox.Items.EndUpdate;
00285 end;
00286 end;
00287
00288 procedure SelectAll(ListBox: TListBox);
00289 var
00290 I: Integer;
00291 begin
00292 ListBox.Items.BeginUpdate;
00293 try
00294 with ListBox do
00295 for I := 0 to Items.Count - 1 do
00296 Selected[I] := True;
00297 if ListBox.Items.Count > 0 then
00298 begin
00299 ListBox.ItemIndex := 0;
00300 ListBox.TopIndex := 0;
00301 end;
00302 finally
00303 ListBox.Items.EndUpdate;
00304 end;
00305 end;
00306
00307 procedure GetDataKeyNames(Dataset: TDataset; ErrorName: string; List: TStrings);
00308 var
00309 I: Integer;
00310 begin
00311 with Dataset do
00312 try
00313 FieldDefs.Update;
00314 List.BeginUpdate;
00315 try
00316 List.Clear;
00317 for I := 0 to FieldDefs.Count - 1 do
00318 {$IFNDEF FPC}
00319 if not (FieldDefs[I].DataType in [Low(TBlobType)..High(TBlobType)]) then
00320 {$ELSE}
00321 if not (FieldDefs[I].DataType in [ftBlob..ftTypedBinary]) then
00322 {$ENDIF}
00323 List.AddObject(FieldDefs[I].Name, Pointer(not FieldDefs[I].Required));
00324 finally
00325 List.EndUpdate;
00326 end;
00327 except
00328 if ErrorName <> '' then
00329 MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
00330 end;
00331 end;
00332
00333 procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
00334 var
00335 I: Integer;
00336 begin
00337 with Dataset do
00338 try
00339 FieldDefs.Update;
00340 List.BeginUpdate;
00341 try
00342 List.Clear;
00343 for I := 0 to FieldDefs.Count - 1 do
00344 List.AddObject(FieldDefs[I].Name, Pointer(not FieldDefs[I].Required));
00345 finally
00346 List.EndUpdate;
00347 end;
00348 except
00349 if ErrorName <> '' then
00350 MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
00351 end;
00352 end;
00353
00354 procedure ParseUpdateSQL(const SQL, QuoteString: string; var TableName: string;
00355 UpdateFields: TStrings; WhereFields: TStrings);
00356 begin
00357 with TSQLParser.Create(SQL, QuoteString) do
00358 try
00359 GetUpdateTableName(TableName);
00360 if Assigned(UpdateFields) then
00361 begin
00362 Reset;
00363 GetUpdateFields(UpdateFields);
00364 end;
00365 if Assigned(WhereFields) then
00366 begin
00367 Reset;
00368 GetWhereFields(WhereFields);
00369 end;
00370 finally
00371 Free;
00372 end;
00373 end;
00374
00375 { TSQLParser }
00376
00377 constructor TSQLParser.Create(const Text, QuoteString: string);
00378 begin
00379 FText := Text;
00380 FSourcePtr := PChar(Text);
00381 FQuoteString := QuoteString;
00382 if FQuoteString = '' then
00383 FQuoteString := '""';
00384 if Length(FQuoteString) = 1 then
00385 FQuoteString := FQuoteString + FQuoteString;
00386 NextToken;
00387 end;
00388
00389 function TSQLParser.NextToken: TSQLToken;
00390 var
00391 P, TokenStart: PChar;
00392 IsParam: Boolean;
00393
00394 function IsKatakana(const Chr: Byte): Boolean;
00395 begin
00396 {$IFNDEF FPC}
00397 Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
00398 {$ELSE}
00399 Result := False;
00400 {$ENDIF}
00401 end;
00402
00403 begin
00404 if FToken = stEnd then SysUtils.Abort;
00405 FTokenString := '';
00406 FSymbolQuoted := False;
00407 P := FSourcePtr;
00408 while (P^ <> #0) and (P^ <= ' ') do Inc(P);
00409 FTokenPtr := P;
00410 case P^ of
00411 'A'..'Z', 'a'..'z', '_', '$', #127..#255:
00412 begin
00413 TokenStart := P;
00414 if not SysLocale.FarEast then
00415 begin
00416 Inc(P);
00417 while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '"', '$', #127..#255] do Inc(P);
00418 if P^ = '.' then Inc(P);
00419 end
00420 else
00421 begin
00422 while TRUE do
00423 begin
00424 if (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$']) or
00425 IsKatakana(Byte(P^)) then
00426 Inc(P)
00427 else
00428 if P^ in LeadBytes then
00429 Inc(P, 2)
00430 else
00431 Break;
00432 end;
00433 end;
00434 SetString(FTokenString, TokenStart, P - TokenStart);
00435 FToken := stSymbol;
00436 end;
00437 '-', '0'..'9':
00438 begin
00439 TokenStart := P;
00440 Inc(P);
00441 while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do Inc(P);
00442 SetString(FTokenString, TokenStart, P - TokenStart);
00443 FToken := stNumber;
00444 end;
00445 ',':
00446 begin
00447 Inc(P);
00448 FToken := stComma;
00449 end;
00450 ';':
00451 begin
00452 Inc(P);
00453 FToken := stSemiColon;
00454 end;
00455 '=':
00456 begin
00457 Inc(P);
00458 FToken := stEQ;
00459 end;
00460 '(':
00461 begin
00462 Inc(P);
00463 FToken := stLParen;
00464 end;
00465 ')':
00466 begin
00467 Inc(P);
00468 FToken := stRParen;
00469 end;
00470 #0:
00471 FToken := stEnd;
00472 else
00473 if P^ = FQuoteString[1] then
00474 begin
00475 Inc(P);
00476 IsParam := P^ = ':';
00477 if IsParam then Inc(P);
00478 TokenStart := P;
00479 while not (P^ in [FQuoteString[2], #0]) do Inc(P);
00480 SetString(FTokenString, TokenStart, P - TokenStart);
00481 Inc(P);
00482 if P^ = '.' then
00483 begin
00484 FTokenString := FTokenString + '.';
00485 Inc(P);
00486 end;
00487 Trim(FTokenString);
00488 FToken := stSymbol;
00489 FSymbolQuoted := True;
00490 end
00491 else
00492 begin
00493 FToken := stOther;
00494 Inc(P);
00495 end;
00496 end;
00497 FSourcePtr := P;
00498 if (FToken = stSymbol) and
00499 (FTokenString[Length(FTokenString)] = '.') then FToken := stAlias;
00500 Result := FToken;
00501 end;
00502
00503 procedure TSQLParser.Reset;
00504 begin
00505 FSourcePtr := PChar(FText);
00506 FToken := stSymbol;
00507 NextToken;
00508 end;
00509
00510 function TSQLParser.TokenSymbolIs(const S: string): Boolean;
00511 begin
00512 Result := (FToken = stSymbol) and (CompareText(FTokenString, S) = 0);
00513 end;
00514
00515 procedure TSQLParser.GetSelectTableNames(List: TStrings);
00516 begin
00517 List.BeginUpdate;
00518 try
00519 List.Clear;
00520 if TokenSymbolIs('SELECT') then { Do not localize }
00521 try
00522 while not TokenSymbolIs('FROM') do NextToken; { Do not localize }
00523 NextToken;
00524 while FToken = stSymbol do
00525 begin
00526 List.AddObject(FTokenString, Pointer(Integer(FSymbolQuoted)));
00527 if NextToken = stSymbol then NextToken;
00528 if FToken = stComma then NextToken
00529 else break;
00530 end;
00531 except
00532 end;
00533 finally
00534 List.EndUpdate;
00535 end;
00536 end;
00537
00538 procedure TSQLParser.GetUpdateTableName(var TableName: string);
00539 begin
00540 if TokenSymbolIs('UPDATE') and (NextToken = stSymbol) then { Do not localize }
00541 TableName := FTokenString else
00542 TableName := '';
00543 end;
00544
00545 procedure TSQLParser.GetUpdateFields(List: TStrings);
00546 begin
00547 List.BeginUpdate;
00548 try
00549 List.Clear;
00550 if TokenSymbolIs('UPDATE') then { Do not localize }
00551 try
00552 while not TokenSymbolIs('SET') do NextToken; { Do not localize }
00553 NextToken;
00554 while True do
00555 begin
00556 if FToken = stAlias then NextToken;
00557 if FToken <> stSymbol then Break;
00558 List.Add(FTokenString);
00559 if NextToken <> stEQ then Break;
00560 while NextToken <> stComma do
00561 if TokenSymbolIs('WHERE') or TokenSymbolIs('UPDATE') then Exit;{ Do not localize }
00562 NextToken;
00563 end;
00564 except
00565 end;
00566 finally
00567 List.EndUpdate;
00568 end;
00569 end;
00570
00571 procedure TSQLParser.GetWhereFields(List: TStrings);
00572 begin
00573 List.BeginUpdate;
00574 try
00575 List.Clear;
00576 if TokenSymbolIs('UPDATE') then { Do not localize }
00577 try
00578 while not TokenSymbolIs('WHERE') do NextToken; { Do not localize }
00579 NextToken;
00580 while True do
00581 begin
00582 while FToken in [stLParen, stRParen, stAlias, stOther] do NextToken;
00583 if FToken <> stSymbol then Break;
00584 List.Add(FTokenString);
00585 NextToken;
00586 if (FToken <> stEQ) and not TokenSymbolIs('IS') then Break;
00587 while true do
00588 begin
00589 NextToken;
00590 if FToken in [stEnd, stSemiColon] then Exit;
00591 if TokenSymbolIs('AND') then Break; { Do not localize }
00592 end;
00593 NextToken;
00594 end;
00595 except
00596 end;
00597 finally
00598 List.EndUpdate;
00599 end;
00600 end;
00601
00602 { TUpdateSQLEditor }
00603
00604 { Private Methods }
00605
00606 function TZUpdateSQLEditForm.Edit: Boolean;
00607 var
00608 Index: TUpdateKind;
00609 DataSetName: string;
00610 begin
00611 Result := False;
00612 ConnectionOpened := False;
00613 if Assigned(UpdateSQL.DataSet) and (UpdateSQL.DataSet is TZAbstractDataset) then
00614 begin
00615 DataSet := TZAbstractDataset(UpdateSQL.DataSet);
00616 DataSetName := Format('%s%s%s', [DataSet.Owner.Name, DotSep, DataSet.Name]);
00617 if Assigned(DataSet.Connection) and not DataSet.Connection.Connected then
00618 begin
00619 DataSet.Connection.Connect;
00620 ConnectionOpened := True;
00621 end;
00622 end else
00623 DataSetName := SNoDataSet;
00624 Caption := Format('%s%s%s (%s)', [UpdateSQL.Owner.Name, DotSep, UpdateSQL.Name, DataSetName]);
00625 try
00626 for Index := Low(TUpdateKind) to High(TUpdateKind) do
00627 begin
00628 SQLText[Index] := TStringList.Create;
00629 SQLText[Index].Assign(UpdateSQL.SQL[Index]);
00630 end;
00631 StatementType.ItemIndex := 0;
00632 StatementTypeClick(Self);
00633 InitUpdateTableNames;
00634 ShowWait(InitGenerateOptions);
00635 PageControl.ActivePage := PageControl.Pages[0];
00636 if ShowModal = mrOk then
00637 begin
00638 for Index := low(TUpdateKind) to high(TUpdateKind) do
00639 UpdateSQL.SQL[Index] := SQLText[Index];
00640 Result := True;
00641 end;
00642 finally
00643 for Index := Low(TUpdateKind) to High(TUpdateKind) do
00644 SQLText[Index].Free;
00645 end;
00646 end;
00647
00648 procedure TZUpdateSQLEditForm.GenWhereClause(const TabAlias: string;
00649 KeyFields, SQL: TStrings);
00650 var
00651 I: Integer;
00652 BindText: string;
00653 FieldName: string;
00654 OldFieldName: string;
00655 begin
00656 SQL.Add('WHERE'); { Do not localize }
00657 for I := 0 to KeyFields.Count - 1 do
00658 begin
00659 FieldName := KeyFields[I];
00660 OldFieldName := 'OLD_' + FieldName;
00661 if QuoteFields.Checked then
00662 FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
00663 if not Assigned(KeyFields.Objects[I]) then
00664 BindText := Format(' %s%s = :%s', { Do not localize }
00665 [TabAlias, FieldName, OldFieldName])
00666 else
00667 BindText := Format(' ((%0:s%1:s IS NULL AND :%2:s IS NULL) OR (%0:s%1:s = :%2:s))', { Do not localize }
00668 [TabAlias, FieldName, OldFieldName]);
00669 if I < KeyFields.Count - 1 then
00670 BindText := Format('%s AND',[BindText]); { Do not localize }
00671 SQL.Add(BindText);
00672 end;
00673 end;
00674
00675 procedure TZUpdateSQLEditForm.GenDeleteSQL(const TableName: string;
00676 KeyFields, SQL: TStrings);
00677 begin
00678 SQL.Add(Format('DELETE FROM %s', [TableName])); { Do not localize }
00679 GenWhereClause(GetTableRef(TableName), KeyFields, SQL);
00680 end;
00681
00682 procedure TZUpdateSQLEditForm.GenInsertSQL(const TableName: string;
00683 UpdateFields, SQL: TStrings);
00684
00685 procedure GenFieldList(const TabName, ParamChar: String);
00686 var
00687 L: string;
00688 I: integer;
00689 Comma: string;
00690 FieldName: string;
00691 begin
00692 L := ' (';
00693 Comma := ', ';
00694 for I := 0 to UpdateFields.Count - 1 do
00695 begin
00696 if I = UpdateFields.Count - 1 then Comma := '';
00697 FieldName := UpdateFields[I];
00698 if QuoteFields.Checked and (ParamChar = '') then
00699 FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
00700 L := Format('%s%s%s%s',[L, ParamChar, FieldName, Comma]);
00701 if (Length(L) > 70) and (I <> UpdateFields.Count - 1) then
00702 begin
00703 SQL.Add(L);
00704 L := ' ';
00705 end;
00706 end;
00707 SQL.Add(L+')');
00708 end;
00709
00710 begin
00711 SQL.Add(Format('INSERT INTO %s', [TableName])); { Do not localize }
00712 GenFieldList(GetTableRef(TableName), '');
00713 SQL.Add('VALUES'); { Do not localize }
00714 GenFieldList('', ':');
00715 end;
00716
00717 procedure TZUpdateSQLEditForm.GenModifySQL(const TableName: string;
00718 KeyFields, UpdateFields, SQL: TStrings);
00719 var
00720 I: integer;
00721 Comma: string;
00722 TableRef: string;
00723 FieldName: string;
00724 begin
00725 SQL.Add(Format('UPDATE %s SET', [TableName])); { Do not localize }
00726 Comma := ',';
00727 TableRef := GetTableRef(TableName);
00728 for I := 0 to UpdateFields.Count - 1 do
00729 begin
00730 if I = UpdateFields.Count -1 then Comma := '';
00731 FieldName := UpdateFields[I];
00732 if QuoteFields.Checked then
00733 FieldName := InternalQuoteIdentifier(FieldName, QuoteChar);
00734 SQL.Add(Format(' %s = :%s%s',
00735 [FieldName, UpdateFields[I], Comma]));
00736 end;
00737 GenWhereClause(TableRef, KeyFields, SQL);
00738 end;
00739
00740 procedure TZUpdateSQLEditForm.GenerateSQL;
00741
00742 function QuotedTableName(const BaseName: string): string;
00743 begin
00744 if QuoteFields.Checked then
00745 Result := InternalQuoteIdentifier(BaseName, QuoteChar)
00746 else
00747 Result := BaseName;
00748 end;
00749
00750 var
00751 KeyFields: TStringList;
00752 UpdateFields: TStringList;
00753 TableName: string;
00754 begin
00755 if (KeyFieldList.SelCount = 0) or (UpdateFieldList.SelCount = 0) then
00756 raise Exception.Create(SSQLGenSelect);
00757 KeyFields := TStringList.Create;
00758 try
00759 GetSelectedItems(KeyFieldList, KeyFields);
00760 UpdateFields := TStringList.Create;
00761 try
00762 GetSelectedItems(UpdateFieldList, UpdateFields);
00763 TableName := QuotedTableName(UpdateTableName.Text);
00764 if (SQLText[ukDelete].Text <> '') or (SQLText[ukInsert].Text <> '') or (SQLText[ukModify].Text <> '') then
00765 if MessageDlg('The SQL property is not empty. Do you want to clear it before the generation?', mtWarning, [mbYes, mbNo], 0) = mrYes then
00766 begin
00767 SQLText[ukDelete].Clear;
00768 SQLText[ukInsert].Clear;
00769 SQLText[ukModify].Clear;
00770 end
00771 else
00772 begin
00773 SQLText[ukDelete].Text := SQLText[ukDelete].Text + '';
00774 SQLText[ukDelete].Add('');
00775 SQLText[ukInsert].Text := SQLText[ukInsert].Text + '';
00776 SQLText[ukInsert].Add('');
00777 SQLText[ukModify].Text := SQLText[ukModify].Text + '';
00778 SQLText[ukModify].Add('');
00779 end;
00780 GenDeleteSQL(TableName, KeyFields, SQLText[ukDelete]);
00781 GenInsertSQL(TableName, UpdateFields, SQLText[ukInsert]);
00782 GenModifySQL(TableName, KeyFields, UpdateFields,
00783 SQLText[ukModify]);
00784 SQLMemo.Modified := False;
00785 StatementTypeClick(Self);
00786 PageControl.SelectNextPage(True);
00787 finally
00788 UpdateFields.Free;
00789 end;
00790 finally
00791 KeyFields.Free;
00792 end;
00793 end;
00794
00795 procedure TZUpdateSQLEditForm.GetDataSetFieldNames;
00796 begin
00797 if Assigned(DataSet) and Assigned(Dataset.Connection) then
00798 begin
00799 GetDataKeyNames(DataSet, DataSet.Name, KeyFieldList.Items);
00800 GetDataFieldNames(DataSet, DataSet.Name, UpdateFieldList.Items);
00801 end;
00802 end;
00803
00804 procedure TZUpdateSQLEditForm.GetTableFieldNames;
00805 var
00806 ResultSet: IZResultSet;
00807 begin
00808 if Assigned(DataSet) and Assigned(DataSet.Connection) and Assigned(DataSet.Connection.dbcConnection)then
00809 begin
00810 KeyFieldList.Clear;
00811 UpdateFieldList.Clear;
00812 ResultSet := DataSet.Connection.DbcConnection.GetMetadata.GetColumns('', '', UpdateTableName.Text, '');
00813 if Assigned(ResultSet) then
00814 begin
00815 while ResultSet.Next do
00816 begin
00817 if ResultSet.GetBooleanByName('SEARCHABLE') then
00818 KeyFieldList.Items.AddObject(ResultSet.GetStringByName('COLUMN_NAME'), Pointer(ResultSet.GetIntByName('NULLABLE') <> 0));
00819 if ResultSet.GetBooleanByName('WRITABLE') then
00820 UpdateFieldList.Items.Add(ResultSet.GetStringByName('COLUMN_NAME'));
00821 end;
00822 end;
00823 FDatasetDefaults := False;
00824 end;
00825 end;
00826
00827 function TZUpdateSQLEditForm.GetTableRef(const TabName: string): string;
00828 begin
00829 if QuoteChar <> '' then
00830 Result := TabName + '.' else
00831 REsult := '';
00832 end;
00833
00834 procedure TZUpdateSQLEditForm.InitGenerateOptions;
00835 var
00836 UpdTabName: string;
00837
00838 procedure InitFromDataSet;
00839 begin
00840
00841
00842 if (UpdateTableName.Items.Count > 1) then
00843 GetTableFieldNames
00844 else
00845 begin
00846 GetDataSetFieldNames;
00847 FDatasetDefaults := True;
00848 end;
00849 SetDefaultSelections;
00850 end;
00851
00852 procedure InitFromUpdateSQL;
00853 var
00854 UpdFields,
00855 WhFields: TStrings;
00856 begin
00857 UpdFields := TStringList.Create;
00858 try
00859 WhFields := TStringList.Create;
00860 try
00861 ParseUpdateSQL(SQLText[ukModify].Text, QuoteChar, UpdTabName, UpdFields, WhFields);
00862 GetDataSetFieldNames;
00863 if SetSelectedItems(UpdateFieldList, UpdFields) < 1 then
00864 SelectAll(UpdateFieldList);
00865 if SetSelectedItems(KeyFieldList, WhFields) < 1 then
00866 SelectAll(KeyFieldList);
00867 finally
00868 WhFields.Free;
00869 end;
00870 finally
00871 UpdFields.Free;
00872 end;
00873 end;
00874
00875 begin
00876
00877
00878 if SQLText[ukModify].Count > 0 then
00879 begin
00880 ParseUpdateSQL(SQLText[ukModify].Text, QuoteChar, UpdTabName, nil, nil);
00881
00882
00883 if (UpdateTableName.Items.Count > 0) and
00884 (UpdateTableName.Items.IndexOf(UpdTabName) > -1) then
00885 begin
00886 UpdateTableName.Text := UpdTabName;
00887 InitFromUpdateSQL;
00888 end else
00889 begin
00890 InitFromDataSet;
00891 UpdateTableName.Items.Add(UpdTabName);
00892 end;
00893 end else
00894 InitFromDataSet;
00895 SetButtonStates;
00896 end;
00897
00898 type
00899 THackDataSet = class(TZAbstractDataset);
00900
00901 procedure TZUpdateSQLEditForm.InitUpdateTableNames;
00902 var
00903 I: Integer;
00904 TableName: string;
00905 Tokenizer: IZTokenizer;
00906 StatementAnalyser: IZStatementAnalyser;
00907 SelectSchema: IZSelectSchema;
00908 begin
00909 QuoteChar := '""';
00910 if Assigned(DataSet) and Assigned(DataSet.Connection)
00911 and Assigned(DataSet.Connection.DbcConnection)then
00912 begin
00913 QuoteChar := DataSet.Connection.DbcConnection.GetMetadata.
00914 GetIdentifierQuoteString;
00915 if Length(QuoteChar) = 1 then
00916 QuoteChar := QuoteChar + QuoteChar;
00917 { Parses the Select statement and retrieves a schema object. }
00918 Tokenizer := DataSet.Connection.DbcDriver.GetTokenizer;
00919 StatementAnalyser := DataSet.Connection.DbcDriver.GetStatementAnalyser;
00920 SelectSchema := StatementAnalyser.DefineSelectSchemaFromQuery(Tokenizer,
00921 THackDataSet(DataSet).SQL.Text);
00922 if Assigned(SelectSchema) then
00923 begin
00924 UpdateTableName.Clear;
00925 for I := 0 to SelectSchema.TableCount - 1 do
00926 UpdateTableName.Items.Add(SelectSchema.Tables[I].Table);
00927 end;
00928 end
00929 else
00930 if Assigned(Dataset) then
00931 begin
00932 TableName := '';
00933 if SQLText[ukModify].Count > 0 then
00934 ParseUpdateSql(SQLText[ukModify].Text, QuoteChar, TableName, nil, nil);
00935 if TableName <> '' then
00936 UpdateTableName.Items.Add(TableName);
00937 end;
00938 if UpdateTableName.Items.Count > 0 then
00939 UpdateTableName.ItemIndex := 0;
00940 end;
00941
00942 procedure TZUpdateSQLEditForm.SetButtonStates;
00943 begin
00944 GetTableFieldsButton.Enabled := UpdateTableName.Text <> '';
00945 PrimaryKeyButton.Enabled := GetTableFieldsButton.Enabled and
00946 (KeyFieldList.Items.Count > 0);
00947 GenerateButton.Enabled := GetTableFieldsButton.Enabled and
00948 (UpdateFieldList.Items.Count > 0) and (KeyFieldList.Items.Count > 0);
00949 DefaultButton.Enabled := Assigned(DataSet) and not FDatasetDefaults;
00950 end;
00951
00952 procedure TZUpdateSQLEditForm.SelectPrimaryKeyFields;
00953 var
00954 I: Integer;
00955 Index: Integer;
00956 PKeys: TZSQLMetadata;
00957 begin
00958 if KeyFieldList.Items.Count < 1 then Exit;
00959 with Dataset do
00960 begin
00961 for I := 0 to KeyFieldList.Items.Count - 1 do
00962 KeyFieldList.Selected[I] := False;
00963 PKeys := TZSQLMetadata.Create(nil);
00964 try
00965 PKeys.Connection := Connection;
00966 PKeys.TableName := UpdateTableName.Text;
00967 PKeys.MetadataType := mdPrimaryKeys;
00968 PKeys.Open;
00969 PKeys.First;
00970 while not PKeys.Eof do
00971 begin
00972 Index := KeyFieldList.Items.IndexOf(PKeys.FieldByName('COLUMN_NAME').AsString);
00973 if Index > -1 then KeyFieldList.Selected[Index] := True;
00974 PKeys.Next;
00975 end;
00976 finally
00977 PKeys.Free;
00978 end;
00979 end;
00980 end;
00981
00982 procedure TZUpdateSQLEditForm.SetDefaultSelections;
00983 var
00984 DSFields: TStringList;
00985 begin
00986 if FDatasetDefaults or not Assigned(DataSet) then
00987 begin
00988 SelectAll(UpdateFieldList);
00989 SelectAll(KeyFieldList);
00990 end
00991 else if (DataSet.FieldDefs.Count > 0) then
00992 begin
00993 DSFields := TStringList.Create;
00994 try
00995 GetDataFieldNames(DataSet, '', DSFields);
00996 SetSelectedItems(KeyFieldList, DSFields);
00997 SetSelectedItems(UpdateFieldList, DSFields);
00998 finally
00999 DSFields.Free;
01000 end;
01001 end;
01002 end;
01003
01004 procedure TZUpdateSQLEditForm.ShowWait(WaitMethod: TWaitMethod);
01005 begin
01006 Screen.Cursor := crHourGlass;
01007 try
01008 WaitMethod;
01009 finally
01010 Screen.Cursor := crDefault;
01011 end;
01012 end;
01013
01014 { Event Handlers }
01015
01016 procedure TZUpdateSQLEditForm.FormCreate(Sender: TObject);
01017 begin
01018
01019 end;
01020
01021 procedure TZUpdateSQLEditForm.HelpButtonClick(Sender: TObject);
01022 begin
01023 Application.HelpContext(HelpContext);
01024 end;
01025
01026 procedure TZUpdateSQLEditForm.StatementTypeClick(Sender: TObject);
01027 begin
01028 if SQLMemo.Modified then
01029 SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
01030 StmtIndex := StatementType.ItemIndex;
01031 SQLMemo.Lines.Assign(SQLText[TUpdateKind(StmtIndex)]);
01032 end;
01033
01034 procedure TZUpdateSQLEditForm.OkButtonClick(Sender: TObject);
01035 begin
01036 if SQLMemo.Modified then
01037 SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
01038 end;
01039
01040 procedure TZUpdateSQLEditForm.DefaultButtonClick(Sender: TObject);
01041 begin
01042 with UpdateTableName do
01043 if Items.Count > 0 then ItemIndex := 0;
01044 ShowWait(GetDataSetFieldNames);
01045 FDatasetDefaults := True;
01046 SetDefaultSelections;
01047 KeyfieldList.SetFocus;
01048 SetButtonStates;
01049 end;
01050
01051 procedure TZUpdateSQLEditForm.GenerateButtonClick(Sender: TObject);
01052 begin
01053 GenerateSQL;
01054 FSettingsChanged := False;
01055 end;
01056
01057 procedure TZUpdateSQLEditForm.PrimaryKeyButtonClick(Sender: TObject);
01058 begin
01059 ShowWait(SelectPrimaryKeyFields);
01060 SettingsChanged(Sender);
01061 end;
01062
01063 procedure TZUpdateSQLEditForm.PageControlChanging(Sender: TObject;
01064 var AllowChange: Boolean);
01065 begin
01066 if (PageControl.ActivePage = PageControl.Pages[0]) and
01067 not SQLPage.Enabled then
01068 AllowChange := False;
01069 end;
01070
01071 procedure TZUpdateSQLEditForm.FormDestroy(Sender: TObject);
01072 begin
01073 if ConnectionOpened then
01074 DataSet.Connection.Disconnect;
01075 end;
01076
01077 procedure TZUpdateSQLEditForm.GetTableFieldsButtonClick(Sender: TObject);
01078 begin
01079 ShowWait(GetTableFieldNames);
01080 SetDefaultSelections;
01081 SettingsChanged(Sender);
01082 end;
01083
01084 procedure TZUpdateSQLEditForm.SettingsChanged(Sender: TObject);
01085 begin
01086 FSettingsChanged := True;
01087 FDatasetDefaults := False;
01088 SetButtonStates;
01089 end;
01090
01091 procedure TZUpdateSQLEditForm.FormCloseQuery(Sender: TObject;
01092 var CanClose: Boolean);
01093 begin
01094 if (ModalResult = mrOK) and FSettingsChanged then
01095 CanClose := MessageDlg(SSQLNotGenerated, mtConfirmation,
01096 mbYesNoCancel, 0) = mrYes;
01097 end;
01098
01099 procedure TZUpdateSQLEditForm.UpdateTableNameChange(Sender: TObject);
01100 begin
01101 SettingsChanged(Sender);
01102 end;
01103
01104 procedure TZUpdateSQLEditForm.UpdateTableNameClick(Sender: TObject);
01105 begin
01106 if not Visible then Exit;
01107 GetTableFieldsButtonClick(Sender);
01108 end;
01109
01110 procedure TZUpdateSQLEditForm.SelectAllClick(Sender: TObject);
01111 begin
01112 SelectAll(FieldListPopup.PopupComponent as TListBox);
01113 end;
01114
01115 procedure TZUpdateSQLEditForm.ClearAllClick(Sender: TObject);
01116 var
01117 I: Integer;
01118 begin
01119 with FieldListPopup.PopupComponent as TListBox do
01120 begin
01121 Items.BeginUpdate;
01122 try
01123 for I := 0 to Items.Count - 1 do
01124 Selected[I] := False;
01125 finally
01126 Items.EndUpdate;
01127 end;
01128 end;
01129 end;
01130
01131 procedure TZUpdateSQLEditForm.SQLMemoKeyPress(Sender: TObject;
01132 var Key: Char);
01133 begin
01134 if Key = #27 then Close;
01135 end;
01136
01137 {$IFDEF FPC}
01138 initialization
01139 {$i ZUpdateSqlEditor.lrs}
01140 {$ENDIF}
01141
01142 end.