ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 23
Committed: Fri Mar 13 10:26:52 2015 UTC (9 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 46283 byte(s)
Log Message:
Committing updates for Release R1-2-1

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