ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBTable.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBTable.pas (file contents):
Revision 32 by tony, Tue Apr 14 13:10:23 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines