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