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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines