ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 27
Committed: Tue Apr 14 13:10:23 2015 UTC (9 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 46317 byte(s)
Log Message:
Committing updates for Release R1-2-3

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