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