ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
(Generate patch)
# Line 1 | Line 1
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.
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.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines