ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBTable.pas
Revision: 221
Committed: Mon Mar 19 09:48:37 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 48351 byte(s)
Log Message:
Fixes merged

File Contents

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