ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBTable.pas
Revision: 308
Committed: Sat Jul 18 10:26:30 2020 UTC (3 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 48153 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
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 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 - 2018 }
31 { }
32 {************************************************************************}
33
34 unit IBTable;
35
36 {$Mode Delphi}
37
38 {$codepage UTF8}
39
40 interface
41
42 uses SysUtils, Classes, DB, IB, IBCustomDataSet,
43 IBSQL, IBUtils;
44
45 type
46
47 { TIBTable }
48
49 TIBTableType = (ttSystem, ttView);
50 TIBTableTypes = set of TIBTableType;
51 TIndexName = String;
52
53 TIBTable = class;
54
55 TIBTable = class(TIBCustomDataSet)
56 private
57 FSystemTable: Boolean;
58 FMultiTableView: Boolean;
59 FMasterLink: TMasterDataLink;
60 FMasterFieldsList: TStringList;
61 FDetailFieldsList: TStringList;
62 FIndexDefs: TIndexDefs;
63 FDefaultIndex: Boolean;
64 FReadOnly: Boolean;
65 FFieldsIndex: Boolean;
66 FTableName: String;
67 FIndexName: TIndexName;
68 FRegenerateSQL: Boolean;
69 FNameList: TStrings;
70 FSwitchingIndex: Boolean;
71 FPrimaryIndexFields: string;
72 FTableTypes: TIBTableTypes;
73 FStoreDefs: boolean;
74 WhereAllRefreshSQL: TStrings;
75 WhereDBKeyRefreshSQL: TStrings;
76 WherePrimaryRefreshSQL: TStrings;
77
78 function GetIndexFieldCount: Integer;
79 function GetIndexField(Index: Integer): TField;
80 procedure MasterChanged(Sender: TObject);
81 procedure MasterDisabled(Sender: TObject);
82 procedure SetDataSource(Value: TDataSource);
83 procedure SetIndexField(Index: Integer; Value: TField);
84 procedure SetIndexFieldNames(const Value: string);
85 procedure GenerateSQL;
86 procedure GenerateUpdateSQL;
87 procedure SwitchToIndex();
88 procedure InternalTableRefresh();
89 function GetTableNames: TStrings;
90 procedure GetTableNamesFromServer;
91 procedure SetTableTypes(
92 const Value: TIBTableTypes);
93 function InternalGotoDBKey(DBKey: TIBDBKey): Boolean;
94 function FormatFieldsList(Value: string): string;
95 function GetCurrentDBKey: TIBDBKey;
96 function InternalGetUpdatable: Boolean;
97 function GetExists: Boolean;
98 procedure SetIndexDefs(Value: TIndexDefs);
99 procedure ExtractLinkFields;
100 function IndexDefsStored: Boolean;
101 function GetMasterFields: string;
102 procedure SetMasterFields(const Value: string);
103 function GetIndexFieldNames: string;
104 function GetIndexName: string;
105 procedure SetIndexName(const Value: string);
106 procedure SetParams;
107 procedure SetReadOnly(Value: Boolean);
108 procedure SetTableName(Value: String);
109 procedure SetIndex(const Value: string; FieldsIndex: Boolean);
110 procedure ResetSQLStatements;
111 procedure Reopen;
112
113 protected
114
115 procedure DoOnNewRecord; override;
116 procedure GetIndexParams(const IndexName: string; FieldsIndex: Boolean;
117 var IndexedName: string);
118 function GetCanModify: Boolean; override;
119 procedure UpdateIndexDefs; override;
120 procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
121 procedure DefChanged(Sender: TObject); virtual;
122 function GetDataSource: TDataSource; override;
123 procedure InitFieldDefs; override;
124 procedure InternalClose; override;
125 procedure InternalOpen; override;
126 procedure InternalRefresh; override;
127 procedure SetFiltered(Value: Boolean); override;
128 procedure SetFilterText(const Value: string); override;
129 procedure SetFilterOptions(Value: TFilterOptions); override;
130 procedure InternalRefreshRow; override;
131 function GetMasterDetailDelay: integer; override;
132 procedure SetMasterDetailDelay(AValue: integer); override;
133
134 public
135 constructor Create(AOwner: TComponent); override;
136 destructor Destroy; override;
137 procedure AddIndex(const Name, Fields: string; Options: TIndexOptions;
138 const DescFields: string = '');
139 procedure CreateTable;
140 procedure DeleteIndex(const Name: string);
141 procedure DeleteTable;
142 procedure EmptyTable;
143 procedure GetDetailLinkFields(MasterFields, DetailFields: TList); virtual;
144 procedure GetIndexNames(List: TStrings);
145 procedure GotoCurrent(Table: TIBTable);
146 property CurrentDBKey: TIBDBKey read GetCurrentDBKey;
147 property Exists: Boolean read GetExists;
148 property IndexFieldCount: Integer read GetIndexFieldCount;
149 property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
150 property SelectStmtHandle;
151 property TableNames: TStrings read GetTableNames;
152
153 published
154 property AutoCommit;
155 property Active;
156 property BufferChunks;
157 property CachedUpdates;
158 property DataSetCloseAction;
159 // property Constraints stored ConstraintsStored;
160 property DefaultIndex: Boolean read FDefaultIndex write FDefaultIndex default True;
161 property EnableStatistics;
162 property Filter;
163 property Filtered;
164 property SQLFiltered;
165 property SQLFilterParams;
166 property GeneratorField;
167 property IndexDefs: TIndexDefs read FIndexDefs write SetIndexDefs stored IndexDefsStored;
168 property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
169 property IndexName: string read GetIndexName write SetIndexName;
170 property MasterFields: string read GetMasterFields write SetMasterFields;
171 property MasterSource: TDataSource read GetDataSource write SetDataSource;
172 property MasterDetailDelay;
173 property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
174 property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
175 property TableName: String read FTableName write SetTableName;
176 property TableTypes: TIBTableTypes read FTableTypes write SetTableTypes default [];
177 property UpdateObject;
178 property UniDirectional;
179
180 property BeforeDatabaseDisconnect;
181 property AfterDatabaseDisconnect;
182 property DatabaseFree;
183 property BeforeTransactionEnd;
184 property AfterTransactionEnd;
185 property TransactionFree;
186 property OnFilterRecord;
187 end;
188
189 implementation
190
191 uses IBMessages, IBTypes;
192
193 type
194
195 { TIBMasterDataLink }
196
197 TIBMasterDataLink = class(TMasterDataLink)
198 private
199 FDelayTimerValue: integer;
200 FTimer: TIBTimerInf;
201 procedure HandleRefreshTimer(Sender: TObject);
202 procedure SetDelayTimerValue(AValue: integer);
203 protected
204 procedure DoMasterChange; override;
205 public
206 constructor Create(ADataSet: TDataSet); override;
207 property DelayTimerValue: integer {in Milliseconds}
208 read FDelayTimerValue write SetDelayTimerValue;
209 end;
210
211 { TIBMasterDataLink }
212
213 procedure TIBMasterDataLink.HandleRefreshTimer(Sender: TObject);
214 begin
215 FTimer.Enabled := false;
216 if GetDetailDataSet.Active then
217 inherited DoMasterChange;
218 end;
219
220 procedure TIBMasterDataLink.SetDelayTimerValue(AValue: integer);
221 begin
222 if FDelayTimerValue = AValue then Exit;
223 if assigned(FTimer) then
224 FTimer.Enabled := false;
225 FDelayTimerValue := AValue;
226 end;
227
228 procedure TIBMasterDataLink.DoMasterChange;
229 begin
230 if assigned(FTimer) and (FDelayTimerValue > 0) then
231 with FTimer do
232 begin
233 FTimer.Enabled := false;
234 FTimer.Interval := FDelayTimerValue;
235 FTimer.Enabled := true;
236 end
237 else
238 inherited DoMasterChange
239 end;
240
241 constructor TIBMasterDataLink.Create(ADataSet: TDataSet);
242 begin
243 inherited Create(ADataSet);
244 if assigned(IBGUIInterface) then
245 begin
246 FTimer := IBGUIInterface.CreateTimer;
247 if FTimer <> nil then
248 begin
249 FTimer.Enabled := false;
250 FTimer.Interval := 0;
251 FTimer.OnTimer := HandleRefreshTimer;
252 end;
253 end;
254 FDelayTimerValue := 0;
255 end;
256
257 { TIBTable }
258
259 constructor TIBTable.Create(AOwner: TComponent);
260 begin
261 inherited Create(AOwner);
262 FNameList := TStringList.Create;
263 FSwitchingIndex := False;
264 FIndexDefs := TIndexDefs.Create(Self);
265 WhereAllRefreshSQL := TStringList.Create;
266 WhereDBKeyRefreshSQL := TStringList.Create;
267 WherePrimaryRefreshSQL := TStringList.Create;
268 FDefaultIndex := True;
269 FRegenerateSQL := True;
270 FMasterFieldsList := TStringList.Create;
271 FDetailFieldsList := TStringList.Create;
272 FMasterLink := TIBMasterDataLink.Create(Self);
273 FMasterLink.OnMasterChange := MasterChanged;
274 FMasterLink.OnMasterDisable := MasterDisabled;
275 QRefresh.OnSQLChanging := nil;
276 QDelete.OnSQLChanging := nil;
277 QInsert.OnSQLChanging := nil;
278 QModify.OnSQLChanging := nil;
279 end;
280
281 destructor TIBTable.Destroy;
282 begin
283 FNameList.Free;
284 FIndexDefs.Free;
285 FMasterFieldsList.Free;
286 FDetailFieldsList.Free;
287 FMasterLink.Free;
288 WhereAllRefreshSQL.Free;
289 WhereDBKeyRefreshSQL.Free;
290 WherePrimaryRefreshSQL.Free;
291 inherited Destroy;
292 end;
293
294 procedure TIBTable.InternalClose;
295 begin
296 DataEvent(dePropertyChange, 0);
297 inherited InternalClose;
298 end;
299
300 procedure TIBTable.InternalOpen;
301 begin
302 if FTableName = '' then IBError(ibxeNoTableName, [nil]);
303 ActivateConnection;
304 ActivateTransaction;
305 if FRegenerateSQL then
306 begin
307 InternalUnprepare;
308 GenerateSQL;
309 if not FReadOnly then
310 GenerateUpdateSQL;
311 FRegenerateSQL := False;
312 end;
313 { writeln(SelectSQL.Text);
314 writeln(InsertSQL.Text);
315 writeln(DeleteSQL.Text);
316 writeln(ModifySQL.Text); }
317 SetParams;
318 inherited InternalOpen;
319 end;
320
321 procedure TIBTable.InternalRefresh;
322 var
323 DBKey: TIBDBKey;
324 begin
325 DBKey := CurrentDBKey;
326 Reopen;
327 if DBKey.DBKey[0] <> 0 then
328 InternalGotoDBKey(DBKey);
329 end;
330
331 procedure TIBTable.SetFiltered(Value: Boolean);
332 begin
333 if(Filtered <> Value) then
334 begin
335 inherited SetFiltered(value);
336 if Active then
337 InternalTableRefresh;
338 end
339 else
340 inherited SetFiltered(value);
341 end;
342
343 procedure TIBTable.SetFilterText(const Value: string);
344 begin
345 if Filtered and (Value <> Filter) then
346 begin
347 inherited SetFilterText(value);
348 InternalTableRefresh;
349 end
350 else
351 inherited SetFilterText(value);
352 end;
353
354 procedure TIBTable.SetFilterOptions(Value: TFilterOptions);
355 begin
356 if Value <> [] then
357 IBError(ibxeNotSupported, [nil]);
358 end;
359
360 procedure TIBTable.InternalRefreshRow;
361 begin
362 if CurrentDBKey.DBKey[0] <> 0 then
363 QRefresh.SQL.Assign(WhereDBKeyRefreshSQL)
364 else if WherePrimaryRefreshSQL.Text <> '' then
365 QRefresh.SQL.Assign(WherePrimaryRefreshSQL)
366 else
367 QRefresh.SQL.Assign(WhereAllRefreshSQL);
368 inherited InternalRefreshRow;
369 end;
370
371 function TIBTable.GetMasterDetailDelay: integer;
372 begin
373 Result := TIBMasterDataLink(FMasterLink).DelayTimerValue
374 end;
375
376 procedure TIBTable.SetMasterDetailDelay(AValue: integer);
377 begin
378 TIBMasterDataLink(FMasterLink).DelayTimerValue := AValue;
379 end;
380
381 procedure TIBTable.DefChanged(Sender: TObject);
382 begin
383 StoreDefs := True;
384 end;
385
386 procedure TIBTable.InitFieldDefs;
387 var
388 DidActivate: Boolean;
389 Query: TIBSQL;
390 begin
391 if FTableName = '' then IBError(ibxeNoTableName, [nil]);
392 if (InternalPrepared) then
393 InternalInitFieldDefs
394 else
395 begin
396 {Get the field defs from a simple query on the table}
397 ActivateConnection;
398 Query := TIBSQL.Create(self);
399 try
400 Query.Database := DataBase;
401 Query.Transaction := Database.InternalTransaction;
402 DidActivate := false;
403 Query.SQL.Text := 'Select * from ' + QuoteIdentifier(DataBase.SQLDialect, FTableName);
404 with Query.Transaction do
405 begin
406 if not InTransaction then
407 begin
408 StartTransaction;
409 DidActivate := true
410 end;
411 end;
412 Query.Prepare;
413 FieldDefsFromQuery(Query);
414 if DidActivate then
415 Query.Transaction.Rollback;
416 finally
417 Query.Free;
418 end;
419 end;
420 end;
421
422 { Index / Ranges / Keys }
423
424 procedure TIBTable.AddIndex(const Name, Fields: string; Options: TIndexOptions;
425 const DescFields: string);
426 var
427 Query: TIBSQL;
428 FieldList: string;
429 begin
430 FieldDefs.Update;
431 if Active then begin
432 CheckBrowseMode;
433 CursorPosChanged;
434 end;
435 Query := TIBSQL.Create(self);
436 try
437 Query.Database := DataBase;
438 Query.Transaction := Transaction;
439 FieldList := FormatFieldsList(Fields);
440 if (ixPrimary in Options) then
441 begin
442 Query.SQL.Text := 'Alter Table ' + {do not localize}
443 QuoteIdentifier(Database.SQLDialect, FTableName) +
444 ' Add CONSTRAINT ' + {do not localize}
445 QuoteIdentifier(Database.SQLDialect, Name)
446 + ' Primary Key (' + {do not localize}
447 FormatFieldsList(Fields) +
448 ')';
449 end
450 else if ([ixUnique, ixDescending] * Options = [ixUnique, ixDescending]) then
451 Query.SQL.Text := 'Create unique Descending Index ' + {do not localize}
452 QuoteIdentifier(Database.SQLDialect, Name) +
453 ' on ' + {do not localize}
454 QuoteIdentifier(Database.SQLDialect, FTableName) +
455 ' (' + FieldList + ')'
456 else if (ixUnique in Options) then
457 Query.SQL.Text := 'Create unique Index ' + {do not localize}
458 QuoteIdentifier(Database.SQLDialect, Name) +
459 ' on ' + {do not localize}
460 QuoteIdentifier(Database.SQLDialect, FTableName) +
461 ' (' + FieldList + ')'
462 else if (ixDescending in Options) then
463 Query.SQL.Text := 'Create Descending Index ' + {do not localize}
464 QuoteIdentifier(Database.SQLDialect, Name) +
465 ' on ' + {do not localize}
466 QuoteIdentifier(Database.SQLDialect, FTableName) +
467 ' (' + FieldList + ')'
468 else
469 Query.SQL.Text := 'Create Index ' + {do not localize}
470 QuoteIdentifier(Database.SQLDialect, Name) +
471 ' on ' + {do not localize}
472 QuoteIdentifier(Database.SQLDialect, FTableName) +
473 ' (' + FieldList + ')';
474 Query.Prepare;
475 Query.ExecQuery;
476 IndexDefs.Updated := False;
477 finally
478 Query.free
479 end;
480 end;
481
482 procedure TIBTable.DeleteIndex(const Name: string);
483 var
484 Query: TIBSQL;
485
486 procedure DeleteByIndex;
487 begin
488 Query := TIBSQL.Create(self);
489 try
490 Query.Database := DataBase;
491 Query.Transaction := Transaction;
492 Query.SQL.Text := 'Drop index ' + {do not localize}
493 QuoteIdentifier(Database.SQLDialect, Name);
494 Query.Prepare;
495 Query.ExecQuery;
496 IndexDefs.Updated := False;
497 finally
498 Query.Free;
499 end;
500 end;
501
502 function DeleteByConstraint: Boolean;
503 begin
504 Result := False;
505 Query := TIBSQL.Create(self);
506 try
507 Query.Database := DataBase;
508 Query.Transaction := Transaction;
509 Query.SQL.Text := 'Select ''foo'' from RDB$RELATION_CONSTRAINTS ' +
510 'where RDB$RELATION_NAME = ' +
511 '''' +
512 ExtractIdentifier(Database.SQLDialect,
513 QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
514 ''' ' +
515 ' AND RDB$CONSTRAINT_NAME = ' +
516 '''' +
517 ExtractIdentifier(Database.SQLDialect,
518 QuoteIdentifier(DataBase.SQLDialect, Name)) +
519 ''' ' +
520 'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
521 Query.Prepare;
522 Query.ExecQuery;
523 if not Query.EOF then
524 begin
525 Query.Close;
526 Query.SQL.Text := 'Alter Table ' + {do not localize}
527 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
528 ' Drop Constraint ' +
529 QuoteIdentifier(DataBase.SQLDialect, Name);
530 Query.Prepare;
531 Query.ExecQuery;
532 IndexDefs.Updated := False;
533 Result := True;
534 end;
535 finally
536 Query.Free;
537 end;
538 end;
539
540 procedure DeleteByKey;
541 begin
542 Query := TIBSQL.Create(self);
543 try
544 Query.Database := DataBase;
545 Query.Transaction := Transaction;
546 Query.SQL.Text := 'Select RDB$CONSTRAINT_NAME from RDB$RELATION_CONSTRAINTS ' +
547 'where RDB$RELATION_NAME = ' +
548 '''' +
549 ExtractIdentifier(Database.SQLDialect,
550 QuoteIdentifier(DataBase.SQLDialect, FTableName)) +
551 ''' ' +
552 'AND RDB$INDEX_NAME = ' +
553 '''' +
554 ExtractIdentifier(Database.SQLDialect,
555 QuoteIdentifier(DataBase.SQLDialect, Name)) +
556 ''' ' +
557 'AND RDB$CONSTRAINT_TYPE = ''PRIMARY KEY''';
558 Query.Prepare;
559 Query.ExecQuery;
560 if not Query.EOF then
561 begin
562 Query.Close;
563 Query.SQL.Text := 'Alter Table ' + {do not localize}
564 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
565 ' Drop Constraint ' +
566 QuoteIdentifier(DataBase.SQLDialect, Query.FieldByName('RDB$CONSTRAINT_NAME').AsString);
567 Query.Prepare;
568 Query.ExecQuery;
569 IndexDefs.Updated := False;
570 end;
571 finally
572 Query.Free;
573 end;
574 end;
575
576 begin
577 if Active then
578 CheckBrowseMode;
579 IndexDefs.Update;
580 if (Pos('RDB$PRIMARY', Name) <> 0 ) then {do not localize} {mbcs ok}
581 DeleteByKey
582 else if not DeleteByConstraint then
583 DeleteByIndex;
584 end;
585
586 function TIBTable.GetIndexFieldNames: string;
587 begin
588 if FFieldsIndex then Result := FIndexName else Result := '';
589 end;
590
591 function TIBTable.GetIndexName: string;
592 begin
593 if FFieldsIndex then Result := '' else Result := FIndexName;
594 end;
595
596 procedure TIBTable.GetIndexNames(List: TStrings);
597 begin
598 IndexDefs.Update;
599 IndexDefs.GetItemNames(List);
600 end;
601
602 procedure TIBTable.GetIndexParams(const IndexName: string;
603 FieldsIndex: Boolean; var IndexedName: string);
604 var
605 IndexStr: TIndexName;
606 begin
607 if IndexName <> '' then
608 begin
609 IndexDefs.Update;
610 IndexStr := IndexName;
611 if FieldsIndex then
612 IndexStr := IndexDefs.FindIndexForFields(IndexName).Name;
613 end;
614 IndexedName := IndexStr;
615 end;
616
617 procedure TIBTable.SetIndexDefs(Value: TIndexDefs);
618 begin
619 IndexDefs.Assign(Value);
620 end;
621
622 procedure TIBTable.SetIndex(const Value: string; FieldsIndex: Boolean);
623 begin
624 if Active then CheckBrowseMode;
625 if (FIndexName <> Value) or (FFieldsIndex <> FieldsIndex) then
626 begin
627 FIndexName := Value;
628 FFieldsIndex := FieldsIndex;
629 if Active then
630 begin
631 SwitchToIndex;
632 end;
633 end;
634 end;
635
636 procedure TIBTable.SetIndexFieldNames(const Value: string);
637 begin
638 SetIndex(Value, Value <> '');
639 end;
640
641 procedure TIBTable.SetIndexName(const Value: string);
642 begin
643 SetIndex(Value, False);
644 end;
645
646 procedure TIBTable.UpdateIndexDefs;
647 var
648 Opts: TIndexOptions;
649 Flds: string;
650 Query, SubQuery: TIBSQL;
651 fn: string;
652 aField: TFieldDef;
653 begin
654 if not (csReading in ComponentState) then begin
655 if not Active and not FSwitchingIndex then
656 FieldDefs.Update;
657 IndexDefs.Clear;
658 Database.InternalTransaction.StartTransaction;
659 Query := TIBSQL.Create(self);
660 try
661 FPrimaryIndexFields := '';
662 Query.GoToFirstRecordOnExecute := False;
663 Query.Database := DataBase;
664 Query.Transaction := Database.InternalTransaction;
665 Query.SQL.Text :=
666 'Select I.RDB$INDEX_NAME, I.RDB$UNIQUE_FLAG, I.RDB$INDEX_TYPE, ' + {do not localize}
667 'I.RDB$SEGMENT_COUNT, S.RDB$FIELD_NAME from RDB$INDICES I, ' + {do not localize}
668 'RDB$INDEX_SEGMENTS S where I.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+ {do not localize}
669 'and I.RDB$RELATION_NAME = ' + '''' + {do not localize}
670 ExtractIdentifier(Database.SQLDialect,
671 QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
672 Query.Prepare;
673 Query.ExecQuery;
674 while (not Query.EOF) and Query.Next do
675 begin
676 with IndexDefs.AddIndexDef do
677 begin
678 Name := TrimRight(Query.FieldByName('RDB$INDEX_NAME').AsString); {do not localize}
679 Opts := [];
680 if Pos ('RDB$PRIMARY', Name) = 1 then Include(Opts, ixPrimary); {do not localize} {mbcs ok}
681 if Query.FieldByName('RDB$UNIQUE_FLAG').AsInteger = 1 then Include(Opts, ixUnique); {do not localize}
682 if Query.FieldByName('RDB$INDEX_TYPE').AsInteger = 2 then Include(Opts, ixDescending); {do not localize}
683 Options := Opts;
684 if (Query.FieldByName('RDB$SEGMENT_COUNT').AsInteger = 1) then {do not localize}
685 begin
686 fn := Trim(Query.FieldByName('RDB$FIELD_NAME').AsString); {do not localize}
687 aField := GetFieldDefFromAlias(fn);
688 if assigned(aField) then
689 Fields := aField.Name
690 else
691 Fields := fn;
692 end
693 else begin
694 SubQuery := TIBSQL.Create(self);
695 try
696 SubQuery.GoToFirstRecordOnExecute := False;
697 SubQuery.Database := DataBase;
698 SubQuery.Transaction := Database.InternalTransaction;
699 SubQuery.SQL.Text :=
700 'Select RDB$FIELD_NAME from RDB$INDEX_SEGMENTS where RDB$INDEX_NAME = ' + {do not localize}
701 '''' +
702 ExtractIdentifier(Database.SQLDialect,
703 QuoteIdentifier(DataBase.SQLDialect, Name)) +
704 '''' + 'ORDER BY RDB$FIELD_POSITION'; {do not localize}
705 SubQuery.Prepare;
706 SubQuery.ExecQuery;
707 Flds := '';
708 while (not SubQuery.EOF) and SubQuery.Next do
709 begin
710 fn := TrimRight(SubQuery.FieldByName('RDB$FIELD_NAME').AsString); {do not localize}
711 aField := GetFieldDefFromAlias(fn);
712 if assigned(aField) then
713 fn := aField.Name;
714 if (Flds = '') then
715 Flds := fn
716 else begin
717 Query.Next;
718 Flds := Flds + ';' + fn;
719 end;
720 end;
721 Fields := Flds;
722 finally
723 SubQuery.Free;
724 end;
725 end;
726 if (ixDescending in Opts) then
727 DescFields := Fields;
728 if ixPrimary in Opts then
729 FPrimaryIndexFields := Fields;
730 end;
731 end;
732 finally
733 Query.Free;
734 Database.InternalTransaction.Commit;
735 end;
736 end;
737 end;
738
739 function TIBTable.GetExists: Boolean;
740 var
741 Query: TIBSQL;
742 begin
743 Result := Active;
744 if Result or (TableName = '') then Exit;
745 Database.InternalTransaction.StartTransaction;
746 Query := TIBSQL.Create(self);
747 try
748 Query.Database := DataBase;
749 Query.Transaction := Database.InternalTransaction;
750 Query.SQL.Text :=
751 'Select USER from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
752 '''' +
753 ExtractIdentifier(Database.SQLDialect,
754 QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
755 Query.Prepare;
756 Query.ExecQuery;
757 Result := not Query.EOF;
758 finally
759 Query.Free;
760 Database.InternalTransaction.Commit;
761 end;
762 end;
763
764 procedure TIBTable.GotoCurrent(Table: TIBTable);
765 begin
766 CheckBrowseMode;
767 Table.CheckBrowseMode;
768 if (Database <> Table.Database) or
769 (CompareText(TableName, Table.TableName) <> 0) then
770 IBError(ibxeTableNameMismatch, [nil]);
771 Table.UpdateCursorPos;
772 InternalGotoDBKey(Table.CurrentDBKey);
773 DoBeforeScroll;
774 Resync([rmExact, rmCenter]);
775 DoAfterScroll;
776 end;
777
778
779 procedure TIBTable.CreateTable;
780 var
781 FieldList: string;
782
783 procedure InitFieldsList;
784 var
785 I: Integer;
786 begin
787 InitFieldDefsFromFields;
788 for I := 0 to FieldDefs.Count - 1 do begin
789 if ( I > 0) then
790 FieldList := FieldList + ', ';
791 with FieldDefs[I] do
792 begin
793 case DataType of
794 ftString:
795 FieldList := FieldList +
796 QuoteIdentifier(DataBase.SQLDialect, Name) +
797 ' VARCHAR(' + IntToStr(Size) + ')'; {do not localize}
798 ftFixedChar:
799 FieldList := FieldList +
800 QuoteIdentifier(DataBase.SQLDialect, Name) +
801 ' CHAR(' + IntToStr(Size) + ')'; {do not localize}
802 ftBoolean:
803 FieldList := FieldList +
804 QuoteIdentifier(DataBase.SQLDialect, Name) +
805 ' BOOLEAN'; {do not localize}
806 ftSmallint, ftWord:
807 FieldList := FieldList +
808 QuoteIdentifier(DataBase.SQLDialect, Name) +
809 ' SMALLINT'; {do not localize}
810 ftInteger:
811 FieldList := FieldList +
812 QuoteIdentifier(DataBase.SQLDialect, Name) +
813 ' INTEGER'; {do not localize}
814 ftFloat, ftCurrency:
815 FieldList := FieldList +
816 QuoteIdentifier(DataBase.SQLDialect, Name) +
817 ' DOUBLE PRECISION'; {do not localize}
818 ftBCD: begin
819 if (Database.SQLDialect = 1) then begin
820 if (Precision > 9) then
821 IBError(ibxeFieldUnsupportedType,[nil]);
822 if (Precision <= 4) then
823 Precision := 9;
824 end;
825 if (Precision <= 4 ) then
826 FieldList := FieldList +
827 QuoteIdentifier(DataBase.SQLDialect, Name) +
828 ' Numeric(18, 4)' {do not localize}
829 else
830 FieldList := FieldList +
831 QuoteIdentifier(DataBase.SQLDialect, Name) +
832 ' Numeric(' + IntToStr(Precision) + ', 4)'; {do not localize}
833 end;
834 ftDate:
835 FieldList := FieldList +
836 QuoteIdentifier(DataBase.SQLDialect, Name) +
837 ' DATE'; {do not localize}
838 ftTime:
839 FieldList := FieldList +
840 QuoteIdentifier(DataBase.SQLDialect, Name) +
841 ' TIME'; {do not localize}
842 ftDateTime:
843 if (Database.SQLDialect = 1) then
844 FieldList := FieldList +
845 QuoteIdentifier(DataBase.SQLDialect, Name) +
846 ' DATE' {do not localize}
847 else
848 FieldList := FieldList +
849 QuoteIdentifier(DataBase.SQLDialect, Name) +
850 ' TIMESTAMP'; {do not localize}
851 ftLargeInt:
852 if (Database.SQLDialect = 1) then
853 IBError(ibxeFieldUnsupportedType,[nil])
854 else
855 FieldList := FieldList +
856 QuoteIdentifier(DataBase.SQLDialect, Name) +
857 ' Numeric(18, 0)'; {do not localize}
858 ftBlob, ftMemo:
859 FieldList := FieldList +
860 QuoteIdentifier(DataBase.SQLDialect, Name) +
861 ' BLOB SUB_TYPE 1'; {do not localize}
862 ftBytes, ftVarBytes, ftGraphic..ftTypedBinary:
863 FieldList := FieldList +
864 QuoteIdentifier(DataBase.SQLDialect, Name) +
865 ' BLOB SUB_TYPE 0'; {do not localize}
866 ftUnknown, ftADT, ftArray, ftReference, ftDataSet,
867 ftCursor, ftWideString, ftAutoInc:
868 IBError(ibxeFieldUnsupportedType,[nil]);
869 else
870 IBError(ibxeFieldUnsupportedType,[nil]);
871 end;
872 if faRequired in Attributes then
873 FieldList := FieldList + ' NOT NULL'; {do not localize}
874 end;
875 end;
876 end;
877
878 procedure InternalCreateTable;
879 var
880 I: Integer;
881 Query: TIBSQL;
882 begin
883 if (FieldList = '') then
884 IBError(ibxeFieldUnsupportedType,[nil]);
885 Query := TIBSQL.Create(self);
886 try
887 Query.Database := Database;
888 Query.transaction := Transaction;
889 Query.SQL.Text := 'Create Table ' +
890 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
891 ' (' + FieldList; {do not localize}
892 for I := 0 to IndexDefs.Count - 1 do
893 with IndexDefs[I] do
894 if ixPrimary in Options then
895 begin
896 Query.SQL.Text := Query.SQL.Text + ', CONSTRAINT ' +
897 QuoteIdentifier(DataBase.SQLDialect, Name) +
898 ' Primary Key (' +
899 FormatFieldsList(Fields) +
900 ')';
901 end;
902 Query.SQL.Text := Query.SQL.Text + ')';
903 Query.Prepare;
904 Query.ExecQuery;
905 finally
906 Query.Free;
907 end;
908 end;
909
910 procedure InternalCreateIndex;
911 var
912 I: Integer;
913 begin
914 for I := 0 to IndexDefs.Count - 1 do
915 with IndexDefs[I] do
916 if not (ixPrimary in Options) then
917 AddIndex(Name, Fields, Options);
918 end;
919
920 begin
921 CheckInactive;
922 InitFieldsList;
923 InternalCreateTable;
924 InternalCreateIndex;
925 end;
926
927 procedure TIBTable.DeleteTable;
928 var
929 Query: TIBSQL;
930 begin
931 CheckInactive;
932 Query := TIBSQL.Create(self);
933 try
934 Query.Database := DataBase;
935 Query.Transaction := Transaction;
936 Query.SQL.Text := 'drop table ' + {do not localize}
937 QuoteIdentifier(DataBase.SQLDialect, FTableName);
938 Query.Prepare;
939 Query.ExecQuery;
940 finally
941 Query.Free;
942 end;
943 end;
944
945 procedure TIBTable.EmptyTable;
946 var
947 Query: TIBSQL;
948 begin
949 if Active then
950 CheckBrowseMode;
951 Query := TIBSQL.Create(self);
952 try
953 Query.Database := DataBase;
954 Query.Transaction := Transaction;
955 Query.SQL.Text := 'delete from ' + {do not localize}
956 QuoteIdentifier(DataBase.SQLDialect, FTableName);
957 Query.Prepare;
958 Query.ExecQuery;
959 if Active then
960 begin
961 ClearBuffers;
962 DataEvent(deDataSetChange, 0);
963 end;
964 finally
965 Query.Free;
966 end;
967 end;
968
969 procedure TIBTable.DataEvent(Event: TDataEvent; Info: Ptrint);
970 begin
971 if Event = dePropertyChange then begin
972 IndexDefs.Updated := False;
973 FRegenerateSQL := True;
974 end;
975 inherited DataEvent(Event, Info);
976 end;
977
978 { Informational & Property }
979
980 function TIBTable.GetCanModify: Boolean;
981 begin
982 Result := True;
983 if (FTableName = '') or FReadOnly
984 or FSystemTable or FMultiTableView then
985 Result := False;
986 end;
987
988 function TIBTable.InternalGetUpdatable: Boolean;
989 var
990 Query : TIBSQL;
991 begin
992 Database.InternalTransaction.StartTransaction;
993 Query := TIBSQL.Create(self);
994 try
995 Query.Database := DataBase;
996 Query.Transaction := Database.InternalTransaction;
997 Query.SQL.Text := 'Select RDB$SYSTEM_FLAG, RDB$DBKEY_LENGTH ' + {do not localize}
998 'from RDB$RELATIONS where RDB$RELATION_NAME = ' + {do not localize}
999 '''' +
1000 ExtractIdentifier(Database.SQLDialect,
1001 QuoteIdentifier(DataBase.SQLDialect, FTableName)) + '''';
1002 Query.Prepare;
1003 Query.ExecQuery;
1004 if (Query.Fields[0].AsInteger <> 0) or
1005 (Query.Fields[1].AsInteger <> 8) then
1006 Result := False
1007 else
1008 Result := True;
1009 finally
1010 Query.Free;
1011 Database.InternalTransaction.Commit;
1012 end;
1013 end;
1014
1015 function TIBTable.IndexDefsStored: Boolean;
1016 begin
1017 Result := StoreDefs and (IndexDefs.Count > 0);
1018 end;
1019
1020 procedure TIBTable.SetParams;
1021 var
1022 i: Integer;
1023 begin
1024 if (MasterSource = nil) or (MasterSource.DataSet = nil) or
1025 (not MasterSource.DataSet.Active) or (FMasterFieldsList.Count = 0) then
1026 exit;
1027 for i := 0 to FMasterFieldsList.Count - 1 do
1028 QSelect.Params.ByName(FMasterFieldsList.Strings[i]).Value :=
1029 MasterSource.DataSet.FieldByName(FMasterFieldsList.Strings[i]).Value;
1030 end;
1031
1032 procedure TIBTable.MasterChanged(Sender: TObject);
1033 begin
1034 CheckBrowseMode;
1035 SetParams;
1036 ReQuery;
1037 end;
1038
1039 procedure TIBTable.MasterDisabled(Sender: TObject);
1040 begin
1041 DataEvent(dePropertyChange, 0);
1042 ReQuery;
1043 end;
1044
1045 function TIBTable.GetDataSource: TDataSource;
1046 begin
1047 Result := FMasterLink.DataSource;
1048 end;
1049
1050 procedure TIBTable.SetDataSource(Value: TDataSource);
1051 begin
1052 if IsLinkedTo(Value) then IBError(ibxeCircularDataLink, [Self]);
1053 if FMasterLink.DataSource <> Value then
1054 DataEvent(dePropertyChange, 0);
1055 FMasterLink.DataSource := Value;
1056 end;
1057
1058 function TIBTable.GetMasterFields: string;
1059 begin
1060 Result := FMasterLink.FieldNames;
1061 end;
1062
1063 procedure TIBTable.SetMasterFields(const Value: string);
1064 begin
1065 if FMasterLink.FieldNames <> Value then
1066 DataEvent(dePropertyChange, 0);
1067 FMasterLink.FieldNames := Value;
1068 end;
1069
1070 procedure TIBTable.DoOnNewRecord;
1071 var
1072 I: Integer;
1073 begin
1074 if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
1075 for I := 0 to FMasterLink.Fields.Count - 1 do
1076 IndexFields[I] := TField(FMasterLink.Fields[I]);
1077 inherited DoOnNewRecord;
1078 end;
1079
1080 function TIBTable.FormatFieldsList(Value: string): string;
1081 var
1082 FieldName: string;
1083 i: Integer;
1084 begin
1085 if Database.SQLDialect = 1 then begin
1086 Value := QuoteIdentifier(Database.SQLDialect, Value);
1087 Result := StringReplace (Value, ';', ', ', [rfReplaceAll]);
1088 end
1089 else begin
1090 i := 1;
1091 Result := '';
1092 while i <= Length(Value) do
1093 begin
1094 FieldName := ExtractFieldName(Value, i);
1095 if Result = '' then
1096 Result := QuoteIdentifier(Database.SQLDialect, FieldName)
1097 else
1098 Result := Result + ', ' + QuoteIdentifier(Database.SQLDialect, FieldName);
1099 end;
1100 end;
1101 end;
1102
1103 procedure TIBTable.ExtractLinkFields;
1104 var
1105 i: Integer;
1106 DetailFieldNames: String;
1107 begin
1108 FMasterFieldsList.Clear;
1109 FDetailFieldsList.Clear;
1110 i := 1;
1111 while i <= Length(MasterFields) do
1112 FMasterFieldsList.Add(ExtractFieldName(MasterFields, i));
1113 i := 1;
1114 if IndexFieldNames = '' then
1115 DetailFieldNames := FPrimaryIndexFields
1116 else
1117 DetailFieldNames := IndexFieldNames;
1118 while i <= Length(DetailFieldNames) do
1119 FDetailFieldsList.Add(ExtractFieldName(DetailFieldNames, i));
1120 end;
1121
1122 procedure TIBTable.GetDetailLinkFields(MasterFields, DetailFields: TList);
1123 var
1124 i: Integer;
1125 Idx: TIndexDef;
1126 begin
1127 MasterFields.Clear;
1128 DetailFields.Clear;
1129 if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and
1130 (Self.MasterFields <> '') then
1131 begin
1132 Idx := nil;
1133 MasterSource.DataSet.GetFieldList(MasterFields, Self.MasterFields);
1134 UpdateIndexDefs;
1135 if IndexName <> '' then
1136 Idx := IndexDefs.Find(IndexName)
1137 else if IndexFieldNames <> '' then
1138 Idx := IndexDefs.GetIndexForFields(IndexFieldNames, False)
1139 else
1140 for i := 0 to IndexDefs.Count - 1 do
1141 if ixPrimary in IndexDefs[i].Options then
1142 begin
1143 Idx := IndexDefs[i];
1144 break;
1145 end;
1146 if Idx <> nil then
1147 GetFieldList(DetailFields, Idx.Fields);
1148 end;
1149 end;
1150
1151 procedure TIBTable.SetReadOnly(Value: Boolean);
1152 begin
1153 CheckInactive;
1154 FReadOnly := Value;
1155 end;
1156
1157 procedure TIBTable.SetTableName(Value: String);
1158 begin
1159 if not (csReading in ComponentState) then
1160 begin
1161 CheckInactive;
1162 if Value <> FTableName then
1163 begin
1164 ResetSQLStatements;
1165 FRegenerateSQL := True;
1166 FTableName := Value;
1167 IndexName := '';
1168 IndexFieldNames := '';
1169 FPrimaryIndexFields := '';
1170 DataEvent(dePropertyChange, 0);
1171 end;
1172 end
1173 else if Value <> FTableName then
1174 FTableName := Value;
1175 end;
1176
1177 function TIBTable.GetIndexField(Index: Integer): TField;
1178 var
1179 I, Count: Integer;
1180 FieldNames, FieldName: String;
1181 begin
1182 Result := nil;
1183 FieldName := '';
1184 FieldNames := IndexFieldNames;
1185 if FieldNames = '' then
1186 begin
1187 for I := 0 to IndexDefs.Count - 1 do
1188 if (IndexDefs[i].Name = FIndexName) then
1189 begin
1190 FieldNames := IndexDefs[i].Fields;
1191 break;
1192 end;
1193 end;
1194 for I := 0 to Index do
1195 begin
1196 Count := Pos(';', FieldNames); {mbcs OK}
1197 if Count = 0 then
1198 FieldName := FieldNames
1199 else begin
1200 FieldName := Copy(FieldNames, 0, Count - 1);
1201 System.Delete(FieldNames, 1, Count);
1202 end;
1203 end;
1204 if FieldName <> '' then
1205 Result := FieldByName(FieldName)
1206 else
1207 IBError(ibxeIndexFieldMissing, [nil]);
1208 end;
1209
1210
1211 procedure TIBTable.SetIndexField(Index: Integer; Value: TField);
1212 begin
1213 GetIndexField(Index).Assign(Value);
1214 end;
1215
1216 function TIBTable.GetIndexFieldCount: Integer;
1217 var
1218 I, Index: Integer;
1219 FieldNames: String;
1220 done: Boolean;
1221 begin
1222 FieldNames := IndexFieldNames;
1223 if FieldNames = '' then
1224 begin
1225 for I := 0 to IndexDefs.Count - 1 do
1226 if (IndexDefs[i].Name = FIndexName) then
1227 begin
1228 FieldNames := IndexDefs[i].Fields;
1229 break;
1230 end;
1231 end;
1232 if FieldNames = '' then
1233 Result := 0
1234 else
1235 begin
1236 done := False;
1237 Result := 1;
1238 while not done do
1239 begin
1240 Index := Pos(';', FieldNames); {mbcs ok}
1241 if Index <> 0 then
1242 begin
1243 System.Delete(FieldNames, 1, Index);
1244 Inc(Result);
1245 end else
1246 done := True;
1247 end;
1248 end;
1249 end;
1250
1251 function TIBTable.GetTableNames: TStrings;
1252 begin
1253 FNameList.clear;
1254 GetTableNamesFromServer;
1255 Result := FNameList;
1256 end;
1257
1258 procedure TIBTable.GetTableNamesFromServer;
1259 var
1260 Query : TIBSQL;
1261 begin
1262 if not (csReading in ComponentState) then begin
1263 ActivateConnection;
1264 Database.InternalTransaction.StartTransaction;
1265 Query := TIBSQL.Create(self);
1266 try
1267 Query.GoToFirstRecordOnExecute := False;
1268 Query.Database := DataBase;
1269 Query.Transaction := Database.InternalTransaction;
1270 if (TableTypes * [ttSystem, ttView] = [ttSystem, ttView]) then
1271 Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' {do not localize}
1272 else if ttSystem in TableTypes then
1273 Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1274 ' where RDB$VIEW_BLR is NULL' {do not localize}
1275 else if ttView in TableTypes then
1276 Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1277 ' where RDB$SYSTEM_FLAG = 0' {do not localize}
1278 else
1279 Query.SQL.Text := 'Select RDB$RELATION_NAME from RDB$RELATIONS' + {do not localize}
1280 ' where RDB$VIEW_BLR is NULL and RDB$SYSTEM_FLAG = 0'; {do not localize}
1281 Query.Prepare;
1282 Query.ExecQuery;
1283 while (not Query.EOF) and Query.Next do
1284 FNameList.Add (TrimRight(Query.Fields[0].AsString));
1285 finally
1286 Query.Free;
1287 Database.InternalTransaction.Commit;
1288 end;
1289 end;
1290 end;
1291
1292 procedure TIBTable.SwitchToIndex();
1293 begin
1294 FSwitchingIndex := True;
1295 InternalTableRefresh;
1296 FSwitchingIndex := False;
1297 end;
1298
1299 procedure TIBTable.InternalTableRefresh();
1300 var
1301 DBKey: TIBDBKey;
1302 begin
1303 CheckActive;
1304 DBKey := CurrentDBKey;
1305 FRegenerateSQL := True;
1306 Reopen;
1307 if DBKey.DBKey[0] <> 0 then
1308 InternalGotoDBKey(DBKey);
1309 end;
1310
1311 procedure TIBTable.GenerateSQL;
1312 var
1313 i: Integer;
1314 SQL: TStrings;
1315 OrderByStr: string;
1316 bWhereClausePresent: Boolean;
1317 fn: string;
1318 aField: TFieldDef;
1319 begin
1320 bWhereClausePresent := False;
1321 Database.CheckActive;
1322 Transaction.CheckInTransaction;
1323 if IndexDefs.Updated = False then
1324 IndexDefs.Update;
1325 if IndexFieldNames <> '' then
1326 OrderByStr := FormatFieldsList(IndexFieldNames)
1327 else if IndexName <> '' then
1328 OrderByStr := FormatFieldsList(IndexDefs[IndexDefs.Indexof (IndexName)].Fields)
1329 else if FDefaultIndex and (FPrimaryIndexFields <> '') then
1330 OrderByStr := FormatFieldsList(FPrimaryIndexFields);
1331 SQL := TStringList.Create;
1332 SQL.Text := 'select ' + {do not localize}
1333 QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1334 + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1335 + QuoteIdentifier(DataBase.SQLDialect, FTableName);
1336 if Filtered and (Filter <> '') then
1337 begin
1338 SQL.Text := SQL.Text + ' where ' + Filter; {do not localize}
1339 bWhereClausePresent := True;
1340 end;
1341 if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and (MasterFields <> '') then
1342 begin
1343 if bWhereClausePresent then
1344 SQL.Text := SQL.Text + ' AND ' {do not localize}
1345 else
1346 SQL.Text := SQL.Text + ' WHERE '; {do not localize}
1347 ExtractLinkfields;
1348 if FDetailFieldsList.Count < FMasterFieldsList.Count then
1349 IBError(ibxeUnknownError, [nil]);
1350 for i := 0 to FMasterFieldsList.Count - 1 do
1351 begin
1352 if i > 0 then
1353 SQL.Text := SQL.Text + 'AND ';
1354 aField := FieldDefs.Find(FDetailFieldsList.Strings[i]);
1355 if assigned(aField) then
1356 fn := GetDBAliasName(aField.FieldNo)
1357 else
1358 fn := FDetailFieldsList.Strings[i]; {something wrong if we get here - but should word}
1359 SQL.Text := SQL.Text +
1360 QuoteIdentifier(DataBase.SQLDialect, fn) + ' = :' + FMasterFieldsList.Strings[i];
1361 end;
1362 end;
1363 if OrderByStr <> '' then
1364 SQL.Text := SQL.Text + ' order by ' + OrderByStr; {do not localize}
1365 SelectSQL.Assign(SQL);
1366 RefreshSQL.Text := 'select ' + {do not localize}
1367 QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1368 + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1369 + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1370 ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
1371 WhereDBKeyRefreshSQL.Assign(RefreshSQL);
1372 InternalPrepare;
1373 SQL.Free;
1374 end;
1375
1376 procedure TIBTable.GenerateUpdateSQL;
1377 var
1378 InsertFieldList, InsertParamList, UpdateFieldList: string;
1379 WherePrimaryFieldList, WhereAllFieldList,
1380 InsertReturningFieldList, UpdateReturningFieldList: string;
1381
1382 procedure GenerateFieldLists;
1383 var
1384 I: Integer;
1385 AllowReturningClause: boolean;
1386 begin
1387 {Is database Firebird 2.1 or later?}
1388 AllowReturningClause := (DatabaseInfo.ODSMajorVersion > 11) or
1389 ((DatabaseInfo.ODSMajorVersion = 11) and (DatabaseInfo.ODSMinorVersion >= 1));
1390 for I := 0 to FieldDefs.Count - 1 do begin
1391 with TIBFieldDef(FieldDefs[I]) do begin
1392 if AllowReturningClause then
1393 begin
1394 if (faReadOnly in Attributes) or IdentityColumn then
1395 begin
1396 if InsertReturningFieldList <> '' then
1397 InsertReturningFieldList := InsertReturningFieldList + ', ' +
1398 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1399 else
1400 InsertReturningFieldList := ' RETURNING ' +
1401 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1402 end;
1403 if (faReadOnly in Attributes) then
1404 begin
1405 if UpdateReturningFieldList <> '' then
1406 UpdateReturningFieldList := UpdateReturningFieldList + ', ' +
1407 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1408 else
1409 UpdateReturningFieldList := ' RETURNING ' +
1410 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo))
1411 end;
1412 end;
1413 if not (InternalCalcField or (faReadOnly in Attributes) or
1414 (DataType = ftUnknown)) then
1415 begin
1416 if not IdentityColumn then
1417 begin
1418 if ( InsertFieldList <> '' ) then begin
1419 InsertFieldList := InsertFieldList + ', ';
1420 InsertParamList := InsertParamList + ', ';
1421 end;
1422 InsertFieldList := InsertFieldList +
1423 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo));
1424 InsertParamList := InsertParamList + ':' + Name;
1425 end;
1426 if (UpdateFieldList <> '') then begin
1427 UpdateFieldList := UpdateFieldList + ', ';
1428 if (DataType <> ftBlob) and (DataType <>ftMemo) then
1429 WhereAllFieldList := WhereAllFieldList + ' AND ';
1430 end;
1431 UpdateFieldList := UpdateFieldList +
1432 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo)) +
1433 ' = :' + Name;
1434 if (DataType <> ftBlob) and (DataType <>ftMemo) then
1435 WhereAllFieldList := WhereAllFieldList +
1436 QuoteIdentifier(DataBase.SQLDialect, GetDBAliasName(FieldNo)) + ' = :' + Name;
1437 end;
1438 end;
1439 end;
1440 end;
1441
1442 procedure GenerateWherePrimaryFieldList;
1443 var
1444 i: Integer;
1445 tmp, fn: String;
1446 aField: TFieldDef;
1447 begin
1448 i := 1;
1449 while i <= Length(FPrimaryIndexFields) do
1450 begin
1451 tmp := ExtractFieldName(FPrimaryIndexFields, i);
1452 aField := FieldDefs.Find(tmp);
1453 if assigned(aField) then
1454 fn := GetDBAliasName(aField.FieldNo)
1455 else
1456 fn := tmp; {something wrong if we get here - but will work in most cases}
1457 tmp :=
1458 QuoteIdentifier(DataBase.SQLDialect, fn) + ' = :' +
1459 QuoteIdentifier(DataBase.SQLDialect, tmp);{do not localize}
1460 if WherePrimaryFieldList <> '' then
1461 WherePrimaryFieldList :=
1462 WherePrimaryFieldList + ' AND ' + tmp
1463 else
1464 WherePrimaryFieldList := tmp;
1465 end;
1466 end;
1467
1468 begin
1469 if InternalGetUpdatable = False then
1470 FReadOnly := True
1471 else
1472 begin
1473 DeleteSQL.Text := 'delete from ' + {do not localize}
1474 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1475 ' where RDB$DB_KEY = ' + ':IBX_INTERNAL_DBKEY'; {do not localize}
1476 GenerateFieldLists;
1477 InsertSQL.Text := 'insert into ' + {do not localize}
1478 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1479 ' (' + InsertFieldList + {do not localize}
1480 ') values (' + InsertParamList + ')' + InsertReturningFieldList; {do not localize}
1481 ModifySQL.Text := 'update ' +
1482 QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1483 ' set ' + UpdateFieldList + {do not localize}
1484 ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY' + UpdateReturningFieldList; {do not localize}
1485 WhereAllRefreshSQL.Text := 'select ' + {do not localize}
1486 QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, '
1487 + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1488 + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1489 ' where ' + WhereAllFieldList ; {do not localize}
1490 if FPrimaryIndexFields <> '' then
1491 begin
1492 GenerateWherePrimaryFieldList;
1493 WherePrimaryRefreshSQL.Text := 'select ' + {do not localize}
1494 QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
1495 + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
1496 + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
1497 ' where ' + WherePrimaryFieldList; {do not localize}
1498 end;
1499 try
1500 InternalPrepare;
1501 except
1502 FReadonly := True;
1503 end;
1504 end;
1505 end;
1506
1507 procedure TIBTable.ResetSQLStatements;
1508 begin
1509 SelectSQL.Text := '';
1510 DeleteSQL.Text := '';
1511 InsertSQL.Text := '';
1512 ModifySQL.Text := '';
1513 RefreshSQL.Text := '';
1514 end;
1515
1516 procedure TIBTable.SetTableTypes(
1517 const Value: TIBTableTypes);
1518 begin
1519 FTableTypes := Value;
1520 end;
1521
1522 function TIBTable.InternalGotoDBKey(DBKey: TIBDBKey): Boolean;
1523
1524 function DBKeyCompare (DBKey1, DBKey2: TIBDBKey): Boolean;
1525 var
1526 I: Integer;
1527 begin
1528 for I := 0 to 7 do
1529 if (DBKey1.DBKey[i] <> DBKey2.DBKey[i]) then begin
1530 result := False;
1531 exit;
1532 end;
1533 result := True;
1534 end;
1535 begin
1536 CheckActive;
1537 DisableControls;
1538 try
1539 result := False;
1540 First;
1541 while ((not result) and (not EOF)) do begin
1542 if (DBKeyCompare (DBKey, PRecordData(GetActiveBuf)^.rdDBKey)) then
1543 result := True
1544 else
1545 Next;
1546 end;
1547 if not result then
1548 First
1549 else
1550 CursorPosChanged;
1551 finally
1552 EnableControls;
1553 end;
1554 end;
1555
1556 function TIBTable.GetCurrentDBKey: TIBDBKey;
1557 var
1558 Buf: pChar;
1559 begin
1560 CheckActive;
1561 buf := GetActiveBuf;
1562 if Buf <> nil then
1563 Result := PRecordData(Buf)^.rdDBKey
1564 else
1565 Result.DBKey[0] := 0;
1566 end;
1567
1568 procedure TIBTable.Reopen;
1569 begin
1570 DisableControls;
1571 try
1572 if Active then
1573 begin
1574 SetState(dsInactive);
1575 CloseCursor;
1576 OpenCursor(false);
1577 SetState(dsBrowse);
1578 end;
1579 finally
1580 EnableControls;
1581 end;
1582 end;
1583
1584 end.