ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
Revision: 5
Committed: Fri Feb 18 16:26:16 2011 UTC (13 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 47474 byte(s)
Log Message:
Committing updates for Release pre-release

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