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