ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 44829 byte(s)
Log Message:
Committing updates for Release R2-0-0

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