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