1 |
{************************************************************************}
|
2 |
{ }
|
3 |
{ Borland Delphi Visual Component Library }
|
4 |
{ InterBase Express core components }
|
5 |
{ }
|
6 |
{ Copyright (c) 1998-2000 Inprise Corporation }
|
7 |
{ }
|
8 |
{ InterBase Express is based in part on the product }
|
9 |
{ Free IB Components, written by Gregory H. Deatz for }
|
10 |
{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
|
11 |
{ Free IB Components is used under license. }
|
12 |
{ }
|
13 |
{ The contents of this file are subject to the InterBase }
|
14 |
{ Public License Version 1.0 (the "License"); you may not }
|
15 |
{ use this file except in compliance with the License. You }
|
16 |
{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
|
17 |
{ Software distributed under the License is distributed on }
|
18 |
{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
|
19 |
{ express or implied. See the License for the specific language }
|
20 |
{ governing rights and limitations under the License. }
|
21 |
{ The Original Code was created by InterBase Software Corporation }
|
22 |
{ and its successors. }
|
23 |
{ Portions created by Inprise Corporation are Copyright (C) Inprise }
|
24 |
{ Corporation. All Rights Reserved. }
|
25 |
{ Contributor(s): Jeff Overcash }
|
26 |
{ }
|
27 |
{************************************************************************}
|
28 |
|
29 |
unit IBUpdateSQLEditor;
|
30 |
|
31 |
interface
|
32 |
|
33 |
uses Forms, DB, ExtCtrls, StdCtrls, Controls,
|
34 |
ComCtrls, Classes, SysUtils, Windows, Menus,
|
35 |
IB, IBDatabase, IBUpdateSQL, IBCustomDataSet,
|
36 |
IBTable, IBQuery, IBXConst;
|
37 |
|
38 |
type
|
39 |
|
40 |
TWaitMethod = procedure of object;
|
41 |
|
42 |
TIBUpdateSQLEditForm = class(TForm)
|
43 |
OkButton: TButton;
|
44 |
CancelButton: TButton;
|
45 |
HelpButton: TButton;
|
46 |
GenerateButton: TButton;
|
47 |
PrimaryKeyButton: TButton;
|
48 |
DefaultButton: TButton;
|
49 |
UpdateTableName: TComboBox;
|
50 |
FieldsPage: TTabSheet;
|
51 |
SQLPage: TTabSheet;
|
52 |
PageControl: TPageControl;
|
53 |
KeyFieldList: TListBox;
|
54 |
UpdateFieldList: TListBox;
|
55 |
GroupBox1: TGroupBox;
|
56 |
Label1: TLabel;
|
57 |
SQLMemo: TMemo;
|
58 |
StatementType: TRadioGroup;
|
59 |
QuoteFields: TCheckBox;
|
60 |
GetTableFieldsButton: TButton;
|
61 |
FieldListPopup: TPopupMenu;
|
62 |
miSelectAll: TMenuItem;
|
63 |
miClearAll: TMenuItem;
|
64 |
FTempTable: TIBTable;
|
65 |
procedure FormCreate(Sender: TObject);
|
66 |
procedure HelpButtonClick(Sender: TObject);
|
67 |
procedure StatementTypeClick(Sender: TObject);
|
68 |
procedure OkButtonClick(Sender: TObject);
|
69 |
procedure DefaultButtonClick(Sender: TObject);
|
70 |
procedure GenerateButtonClick(Sender: TObject);
|
71 |
procedure PrimaryKeyButtonClick(Sender: TObject);
|
72 |
procedure PageControlChanging(Sender: TObject;
|
73 |
var AllowChange: Boolean);
|
74 |
procedure FormDestroy(Sender: TObject);
|
75 |
procedure GetTableFieldsButtonClick(Sender: TObject);
|
76 |
procedure SettingsChanged(Sender: TObject);
|
77 |
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
78 |
procedure UpdateTableNameChange(Sender: TObject);
|
79 |
procedure UpdateTableNameClick(Sender: TObject);
|
80 |
procedure SelectAllClick(Sender: TObject);
|
81 |
procedure ClearAllClick(Sender: TObject);
|
82 |
procedure SQLMemoKeyPress(Sender: TObject; var Key: Char);
|
83 |
private
|
84 |
StmtIndex: Integer;
|
85 |
DataSet: TIBCustomDataset;
|
86 |
Database: TIBDatabase;
|
87 |
DatabaseOpened: Boolean;
|
88 |
UpdateSQL: TIBUpdateSQL;
|
89 |
DataSetEditorFlag: Boolean;
|
90 |
FSettingsChanged: Boolean;
|
91 |
FDatasetDefaults: Boolean;
|
92 |
SQLText: array[TUpdateKind] of TStrings;
|
93 |
RefreshSQL: TStrings;
|
94 |
function GetTableRef(const TabName, QuoteChar: string): string;
|
95 |
function Edit: Boolean;
|
96 |
procedure GenWhereClause(const TabAlias, QuoteChar: string;
|
97 |
KeyFields, SQL: TStrings);
|
98 |
procedure GenDeleteSQL(const TableName, QuoteChar: string;
|
99 |
KeyFields, SQL: TStrings);
|
100 |
procedure GenInsertSQL(const TableName, QuoteChar: string;
|
101 |
UpdateFields, SQL: TStrings);
|
102 |
procedure GenModifySQL(const TableName, QuoteChar: string;
|
103 |
KeyFields, UpdateFields, SQL: TStrings);
|
104 |
procedure GenRefreshSQL(const TableName, QuoteChar: string;
|
105 |
KeyFields, RefreshSQL: TStrings);
|
106 |
procedure GenerateSQL;
|
107 |
procedure GetDataSetFieldNames;
|
108 |
procedure GetTableFieldNames;
|
109 |
procedure InitGenerateOptions;
|
110 |
procedure InitUpdateTableNames;
|
111 |
procedure SetButtonStates;
|
112 |
procedure SelectPrimaryKeyFields;
|
113 |
procedure SetDefaultSelections;
|
114 |
procedure ShowWait(WaitMethod: TWaitMethod);
|
115 |
function TempTable: TIBTable;
|
116 |
end;
|
117 |
|
118 |
{ TSQLParser }
|
119 |
|
120 |
TSQLToken = (stSymbol, stAlias, stNumber, stComma, stEQ, stOther, stLParen,
|
121 |
stRParen, stEnd);
|
122 |
|
123 |
TSQLParser = class
|
124 |
private
|
125 |
FText: string;
|
126 |
FSourcePtr: PChar;
|
127 |
FTokenPtr: PChar;
|
128 |
FTokenString: string;
|
129 |
FToken: TSQLToken;
|
130 |
FSymbolQuoted: Boolean;
|
131 |
function NextToken: TSQLToken;
|
132 |
function TokenSymbolIs(const S: string): Boolean;
|
133 |
procedure Reset;
|
134 |
public
|
135 |
constructor Create(const Text: string);
|
136 |
procedure GetSelectTableNames(List: TStrings);
|
137 |
procedure GetUpdateTableName(var TableName: string);
|
138 |
procedure GetUpdateFields(List: TStrings);
|
139 |
procedure GetWhereFields(List: TStrings);
|
140 |
end;
|
141 |
|
142 |
function EditIBUpdateSQL(AUpdateSQL: TIBUpdateSQL): Boolean;
|
143 |
function EditIBDataSet(ADataSet: TIBDataSet): Boolean;
|
144 |
|
145 |
implementation
|
146 |
|
147 |
{$R *.DFM}
|
148 |
|
149 |
uses Dialogs, LibHelp, TypInfo;
|
150 |
|
151 |
{ Global Interface functions }
|
152 |
|
153 |
function EditIBUpdateSQL(AUpdateSQL: TIBUpdateSQL): Boolean;
|
154 |
begin
|
155 |
with TIBUpdateSQLEditForm.Create(Application) do
|
156 |
try
|
157 |
DataSetEditorFlag := False;
|
158 |
UpdateSQL := AUpdateSQL;
|
159 |
Result := Edit;
|
160 |
finally
|
161 |
Free;
|
162 |
end;
|
163 |
end;
|
164 |
|
165 |
function EditIBDataSet(ADataSet: TIBDataSet): Boolean;
|
166 |
var
|
167 |
TempUpdateSQL: TIBUpdateSQL;
|
168 |
TempQuery: TIBQuery;
|
169 |
begin
|
170 |
TempUpdateSQL := TIBUpdateSQL.Create(ADataSet);
|
171 |
TempQuery := TIBQuery.Create(ADataSet);
|
172 |
try
|
173 |
with TempQuery do
|
174 |
begin
|
175 |
Name := Concat('IBXInternal', ADataSet.Name); {mbcs ok}
|
176 |
Database := ADataSet.Database;
|
177 |
Transaction := ADataSet.Transaction;
|
178 |
SQL.Assign(ADataSet.SelectSQL);
|
179 |
UpdateObject := TempUpdateSQL;
|
180 |
TempUpdateSQL.ModifySQL.Assign(ADataSet.ModifySQL);
|
181 |
TempUpdateSQL.InsertSQL.Assign(ADataSet.InsertSQL);
|
182 |
TempUpdateSQL.DeleteSQL.Assign(ADataSet.DeleteSQL);
|
183 |
TempUpdateSQL.RefreshSQL.Assign(ADataSet.RefreshSQL);
|
184 |
end;
|
185 |
with TIBUpdateSQLEditForm.Create(Application) do
|
186 |
try
|
187 |
DataSetEditorFlag := True;
|
188 |
UpdateSQL := TempUpdateSQL;
|
189 |
Result := Edit;
|
190 |
finally
|
191 |
Free;
|
192 |
end;
|
193 |
if Result then
|
194 |
begin
|
195 |
ADataSet.RefreshSQL.Assign(TempUpdateSQL.RefreshSQL);
|
196 |
ADataSet.InsertSQL.Assign(TempUpdateSQL.InsertSQL);
|
197 |
ADataSet.ModifySQL.Assign(TempUpdateSQL.ModifySQL);
|
198 |
ADataSet.DeleteSQL.Assign(TempUpdateSQL.DeleteSQL);
|
199 |
end;
|
200 |
finally
|
201 |
TempUpdateSQL.free;
|
202 |
TempQuery.free;
|
203 |
end;
|
204 |
end;
|
205 |
|
206 |
{ Utility Routines }
|
207 |
|
208 |
procedure GetSelectedItems(ListBox: TListBox; List: TStrings);
|
209 |
var
|
210 |
I: Integer;
|
211 |
begin
|
212 |
List.Clear;
|
213 |
for I := 0 to ListBox.Items.Count - 1 do
|
214 |
if ListBox.Selected[I] then
|
215 |
List.Add(ListBox.Items[I]);
|
216 |
end;
|
217 |
|
218 |
function SetSelectedItems(ListBox: TListBox; List: TStrings): Integer;
|
219 |
var
|
220 |
I: Integer;
|
221 |
begin
|
222 |
Result := 0;
|
223 |
ListBox.Items.BeginUpdate;
|
224 |
try
|
225 |
for I := 0 to ListBox.Items.Count - 1 do
|
226 |
if List.IndexOf(ListBox.Items[I]) > -1 then
|
227 |
begin
|
228 |
ListBox.Selected[I] := True;
|
229 |
Inc(Result);
|
230 |
end
|
231 |
else
|
232 |
ListBox.Selected[I] := False;
|
233 |
if ListBox.Items.Count > 0 then
|
234 |
begin
|
235 |
ListBox.ItemIndex := 0;
|
236 |
ListBox.TopIndex := 0;
|
237 |
end;
|
238 |
finally
|
239 |
ListBox.Items.EndUpdate;
|
240 |
end;
|
241 |
end;
|
242 |
|
243 |
procedure SelectAll(ListBox: TListBox);
|
244 |
var
|
245 |
I: Integer;
|
246 |
begin
|
247 |
ListBox.Items.BeginUpdate;
|
248 |
try
|
249 |
with ListBox do
|
250 |
for I := 0 to Items.Count - 1 do
|
251 |
Selected[I] := True;
|
252 |
if ListBox.Items.Count > 0 then
|
253 |
begin
|
254 |
ListBox.ItemIndex := 0;
|
255 |
ListBox.TopIndex := 0;
|
256 |
end;
|
257 |
finally
|
258 |
ListBox.Items.EndUpdate;
|
259 |
end;
|
260 |
end;
|
261 |
|
262 |
procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
|
263 |
var
|
264 |
I: Integer;
|
265 |
begin
|
266 |
with Dataset do
|
267 |
try
|
268 |
FieldDefs.Update;
|
269 |
List.BeginUpdate;
|
270 |
try
|
271 |
List.Clear;
|
272 |
for I := 0 to FieldDefs.Count - 1 do
|
273 |
List.Add(FieldDefs[I].Name);
|
274 |
finally
|
275 |
List.EndUpdate;
|
276 |
end;
|
277 |
except
|
278 |
if ErrorName <> '' then
|
279 |
MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
|
280 |
end;
|
281 |
end;
|
282 |
|
283 |
procedure GetSQLTableNames(const SQL: string; List: TStrings);
|
284 |
begin
|
285 |
with TSQLParser.Create(SQL) do
|
286 |
try
|
287 |
GetSelectTableNames(List);
|
288 |
finally
|
289 |
Free;
|
290 |
end;
|
291 |
end;
|
292 |
|
293 |
procedure ParseUpdateSQL(const SQL: string; var TableName: string;
|
294 |
UpdateFields: TStrings; WhereFields: TStrings);
|
295 |
begin
|
296 |
with TSQLParser.Create(SQL) do
|
297 |
try
|
298 |
GetUpdateTableName(TableName);
|
299 |
if Assigned(UpdateFields) then
|
300 |
begin
|
301 |
Reset;
|
302 |
GetUpdateFields(UpdateFields);
|
303 |
end;
|
304 |
if Assigned(WhereFields) then
|
305 |
begin
|
306 |
Reset;
|
307 |
GetWhereFields(WhereFields);
|
308 |
end;
|
309 |
finally
|
310 |
Free;
|
311 |
end;
|
312 |
end;
|
313 |
|
314 |
{ TSQLParser }
|
315 |
|
316 |
constructor TSQLParser.Create(const Text: string);
|
317 |
begin
|
318 |
FText := Text;
|
319 |
FSourcePtr := PChar(Text);
|
320 |
NextToken;
|
321 |
end;
|
322 |
|
323 |
function TSQLParser.NextToken: TSQLToken;
|
324 |
var
|
325 |
P, TokenStart: PChar;
|
326 |
QuoteChar: Char;
|
327 |
IsParam: Boolean;
|
328 |
|
329 |
function IsKatakana(const Chr: Byte): Boolean;
|
330 |
begin
|
331 |
Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
|
332 |
end;
|
333 |
|
334 |
begin
|
335 |
if FToken = stEnd then SysUtils.Abort;
|
336 |
FTokenString := '';
|
337 |
FSymbolQuoted := False;
|
338 |
P := FSourcePtr;
|
339 |
while (P^ <> #0) and (P^ <= ' ') do Inc(P);
|
340 |
FTokenPtr := P;
|
341 |
case P^ of
|
342 |
'A'..'Z', 'a'..'z', '_', '$', #127..#255:
|
343 |
begin
|
344 |
TokenStart := P;
|
345 |
if not SysLocale.FarEast then
|
346 |
begin
|
347 |
Inc(P);
|
348 |
while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$', #127..#255] do Inc(P);
|
349 |
end
|
350 |
else
|
351 |
begin
|
352 |
while TRUE do
|
353 |
begin
|
354 |
if (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$']) or
|
355 |
IsKatakana(Byte(P^)) then
|
356 |
Inc(P)
|
357 |
else
|
358 |
if P^ in LeadBytes then
|
359 |
Inc(P, 2)
|
360 |
else
|
361 |
Break;
|
362 |
end;
|
363 |
end;
|
364 |
SetString(FTokenString, TokenStart, P - TokenStart);
|
365 |
FToken := stSymbol;
|
366 |
end;
|
367 |
'''', '"':
|
368 |
begin
|
369 |
QuoteChar := P^;
|
370 |
Inc(P);
|
371 |
IsParam := P^ = ':';
|
372 |
if IsParam then Inc(P);
|
373 |
TokenStart := P;
|
374 |
while not (P^ in [QuoteChar, #0]) do Inc(P);
|
375 |
SetString(FTokenString, TokenStart, P - TokenStart);
|
376 |
Inc(P);
|
377 |
Trim(FTokenString);
|
378 |
FToken := stSymbol;
|
379 |
FSymbolQuoted := True;
|
380 |
end;
|
381 |
'-', '0'..'9':
|
382 |
begin
|
383 |
TokenStart := P;
|
384 |
Inc(P);
|
385 |
while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do Inc(P);
|
386 |
SetString(FTokenString, TokenStart, P - TokenStart);
|
387 |
FToken := stNumber;
|
388 |
end;
|
389 |
',':
|
390 |
begin
|
391 |
Inc(P);
|
392 |
FToken := stComma;
|
393 |
end;
|
394 |
'=':
|
395 |
begin
|
396 |
Inc(P);
|
397 |
FToken := stEQ;
|
398 |
end;
|
399 |
'(':
|
400 |
begin
|
401 |
Inc(P);
|
402 |
FToken := stLParen;
|
403 |
end;
|
404 |
')':
|
405 |
begin
|
406 |
Inc(P);
|
407 |
FToken := stRParen;
|
408 |
end;
|
409 |
#0:
|
410 |
FToken := stEnd;
|
411 |
else
|
412 |
begin
|
413 |
FToken := stOther;
|
414 |
Inc(P);
|
415 |
end;
|
416 |
end;
|
417 |
FSourcePtr := P;
|
418 |
if (FToken = stSymbol) and
|
419 |
(FTokenString[Length(FTokenString)] = '.') then FToken := stAlias;
|
420 |
Result := FToken;
|
421 |
end;
|
422 |
|
423 |
procedure TSQLParser.Reset;
|
424 |
begin
|
425 |
FSourcePtr := PChar(FText);
|
426 |
FToken := stSymbol;
|
427 |
NextToken;
|
428 |
end;
|
429 |
|
430 |
function TSQLParser.TokenSymbolIs(const S: string): Boolean;
|
431 |
begin
|
432 |
Result := (FToken = stSymbol) and (CompareText(FTokenString, S) = 0);
|
433 |
end;
|
434 |
|
435 |
procedure TSQLParser.GetSelectTableNames(List: TStrings);
|
436 |
begin
|
437 |
List.BeginUpdate;
|
438 |
try
|
439 |
List.Clear;
|
440 |
if TokenSymbolIs('SELECT') then { Do not localize }
|
441 |
try
|
442 |
while not TokenSymbolIs('FROM') do NextToken; { Do not localize }
|
443 |
NextToken;
|
444 |
while FToken = stSymbol do
|
445 |
begin
|
446 |
List.AddObject(FTokenString, Pointer(Integer(FSymbolQuoted)));
|
447 |
if NextToken = stSymbol then NextToken;
|
448 |
if FToken = stComma then NextToken
|
449 |
else break;
|
450 |
end;
|
451 |
except
|
452 |
end;
|
453 |
finally
|
454 |
List.EndUpdate;
|
455 |
end;
|
456 |
end;
|
457 |
|
458 |
procedure TSQLParser.GetUpdateTableName(var TableName: string);
|
459 |
begin
|
460 |
if TokenSymbolIs('UPDATE') and (NextToken = stSymbol) then { Do not localize }
|
461 |
TableName := FTokenString else
|
462 |
TableName := '';
|
463 |
end;
|
464 |
|
465 |
procedure TSQLParser.GetUpdateFields(List: TStrings);
|
466 |
begin
|
467 |
List.BeginUpdate;
|
468 |
try
|
469 |
List.Clear;
|
470 |
if TokenSymbolIs('UPDATE') then { Do not localize }
|
471 |
try
|
472 |
while not TokenSymbolIs('SET') do NextToken; { Do not localize }
|
473 |
NextToken;
|
474 |
while True do
|
475 |
begin
|
476 |
if FToken = stAlias then NextToken;
|
477 |
if FToken <> stSymbol then Break;
|
478 |
List.Add(FTokenString);
|
479 |
if NextToken <> stEQ then Break;
|
480 |
while NextToken <> stComma do
|
481 |
if TokenSymbolIs('WHERE') then Exit;{ Do not localize }
|
482 |
NextToken;
|
483 |
end;
|
484 |
except
|
485 |
end;
|
486 |
finally
|
487 |
List.EndUpdate;
|
488 |
end;
|
489 |
end;
|
490 |
|
491 |
procedure TSQLParser.GetWhereFields(List: TStrings);
|
492 |
begin
|
493 |
List.BeginUpdate;
|
494 |
try
|
495 |
List.Clear;
|
496 |
if TokenSymbolIs('UPDATE') then { Do not localize }
|
497 |
try
|
498 |
while not TokenSymbolIs('WHERE') do NextToken; { Do not localize }
|
499 |
NextToken;
|
500 |
while True do
|
501 |
begin
|
502 |
while FToken in [stLParen, stAlias] do NextToken;
|
503 |
if FToken <> stSymbol then Break;
|
504 |
List.Add(FTokenString);
|
505 |
if NextToken <> stEQ then Break;
|
506 |
while true do
|
507 |
begin
|
508 |
NextToken;
|
509 |
if FToken = stEnd then Exit;
|
510 |
if TokenSymbolIs('AND') then Break; { Do not localize }
|
511 |
end;
|
512 |
NextToken;
|
513 |
end;
|
514 |
except
|
515 |
end;
|
516 |
finally
|
517 |
List.EndUpdate;
|
518 |
end;
|
519 |
end;
|
520 |
|
521 |
{ TIBUpdateSQLEditor }
|
522 |
|
523 |
{ Private Methods }
|
524 |
|
525 |
function TIBUpdateSQLEditForm.Edit: Boolean;
|
526 |
var
|
527 |
Index: TUpdateKind;
|
528 |
DataSetName: string;
|
529 |
begin
|
530 |
Result := False;
|
531 |
if Assigned(UpdateSQL.DataSet) and (UpdateSQL.DataSet is TIBCustomDataset) then
|
532 |
begin
|
533 |
DataSet := TIBCustomDataset(UpdateSQL.DataSet);
|
534 |
QuoteFields.Enabled := False;
|
535 |
if Assigned(DataSet.Database) then
|
536 |
begin
|
537 |
FTempTable.Database := DataSet.Database;
|
538 |
if DataSet.Database.SQLDialect < 3 then
|
539 |
QuoteFields.Enabled := False
|
540 |
else
|
541 |
QuoteFields.Enabled := True;
|
542 |
end;
|
543 |
DataSetName := Format('%s%s%s', [DataSet.Owner.Name, DotSep, DataSet.Name]);
|
544 |
end else
|
545 |
DataSetName := SNoDataSet;
|
546 |
if DataSetEditorFlag then
|
547 |
begin
|
548 |
DataSetName := Copy(DataSet.Name, Length('IBXInternal') + 1, Length(DataSet.Name)); {mbcs ok}
|
549 |
Caption := Format('%s%s%s', [DataSet.Owner.owner.Name, DotSep, DataSetName]);
|
550 |
end
|
551 |
else
|
552 |
Caption := Format('%s%s%s (%s)', [UpdateSQL.Owner.Name, DotSep, UpdateSQL.Name, DataSetName]);
|
553 |
try
|
554 |
for Index := Low(TUpdateKind) to High(TUpdateKind) do
|
555 |
begin
|
556 |
SQLText[Index] := TStringList.Create;
|
557 |
SQLText[Index].Assign(UpdateSQL.SQL[Index]);
|
558 |
end;
|
559 |
RefreshSQL := TStringList.Create;
|
560 |
RefreshSQL.Assign(UpdateSQL.RefreshSQL);
|
561 |
StatementTypeClick(Self);
|
562 |
InitUpdateTableNames;
|
563 |
ShowWait(InitGenerateOptions);
|
564 |
PageControl.ActivePage := PageControl.Pages[0];
|
565 |
if ShowModal = mrOk then
|
566 |
begin
|
567 |
for Index := low(TUpdateKind) to high(TUpdateKind) do
|
568 |
UpdateSQL.SQL[Index] := SQLText[Index];
|
569 |
UpdateSQL.RefreshSQL := RefreshSQL;
|
570 |
Result := True;
|
571 |
end;
|
572 |
finally
|
573 |
for Index := Low(TUpdateKind) to High(TUpdateKind) do
|
574 |
SQLText[Index].Free;
|
575 |
RefreshSQL.free;
|
576 |
end;
|
577 |
end;
|
578 |
|
579 |
procedure TIBUpdateSQLEditForm.GenWhereClause(const TabAlias, QuoteChar: string;
|
580 |
KeyFields, SQL: TStrings);
|
581 |
var
|
582 |
I: Integer;
|
583 |
BindText: string;
|
584 |
FieldName: string;
|
585 |
begin
|
586 |
SQL.Add('where'); { Do not localize }
|
587 |
for I := 0 to KeyFields.Count - 1 do
|
588 |
begin
|
589 |
FieldName := KeyFields[I];
|
590 |
BindText := Format(' %s%s%s%1:s = :%1:sOLD_%2:s%1:s', { Do not localize }
|
591 |
[TabAlias, QuoteChar, FieldName]);
|
592 |
if I < KeyFields.Count - 1 then
|
593 |
BindText := Format('%s and',[BindText]); { Do not localize }
|
594 |
SQL.Add(BindText);
|
595 |
end;
|
596 |
end;
|
597 |
|
598 |
procedure TIBUpdateSQLEditForm.GenDeleteSQL(const TableName, QuoteChar: string;
|
599 |
KeyFields, SQL: TStrings);
|
600 |
begin
|
601 |
SQL.Clear;
|
602 |
SQL.Add(Format('delete from %s%s%0:s', [QuoteChar, TableName])); { Do not localize }
|
603 |
GenWhereClause(GetTableRef(TableName, QuoteChar), QuoteChar, KeyFields, SQL);
|
604 |
end;
|
605 |
|
606 |
procedure TIBUpdateSQLEditForm.GenInsertSQL(const TableName, QuoteChar: string;
|
607 |
UpdateFields, SQL: TStrings);
|
608 |
|
609 |
procedure GenFieldList(const TabName, ParamChar, QuoteChar: String);
|
610 |
var
|
611 |
L: string;
|
612 |
I: integer;
|
613 |
Comma: string;
|
614 |
begin
|
615 |
L := ' (';
|
616 |
Comma := ', ';
|
617 |
for I := 0 to UpdateFields.Count - 1 do
|
618 |
begin
|
619 |
if I = UpdateFields.Count - 1 then Comma := '';
|
620 |
L := Format('%s%s%s%s%s%3:s%5:s',
|
621 |
[L, TabName, ParamChar, QuoteChar, UpdateFields[I], Comma]);
|
622 |
if (Length(L) > 70) and (I <> UpdateFields.Count - 1) then
|
623 |
begin
|
624 |
SQL.Add(L);
|
625 |
L := ' ';
|
626 |
end;
|
627 |
end;
|
628 |
SQL.Add(L+')');
|
629 |
end;
|
630 |
|
631 |
begin
|
632 |
SQL.Clear;
|
633 |
SQL.Add(Format('insert into %s%s%0:s', [QuoteChar,TableName])); { Do not localize }
|
634 |
GenFieldList(GetTableRef(TableName, QuoteChar), '', QuoteChar);
|
635 |
SQL.Add('values'); { Do not localize }
|
636 |
GenFieldList('', ':', QuoteChar);
|
637 |
end;
|
638 |
|
639 |
procedure TIBUpdateSQLEditForm.GenModifySQL(const TableName, QuoteChar: string;
|
640 |
KeyFields, UpdateFields, SQL: TStrings);
|
641 |
var
|
642 |
I: integer;
|
643 |
Comma: string;
|
644 |
TableRef: string;
|
645 |
begin
|
646 |
SQL.Clear;
|
647 |
SQL.Add(Format('update %s%s%0:s', [QuoteChar,TableName])); { Do not localize }
|
648 |
SQL.Add('set'); { Do not localize }
|
649 |
Comma := ',';
|
650 |
TableRef := GetTableRef(TableName, QuoteChar);
|
651 |
for I := 0 to UpdateFields.Count - 1 do
|
652 |
begin
|
653 |
if I = UpdateFields.Count -1 then Comma := '';
|
654 |
SQL.Add(Format(' %s%s%s%1:s = :%1:s%2:s%1:s%3:s',
|
655 |
[TableRef, QuoteChar, UpdateFields[I], Comma]));
|
656 |
end;
|
657 |
GenWhereClause(TableRef, QuoteChar, KeyFields, SQL);
|
658 |
end;
|
659 |
|
660 |
procedure TIBUpdateSQLEditForm.GenRefreshSQL(const TableName, QuoteChar: string;
|
661 |
KeyFields, RefreshSQL: TStrings);
|
662 |
var
|
663 |
I: integer;
|
664 |
Comma: string;
|
665 |
TableRef: string;
|
666 |
RefreshFieldList: TStrings;
|
667 |
|
668 |
procedure GenRefreshWhereClause;
|
669 |
var
|
670 |
I: Integer;
|
671 |
BindText: string;
|
672 |
FieldName: string;
|
673 |
begin
|
674 |
RefreshSQL.Add('where'); { Do not localize }
|
675 |
for I := 0 to KeyFields.Count - 1 do
|
676 |
begin
|
677 |
FieldName := KeyFields[I];
|
678 |
BindText := Format(' %s%s%s%1:s = :%1:s%2:s%1:s', { Do not localize }
|
679 |
[TableRef, QuoteChar, FieldName]);
|
680 |
if I < KeyFields.Count - 1 then
|
681 |
BindText := Format('%s and',[BindText]); { Do not localize }
|
682 |
RefreshSQL.Add(BindText);
|
683 |
end;
|
684 |
end;
|
685 |
|
686 |
begin
|
687 |
RefreshFieldList := TStringList.Create;
|
688 |
try
|
689 |
GetDataFieldNames(TempTable, TempTable.TableName, RefreshFieldList);
|
690 |
Comma := ',';
|
691 |
TableRef := GetTableRef(TableName, QuoteChar);
|
692 |
RefreshSQL.Clear;
|
693 |
RefreshSQL.Add('Select ');
|
694 |
if Dataset is TIBTable then
|
695 |
RefreshSQL.Add(' RDB$DB_KEY as IBX_INTERNAL_DBKEY, ');
|
696 |
for I := 0 to RefreshFieldList.Count - 1 do
|
697 |
begin
|
698 |
if I = RefreshFieldList.Count -1 then Comma := '';
|
699 |
RefreshSQL.Add(Format(' %s%s%s%1:s%3:s',
|
700 |
[TableRef, QuoteChar, RefreshFieldList[I], Comma]));
|
701 |
end;
|
702 |
RefreshSQL.Add(Format('from %s%s%0:s ', [QuoteChar, TableName]));
|
703 |
GenRefreshWhereClause;
|
704 |
finally
|
705 |
RefreshFieldList.Free;
|
706 |
end;
|
707 |
end;
|
708 |
|
709 |
procedure TIBUpdateSQLEditForm.GenerateSQL;
|
710 |
|
711 |
function QuotedTableName(const BaseName: string): string;
|
712 |
begin
|
713 |
with UpdateTableName do
|
714 |
if QuoteFields.Checked then
|
715 |
Result := Format('"%s"', [BaseName])
|
716 |
else
|
717 |
Result := BaseName;
|
718 |
end;
|
719 |
|
720 |
var
|
721 |
KeyFields: TStringList;
|
722 |
UpdateFields: TStringList;
|
723 |
QuoteChar, TableName: string;
|
724 |
begin
|
725 |
if (KeyFieldList.SelCount = 0) or (UpdateFieldList.SelCount = 0) then
|
726 |
raise Exception.CreateRes(@SSQLGenSelect);
|
727 |
KeyFields := TStringList.Create;
|
728 |
try
|
729 |
GetSelectedItems(KeyFieldList, KeyFields);
|
730 |
UpdateFields := TStringList.Create;
|
731 |
try
|
732 |
GetSelectedItems(UpdateFieldList, UpdateFields);
|
733 |
// TableName := QuotedTableName(UpdateTableName.Text);
|
734 |
TableName := UpdateTableName.Text;
|
735 |
if QuoteFields.Checked then
|
736 |
QuoteChar := '"'
|
737 |
else
|
738 |
QuoteChar := '';
|
739 |
GenDeleteSQL(TableName, QuoteChar, KeyFields, SQLText[ukDelete]);
|
740 |
GenInsertSQL(TableName, QuoteChar, UpdateFields, SQLText[ukInsert]);
|
741 |
GenModifySQL(TableName, QuoteChar, KeyFields, UpdateFields,
|
742 |
SQLText[ukModify]);
|
743 |
GenRefreshSQL(TableName, QuoteChar, KeyFields, RefreshSQL);
|
744 |
SQLMemo.Modified := False;
|
745 |
StatementTypeClick(Self);
|
746 |
PageControl.SelectNextPage(True);
|
747 |
finally
|
748 |
UpdateFields.Free;
|
749 |
end;
|
750 |
finally
|
751 |
KeyFields.Free;
|
752 |
end;
|
753 |
end;
|
754 |
|
755 |
procedure TIBUpdateSQLEditForm.GetDataSetFieldNames;
|
756 |
begin
|
757 |
if Assigned(DataSet) then
|
758 |
begin
|
759 |
if DataSetEditorFlag then
|
760 |
GetDataFieldNames(DataSet,
|
761 |
Copy(DataSet.Name, Length('IBXInternal')+1, Length(DataSet.Name)), {mbcs ok}
|
762 |
KeyFieldList.Items)
|
763 |
else
|
764 |
GetDataFieldNames(DataSet, DataSet.Name, KeyFieldList.Items);
|
765 |
UpdateFieldList.Items.Assign(KeyFieldList.Items);
|
766 |
end;
|
767 |
end;
|
768 |
|
769 |
procedure TIBUpdateSQLEditForm.GetTableFieldNames;
|
770 |
begin
|
771 |
GetDataFieldNames(TempTable, TempTable.TableName, KeyFieldList.Items);
|
772 |
UpdateFieldList.Items.Assign(KeyFieldList.Items);
|
773 |
FDatasetDefaults := False;
|
774 |
end;
|
775 |
|
776 |
function TIBUpdateSQLEditForm.GetTableRef(const TabName, QuoteChar: string): string;
|
777 |
begin
|
778 |
if QuoteChar <> '' then
|
779 |
Result := QuoteChar + TabName + QuoteChar + '.' else
|
780 |
Result := '';
|
781 |
end;
|
782 |
|
783 |
procedure TIBUpdateSQLEditForm.InitGenerateOptions;
|
784 |
var
|
785 |
UpdTabName: string;
|
786 |
|
787 |
procedure InitFromDataSet;
|
788 |
begin
|
789 |
// If this is a Query with more than 1 table in the "from" clause then
|
790 |
// initialize the list of fields from the table rather than the dataset.
|
791 |
if (UpdateTableName.Items.Count > 1) then
|
792 |
GetTableFieldNames
|
793 |
else
|
794 |
begin
|
795 |
GetDataSetFieldNames;
|
796 |
FDatasetDefaults := True;
|
797 |
end;
|
798 |
SetDefaultSelections;
|
799 |
end;
|
800 |
|
801 |
procedure InitFromUpdateSQL;
|
802 |
var
|
803 |
UpdFields,
|
804 |
WhFields: TStrings;
|
805 |
begin
|
806 |
UpdFields := TStringList.Create;
|
807 |
try
|
808 |
WhFields := TStringList.Create;
|
809 |
try
|
810 |
ParseUpdateSQL(SQLText[ukModify].Text, UpdTabName, UpdFields, WhFields);
|
811 |
GetDataSetFieldNames;
|
812 |
if SetSelectedItems(UpdateFieldList, UpdFields) < 1 then
|
813 |
SelectAll(UpdateFieldList);
|
814 |
if SetSelectedItems(KeyFieldList, WhFields) < 1 then
|
815 |
SelectAll(KeyFieldList);
|
816 |
finally
|
817 |
WhFields.Free;
|
818 |
end;
|
819 |
finally
|
820 |
UpdFields.Free;
|
821 |
end;
|
822 |
end;
|
823 |
|
824 |
begin
|
825 |
// If there are existing update SQL statements, try to initialize the
|
826 |
// dialog with the fields that correspond to them.
|
827 |
if SQLText[ukModify].Count > 0 then
|
828 |
begin
|
829 |
ParseUpdateSQL(SQLText[ukModify].Text, UpdTabName, nil, nil);
|
830 |
// If the table name from the update statement is not part of the
|
831 |
// dataset, then initialize from the dataset instead.
|
832 |
if (UpdateTableName.Items.Count > 0) and
|
833 |
(UpdateTableName.Items.IndexOf(UpdTabName) > -1) then
|
834 |
begin
|
835 |
UpdateTableName.Text := UpdTabName;
|
836 |
InitFromUpdateSQL;
|
837 |
end else
|
838 |
begin
|
839 |
InitFromDataSet;
|
840 |
UpdateTableName.Items.Add(UpdTabName);
|
841 |
end;
|
842 |
end else
|
843 |
InitFromDataSet;
|
844 |
SetButtonStates;
|
845 |
end;
|
846 |
|
847 |
procedure TIBUpdateSQLEditForm.InitUpdateTableNames;
|
848 |
begin
|
849 |
UpdateTableName.Items.Clear;
|
850 |
if Assigned(DataSet) then
|
851 |
begin
|
852 |
if DataSet is TIBQuery then
|
853 |
GetSQLTableNames(TIBQuery(DataSet).SQL.Text, UpdateTableName.Items)
|
854 |
else if (DataSet is TIBTable) and (TIBTable(DataSet).TableName <> '') then
|
855 |
UpdateTableName.Items.Add(TIBTable(DataSet).TableName);
|
856 |
end;
|
857 |
if UpdateTableName.Items.Count > 0 then
|
858 |
UpdateTableName.ItemIndex := 0;
|
859 |
end;
|
860 |
|
861 |
procedure TIBUpdateSQLEditForm.SetButtonStates;
|
862 |
begin
|
863 |
GetTableFieldsButton.Enabled := UpdateTableName.Text <> '';
|
864 |
PrimaryKeyButton.Enabled := GetTableFieldsButton.Enabled and
|
865 |
(KeyFieldList.Items.Count > 0);
|
866 |
GenerateButton.Enabled := GetTableFieldsButton.Enabled and
|
867 |
(UpdateFieldList.Items.Count > 0) and (KeyFieldList.Items.Count > 0);
|
868 |
DefaultButton.Enabled := Assigned(DataSet) and not FDatasetDefaults;
|
869 |
end;
|
870 |
|
871 |
procedure TIBUpdateSQLEditForm.SelectPrimaryKeyFields;
|
872 |
var
|
873 |
SepPos, I, Index: Integer;
|
874 |
FName, FieldNames: string;
|
875 |
begin
|
876 |
if KeyFieldList.Items.Count < 1 then Exit;
|
877 |
with TempTable do
|
878 |
begin
|
879 |
IndexDefs.Update;
|
880 |
for I := 0 to KeyFieldList.Items.Count - 1 do
|
881 |
KeyFieldList.Selected[I] := False;
|
882 |
for I := 0 to IndexDefs.Count - 1 do
|
883 |
if ixPrimary in IndexDefs[I].Options then
|
884 |
begin
|
885 |
FieldNames := IndexDefs[I].Fields + ';';
|
886 |
while Length(FieldNames) > 0 do
|
887 |
begin
|
888 |
SepPos := Pos(';', FieldNames);
|
889 |
if SepPos < 1 then Break;
|
890 |
FName := Copy(FieldNames, 1, SepPos - 1);
|
891 |
System.Delete(FieldNames, 1, SepPos);
|
892 |
Index := KeyFieldList.Items.IndexOf(FName);
|
893 |
if Index > -1 then KeyFieldList.Selected[Index] := True;
|
894 |
end;
|
895 |
break;
|
896 |
end;
|
897 |
end;
|
898 |
end;
|
899 |
|
900 |
procedure TIBUpdateSQLEditForm.SetDefaultSelections;
|
901 |
var
|
902 |
DSFields: TStringList;
|
903 |
begin
|
904 |
if FDatasetDefaults or not Assigned(DataSet) then
|
905 |
begin
|
906 |
SelectAll(UpdateFieldList);
|
907 |
SelectAll(KeyFieldList);
|
908 |
end
|
909 |
else if (DataSet.FieldDefs.Count > 0) then
|
910 |
begin
|
911 |
DSFields := TStringList.Create;
|
912 |
try
|
913 |
GetDataFieldNames(DataSet, '', DSFields);
|
914 |
SetSelectedItems(KeyFieldList, DSFields);
|
915 |
SetSelectedItems(UpdateFieldList, DSFields);
|
916 |
finally
|
917 |
DSFields.Free;
|
918 |
end;
|
919 |
end;
|
920 |
end;
|
921 |
|
922 |
procedure TIBUpdateSQLEditForm.ShowWait(WaitMethod: TWaitMethod);
|
923 |
var
|
924 |
SetCursor: Boolean;
|
925 |
begin
|
926 |
SetCursor := Screen.Cursor = crDefault;
|
927 |
if SetCursor then
|
928 |
Screen.Cursor := crHourGlass;
|
929 |
Screen.Cursor := crHourGlass;
|
930 |
try
|
931 |
WaitMethod;
|
932 |
finally
|
933 |
if SetCursor and (Screen.Cursor = crHourGlass) then
|
934 |
Screen.Cursor := crDefault;
|
935 |
end;
|
936 |
end;
|
937 |
|
938 |
function TIBUpdateSQLEditForm.TempTable: TIBTable;
|
939 |
begin
|
940 |
if FTempTable.TableName <> UpdateTableName.Text then
|
941 |
begin
|
942 |
FTempTable.Close;
|
943 |
FTempTable.TableName := UpdateTableName.Text;
|
944 |
end;
|
945 |
Result := FTempTable;
|
946 |
end;
|
947 |
|
948 |
{ Event Handlers }
|
949 |
|
950 |
procedure TIBUpdateSQLEditForm.FormCreate(Sender: TObject);
|
951 |
begin
|
952 |
HelpContext := hcDIBUpdateSQL;
|
953 |
end;
|
954 |
|
955 |
procedure TIBUpdateSQLEditForm.HelpButtonClick(Sender: TObject);
|
956 |
begin
|
957 |
Application.HelpContext(HelpContext);
|
958 |
end;
|
959 |
|
960 |
procedure TIBUpdateSQLEditForm.StatementTypeClick(Sender: TObject);
|
961 |
begin
|
962 |
if SQLMemo.Modified then
|
963 |
SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
|
964 |
StmtIndex := StatementType.ItemIndex;
|
965 |
SQLMemo.Lines.Assign(SQLText[TUpdateKind(StmtIndex)]);
|
966 |
end;
|
967 |
|
968 |
procedure TIBUpdateSQLEditForm.OkButtonClick(Sender: TObject);
|
969 |
begin
|
970 |
if SQLMemo.Modified then
|
971 |
SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
|
972 |
end;
|
973 |
|
974 |
procedure TIBUpdateSQLEditForm.DefaultButtonClick(Sender: TObject);
|
975 |
begin
|
976 |
with UpdateTableName do
|
977 |
if Items.Count > 0 then ItemIndex := 0;
|
978 |
ShowWait(GetDataSetFieldNames);
|
979 |
FDatasetDefaults := True;
|
980 |
SetDefaultSelections;
|
981 |
KeyfieldList.SetFocus;
|
982 |
SetButtonStates;
|
983 |
end;
|
984 |
|
985 |
procedure TIBUpdateSQLEditForm.GenerateButtonClick(Sender: TObject);
|
986 |
begin
|
987 |
GenerateSQL;
|
988 |
FSettingsChanged := False;
|
989 |
end;
|
990 |
|
991 |
procedure TIBUpdateSQLEditForm.PrimaryKeyButtonClick(Sender: TObject);
|
992 |
begin
|
993 |
ShowWait(SelectPrimaryKeyFields);
|
994 |
SettingsChanged(Sender);
|
995 |
end;
|
996 |
|
997 |
procedure TIBUpdateSQLEditForm.PageControlChanging(Sender: TObject;
|
998 |
var AllowChange: Boolean);
|
999 |
begin
|
1000 |
if (PageControl.ActivePage = PageControl.Pages[0]) and
|
1001 |
not SQLPage.Enabled then
|
1002 |
AllowChange := False;
|
1003 |
end;
|
1004 |
|
1005 |
procedure TIBUpdateSQLEditForm.FormDestroy(Sender: TObject);
|
1006 |
begin
|
1007 |
if DatabaseOpened then
|
1008 |
Database.Close;
|
1009 |
end;
|
1010 |
|
1011 |
procedure TIBUpdateSQLEditForm.GetTableFieldsButtonClick(Sender: TObject);
|
1012 |
begin
|
1013 |
ShowWait(GetTableFieldNames);
|
1014 |
SetDefaultSelections;
|
1015 |
SettingsChanged(Sender);
|
1016 |
end;
|
1017 |
|
1018 |
procedure TIBUpdateSQLEditForm.SettingsChanged(Sender: TObject);
|
1019 |
begin
|
1020 |
FSettingsChanged := True;
|
1021 |
FDatasetDefaults := False;
|
1022 |
SetButtonStates;
|
1023 |
end;
|
1024 |
|
1025 |
procedure TIBUpdateSQLEditForm.FormCloseQuery(Sender: TObject;
|
1026 |
var CanClose: Boolean);
|
1027 |
begin
|
1028 |
if (ModalResult = mrOK) and FSettingsChanged then
|
1029 |
CanClose := MessageDlg(SSQLNotGenerated, mtConfirmation,
|
1030 |
mbYesNoCancel, 0) = mrYes;
|
1031 |
end;
|
1032 |
|
1033 |
procedure TIBUpdateSQLEditForm.UpdateTableNameChange(Sender: TObject);
|
1034 |
begin
|
1035 |
SettingsChanged(Sender);
|
1036 |
end;
|
1037 |
|
1038 |
procedure TIBUpdateSQLEditForm.UpdateTableNameClick(Sender: TObject);
|
1039 |
begin
|
1040 |
if not Visible then Exit;
|
1041 |
GetTableFieldsButtonClick(Sender);
|
1042 |
end;
|
1043 |
|
1044 |
procedure TIBUpdateSQLEditForm.SelectAllClick(Sender: TObject);
|
1045 |
begin
|
1046 |
SelectAll(FieldListPopup.PopupComponent as TListBox);
|
1047 |
end;
|
1048 |
|
1049 |
procedure TIBUpdateSQLEditForm.ClearAllClick(Sender: TObject);
|
1050 |
var
|
1051 |
I: Integer;
|
1052 |
begin
|
1053 |
with FieldListPopup.PopupComponent as TListBox do
|
1054 |
begin
|
1055 |
Items.BeginUpdate;
|
1056 |
try
|
1057 |
for I := 0 to Items.Count - 1 do
|
1058 |
Selected[I] := False;
|
1059 |
finally
|
1060 |
Items.EndUpdate;
|
1061 |
end;
|
1062 |
end;
|
1063 |
end;
|
1064 |
|
1065 |
procedure TIBUpdateSQLEditForm.SQLMemoKeyPress(Sender: TObject;
|
1066 |
var Key: Char);
|
1067 |
begin
|
1068 |
if Key = #27 then Close;
|
1069 |
end;
|
1070 |
|
1071 |
end.
|