ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBTable.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 48097 byte(s)
Log Message:
Release 2.3.2 committed

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