trunk/design/IBSystemTables.pas

unit IBSystemTables; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IBSQL, IBDatabase;

type

  { TIBSystemTables }

  TIBSystemTables = class
  private
    FGetTableNames: TIBSQL;
    FGetFieldNames: TIBSQL;
    FGetPrimaryKeys: TIBSQL;
    FTestSQL: TIBSQL;
    FTableAndColumnSQL: TIBSQL;
    FGetGeneratorsSQL: TIBSQL;
    function GetSQLType(SQLType: TIBSQLTypes): string;
    procedure AddWhereClause(TableName: string; QuotedStrings: boolean; SQL: TStrings);
 public
    constructor Create;
    destructor Destroy; override;
    procedure SelectDatabase(Database: TIBDatabase; Transaction: TIBTransaction);
    procedure GetTableNames(TableNames: TStrings);
    procedure GetFieldNames(TableName: string; FieldNames: TStrings;
              IncludePrimaryKeys:boolean=true);
    procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
    procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
                Columns: TStrings);
    procedure GetGenerators(GeneratorNames: TStrings);
    procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean; FieldNames, SQL: TStrings);
    procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
    procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
    procedure TestSQL(SQL: string);
  end;

implementation

uses IB, Dialogs;

{ TIBSystemTables }

const
  sqlGETTABLES = 'Select Trim(RDB$RELATION_NAME) as TableName From RDB$RELATIONS ' +
                 'Where RDB$SYSTEM_FLAG = 0 ' +
                 'Order by 1';

  sqlGETFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
                 'Where RDB$RELATION_NAME = :TableName ' +
                 'order by RDB$FIELD_POSITION asc ';

  sqlGETPRIMARYKEYS = 'Select Trim(S.RDB$FIELD_NAME) as ColumnName From '+
                      '(Select RDB$INDEX_NAME,RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS Order by RDB$FIELD_POSITION ASC) S ' +
                      'JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME ' +
                      'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and RDB$RELATION_NAME = :TableName';

  sqlUPDATEFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
                    'Where RF.RDB$RELATION_NAME = :TableName  and RDB$FIELD_NAME not in ' +
                    '(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
                     'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)' +
                     'order by 1 asc ';

  sqlGETGENERATORNAMES = 'Select RDB$GENERATOR_NAME FROM RDB$GENERATORS '+
                         'Where RDB$SYSTEM_FLAG = 0 '+
                         'Order by 1 asc';

function TIBSystemTables.GetSQLType(SQLType: TIBSQLTypes): string;
begin
  case SQLType of
  SQLUnknown:              Result := 'Unknown';
  SQLSelect:               Result := 'Select';
  SQLInsert:               Result := 'Insert';
  SQLUpdate:               Result := 'Update';
  SQLDelete:               Result := 'Delete';
  SQLDDL:                  Result := 'DDL';
  SQLGetSegment:           Result := 'GetSegment';
  SQLPutSegment:           Result := 'PutSegment';
  SQLExecProcedure:        Result := 'Execute Procedure';
  SQLStartTransaction:     Result := 'StartTransaction';
  SQLCommit:               Result := 'Commit';
  SQLRollback:             Result := 'Rollback';
  SQLSelectForUpdate:      Result := 'Select for Update';
  SQLSetGenerator:         Result := 'Set Generator';
  end;
end;

procedure TIBSystemTables.AddWhereClause(TableName: string;
          QuotedStrings: boolean; SQL: TStrings);
var WhereClause: string;
    Separator: string;
    Count: integer;
begin
  if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
    not assigned(FGetPrimaryKeys.Transaction) then
    Exit;
  Count := 0;
  WhereClause := 'Where';
  Separator := ' A.';
  FGetPrimaryKeys.Prepare;
  FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
  FGetPrimaryKeys.ExecQuery;
  try
    while not FGetPrimaryKeys.EOF do
    begin
      Inc(Count);
      if QuotedStrings then
        WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + '" = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString
      else
        WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + ' = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
      Separator := ' AND A.';
      FGetPrimaryKeys.Next
    end;
  finally
    FGetPrimaryKeys.Close
  end;
  if Count > 0 then
    SQL.Add(WhereClause)
end;

constructor TIBSystemTables.Create;
begin
  FGetTableNames := TIBSQL.Create(nil);
  FGetFieldNames := TIBSQL.Create(nil);
  FGetPrimaryKeys := TIBSQL.Create(nil);
  FTestSQL := TIBSQL.Create(nil);
  FTableAndColumnSQL := TIBSQL.Create(nil);
  FGetGeneratorsSQL := TIBSQL.Create(nil);
end;

destructor TIBSystemTables.Destroy;
begin
  if assigned(FGetFieldNames) then FGetFieldNames.Free;
  if assigned(FGetTableNames) then FGetTableNames.Free;
  if assigned(FTestSQL) then FTestSQL.Free;
  if assigned(FGetPrimaryKeys) then FGetPrimaryKeys.Free;
  if assigned(FTableAndColumnSQL) then FTableAndColumnSQL.Free;
  if assigned(FGetGeneratorsSQL) then FGetGeneratorsSQL.Free;
  inherited Destroy;
end;

procedure TIBSystemTables.SelectDatabase(Database: TIBDatabase;
  Transaction: TIBTransaction);
begin
    FGetTableNames.Database := Database;
    FGetTableNames.Transaction := Transaction;
    FGetTableNames.SQL.Text := sqlGETTABLES;
    FGetFieldNames.Database := Database;
    FGetFieldNames.Transaction := Transaction;
    FGetFieldNames.SQL.Text := sqlGETFIELDS;
    FTestSQL.Database := Database;
    FTestSQL.Transaction := Transaction;
    FGetPrimaryKeys.Database := Database;
    FGetPrimaryKeys.Transaction := Transaction;
    FGetPrimaryKeys.SQL.Text := sqlGETPRIMARYKEYS;
    FTableAndColumnSQL.Database := Database;
    FTableAndColumnSQL.Transaction := Transaction;
    FGetGeneratorsSQL.Database := Database;
    FGetGeneratorsSQL.Transaction := Transaction;
    FGetGeneratorsSQL.SQL.Text := sqlGETGENERATORNAMES;
end;

procedure TIBSystemTables.GetTableNames(TableNames: TStrings);
begin
  if not assigned(FGetTableNames.Database) or not FGetTableNames.Database.Connected or
    not assigned(FGetTableNames.Transaction) then
    Exit;
  with FGetTableNames.Transaction do
    if not InTransaction then StartTransaction;
  TableNames.Clear;
  FGetTableNames.ExecQuery;
  try
    while not FGetTableNames.EOF do
    begin
      TableNames.Add(FGetTableNames.FieldByName('TableName').AsString);
      FGetTableNames.Next
    end;
  finally
    FGetTableNames.Close
  end;
end;

procedure TIBSystemTables.GetFieldNames(TableName: string; FieldNames: TStrings;
              IncludePrimaryKeys:boolean=true);
begin
  if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
    not assigned(FGetFieldNames.Transaction) then
    Exit;
  with FGetFieldNames.Transaction do
    if not InTransaction then StartTransaction;
  FieldNames.Clear;
  if IncludePrimaryKeys then
      FGetFieldNames.SQL.Text := sqlGETFIELDS
  else
      FGetFieldNames.SQL.Text := sqlUPDATEFIELDS;
  FGetFieldNames.Prepare;
  FGetFieldNames.ParamByName('TableName').AsString := TableName;
  FGetFieldNames.ExecQuery;
  try
    while not FGetFieldNames.EOF do
    begin
      FieldNames.Add(FGetFieldNames.FieldByName('ColumnName').AsString);
      FGetFieldNames.Next
    end;
  finally
    FGetFieldNames.Close
  end;
end;

procedure TIBSystemTables.GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
begin
  if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
    not assigned(FGetPrimaryKeys.Transaction) then
    Exit;
  with FGetPrimaryKeys.Transaction do
    if not InTransaction then StartTransaction;
  PrimaryKeys.Clear;
  FGetPrimaryKeys.Prepare;
  FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
  FGetPrimaryKeys.ExecQuery;
  try
    while not FGetPrimaryKeys.EOF do
    begin
      PrimaryKeys.Add(FGetPrimaryKeys.FieldByName('ColumnName').AsString);
      FGetPrimaryKeys.Next
    end;
  finally
    FGetPrimaryKeys.Close
  end;
end;

procedure TIBSystemTables.GetTableAndColumns(SelectSQL: string;
  var FirstTableName: string; Columns: TStrings);
var I: integer;
begin
  if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
    not assigned(FTableAndColumnSQL.Transaction) then
    Exit;
  with FTableAndColumnSQL.Transaction do
    if not InTransaction then StartTransaction;
  FTableAndColumnSQL.SQL.Text := SelectSQL;
  try
    FTableAndColumnSQL.Prepare;
    FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname);
    if assigned(Columns) then
    begin
      Columns.Clear;
      for I := 0 to FTableAndColumnSQL.Current.Count - 1 do
        Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name)
    end;
  except on E:EIBError do
      ShowMessage(E.Message);
  end;
end;

procedure TIBSystemTables.GetGenerators(GeneratorNames: TStrings);
begin
  if not assigned(FGetGeneratorsSQL.Database) or not FGetGeneratorsSQL.Database.Connected or
    not assigned(FGetGeneratorsSQL.Transaction) then
    Exit;
  GeneratorNames.Clear;
  with FGetGeneratorsSQL do
  begin
    with Transaction do
      if not InTransaction then StartTransaction;
    ExecQuery;
    try
      while not EOF do
      begin
        GeneratorNames.Add(FieldByName('RDB$GENERATOR_NAME').AsString);
        Next;
      end;
    finally
      Close
    end;
  end;

end;

procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
var SelectSQL: string;
    Separator : string;
begin
  if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
    not assigned(FGetFieldNames.Transaction) then
    Exit;
  SelectSQL := 'Select';
  Separator := ' A.';
  FGetFieldNames.SQL.Text := sqlGETFIELDS;
  FGetFieldNames.Prepare;
  FGetFieldNames.ParamByName('TableName').AsString := TableName;
  FGetFieldNames.ExecQuery;
  try
    while not FGetFieldNames.EOF do
    begin
      if QuotedStrings then
        SelectSQL := SelectSQL + Separator + '"' + FGetFieldNames.FieldByName('ColumnName').AsString + '"'
      else
        SelectSQL := SelectSQL + Separator + FGetFieldNames.FieldByName('ColumnName').AsString;
      Separator := ', A.';
      FGetFieldNames.Next
    end;
  finally
    FGetFieldNames.Close
  end;
  SelectSQL := SelectSQL + ' From ' + TableName + ' A';
  SQL.Add(SelectSQL);
end;

procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
begin
  GenerateSelectSQL(TableName,QuotedStrings,SQL);
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.GenerateInsertSQL(TableName: string;
  QuotedStrings: boolean; FieldNames,SQL: TStrings);
var InsertSQL: string;
    Separator: string;
    I: integer;
begin
  SQL.Clear;
  InsertSQL := 'Insert Into ' + TableName + '(';
  Separator := '';
  for I := 0 to FieldNames.Count - 1 do
    begin
      if QuotedStrings then
         InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
      else
         InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
      Separator := ',';
    end;
  InsertSQL := InsertSQL + ')';
  SQL.Add(InsertSQL);
  InsertSQL := 'Values(';
  Separator := ':';
  for I := 0 to FieldNames.Count - 1 do
    begin
       InsertSQL := InsertSQL + Separator +  FieldNames[I] ;
       Separator := ',:';
    end;
  InsertSQL := InsertSQL + ')';
  SQL.Add(InsertSQL);
end;

procedure TIBSystemTables.GenerateModifySQL(TableName: string; QuotedStrings: boolean;
          FieldNames,SQL: TStrings);
var UpdateSQL: string;
    Separator: string;
    I: integer;
begin
  SQL.Clear;
  Separator := #$0d#$0a'  A.';
  UpdateSQL := 'Update ' + TableName + ' A Set ';
  for I := 0 to FieldNames.Count - 1 do
    begin
      if QuotedStrings then
        UpdateSQL := UpdateSQL + Separator + '"' + FieldNames[I] + '" = :' + FieldNames[I]
      else
        UpdateSQL := UpdateSQL + Separator + FieldNames[I] + ' = :' + FieldNames[I];
      Separator := ','#$0d#$0a'  A.';
    end;
  SQL.Add(UpdateSQL);
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
begin
  SQL.Clear;
  SQL.Add('Delete From ' + TableName + ' A');
  AddWhereClause(TableName,QuotedStrings,SQL)
end;

procedure TIBSystemTables.TestSQL(SQL: string);
begin
  if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
    not assigned(FTestSQL.Transaction) then
    Exit;
  FTestSQL.SQL.Text := SQL;
  try
    FTestSQL.Prepare;
    ShowMessage('SQL '+ GetSQLType(FTestSQL.SQLType) + ' Statement Looks OK');
  except on E:EIBError do
      ShowMessage(E.Message);
  end;
end;

end.

Revision:	5
Committed:	Fri Feb 18 16:26:16 2011 UTC (13 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	13298 byte(s)
Log Message:	Committing updates for Release pre-release
#	User	Rev	Content
1	tony	5	unit IBSystemTables;
2
3			{$mode objfpc}{$H+}
4
5			interface
6
7			uses
8			Classes, SysUtils, IBSQL, IBDatabase;
9
10			type
11
12			{ TIBSystemTables }
13
14			TIBSystemTables = class
15			private
16			FGetTableNames: TIBSQL;
17			FGetFieldNames: TIBSQL;
18			FGetPrimaryKeys: TIBSQL;
19			FTestSQL: TIBSQL;
20			FTableAndColumnSQL: TIBSQL;
21			FGetGeneratorsSQL: TIBSQL;
22			function GetSQLType(SQLType: TIBSQLTypes): string;
23			procedure AddWhereClause(TableName: string; QuotedStrings: boolean; SQL: TStrings);
24			public
25			constructor Create;
26			destructor Destroy; override;
27			procedure SelectDatabase(Database: TIBDatabase; Transaction: TIBTransaction);
28			procedure GetTableNames(TableNames: TStrings);
29			procedure GetFieldNames(TableName: string; FieldNames: TStrings;
30			IncludePrimaryKeys:boolean=true);
31			procedure GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
32			procedure GetTableAndColumns(SelectSQL: string; var FirstTableName: string;
33			Columns: TStrings);
34			procedure GetGenerators(GeneratorNames: TStrings);
35			procedure GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
36			procedure GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
37			procedure GenerateInsertSQL(TableName: string; QuotedStrings: boolean; FieldNames, SQL: TStrings);
38			procedure GenerateModifySQL(TableName: string; QuotedStrings: boolean; FieldNames,SQL: TStrings);
39			procedure GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
40			procedure TestSQL(SQL: string);
41			end;
42
43			implementation
44
45			uses IB, Dialogs;
46
47			{ TIBSystemTables }
48
49			const
50			sqlGETTABLES = 'Select Trim(RDB$RELATION_NAME) as TableName From RDB$RELATIONS ' +
51			'Where RDB$SYSTEM_FLAG = 0 ' +
52			'Order by 1';
53
54			sqlGETFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS ' +
55			'Where RDB$RELATION_NAME = :TableName ' +
56			'order by RDB$FIELD_POSITION asc ';
57
58			sqlGETPRIMARYKEYS = 'Select Trim(S.RDB$FIELD_NAME) as ColumnName From '+
59			'(Select RDB$INDEX_NAME,RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS Order by RDB$FIELD_POSITION ASC) S ' +
60			'JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME ' +
61			'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and RDB$RELATION_NAME = :TableName';
62
63			sqlUPDATEFIELDS = 'Select Trim(RDB$FIELD_NAME) as ColumnName FROM RDB$RELATION_FIELDS RF ' +
64			'Where RF.RDB$RELATION_NAME = :TableName and RDB$FIELD_NAME not in ' +
65			'(Select RDB$FIELD_NAME FROM RDB$INDEX_SEGMENTS S JOIN RDB$RELATION_CONSTRAINTS C On C.RDB$INDEX_NAME = S.RDB$INDEX_NAME '+
66			'Where C.RDB$CONSTRAINT_TYPE = ''PRIMARY KEY'' and C.RDB$RELATION_NAME = RF.RDB$RELATION_NAME)' +
67			'order by 1 asc ';
68
69			sqlGETGENERATORNAMES = 'Select RDB$GENERATOR_NAME FROM RDB$GENERATORS '+
70			'Where RDB$SYSTEM_FLAG = 0 '+
71			'Order by 1 asc';
72
73			function TIBSystemTables.GetSQLType(SQLType: TIBSQLTypes): string;
74			begin
75			case SQLType of
76			SQLUnknown: Result := 'Unknown';
77			SQLSelect: Result := 'Select';
78			SQLInsert: Result := 'Insert';
79			SQLUpdate: Result := 'Update';
80			SQLDelete: Result := 'Delete';
81			SQLDDL: Result := 'DDL';
82			SQLGetSegment: Result := 'GetSegment';
83			SQLPutSegment: Result := 'PutSegment';
84			SQLExecProcedure: Result := 'Execute Procedure';
85			SQLStartTransaction: Result := 'StartTransaction';
86			SQLCommit: Result := 'Commit';
87			SQLRollback: Result := 'Rollback';
88			SQLSelectForUpdate: Result := 'Select for Update';
89			SQLSetGenerator: Result := 'Set Generator';
90			end;
91			end;
92
93			procedure TIBSystemTables.AddWhereClause(TableName: string;
94			QuotedStrings: boolean; SQL: TStrings);
95			var WhereClause: string;
96			Separator: string;
97			Count: integer;
98			begin
99			if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
100			not assigned(FGetPrimaryKeys.Transaction) then
101			Exit;
102			Count := 0;
103			WhereClause := 'Where';
104			Separator := ' A.';
105			FGetPrimaryKeys.Prepare;
106			FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
107			FGetPrimaryKeys.ExecQuery;
108			try
109			while not FGetPrimaryKeys.EOF do
110			begin
111			Inc(Count);
112			if QuotedStrings then
113			WhereClause := WhereClause + Separator + '"' + FGetPrimaryKeys.FieldByName('ColumnName').AsString + '" = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString
114			else
115			WhereClause := WhereClause + Separator + FGetPrimaryKeys.FieldByName('ColumnName').AsString + ' = :' + FGetPrimaryKeys.FieldByName('ColumnName').AsString;
116			Separator := ' AND A.';
117			FGetPrimaryKeys.Next
118			end;
119			finally
120			FGetPrimaryKeys.Close
121			end;
122			if Count > 0 then
123			SQL.Add(WhereClause)
124			end;
125
126			constructor TIBSystemTables.Create;
127			begin
128			FGetTableNames := TIBSQL.Create(nil);
129			FGetFieldNames := TIBSQL.Create(nil);
130			FGetPrimaryKeys := TIBSQL.Create(nil);
131			FTestSQL := TIBSQL.Create(nil);
132			FTableAndColumnSQL := TIBSQL.Create(nil);
133			FGetGeneratorsSQL := TIBSQL.Create(nil);
134			end;
135
136			destructor TIBSystemTables.Destroy;
137			begin
138			if assigned(FGetFieldNames) then FGetFieldNames.Free;
139			if assigned(FGetTableNames) then FGetTableNames.Free;
140			if assigned(FTestSQL) then FTestSQL.Free;
141			if assigned(FGetPrimaryKeys) then FGetPrimaryKeys.Free;
142			if assigned(FTableAndColumnSQL) then FTableAndColumnSQL.Free;
143			if assigned(FGetGeneratorsSQL) then FGetGeneratorsSQL.Free;
144			inherited Destroy;
145			end;
146
147			procedure TIBSystemTables.SelectDatabase(Database: TIBDatabase;
148			Transaction: TIBTransaction);
149			begin
150			FGetTableNames.Database := Database;
151			FGetTableNames.Transaction := Transaction;
152			FGetTableNames.SQL.Text := sqlGETTABLES;
153			FGetFieldNames.Database := Database;
154			FGetFieldNames.Transaction := Transaction;
155			FGetFieldNames.SQL.Text := sqlGETFIELDS;
156			FTestSQL.Database := Database;
157			FTestSQL.Transaction := Transaction;
158			FGetPrimaryKeys.Database := Database;
159			FGetPrimaryKeys.Transaction := Transaction;
160			FGetPrimaryKeys.SQL.Text := sqlGETPRIMARYKEYS;
161			FTableAndColumnSQL.Database := Database;
162			FTableAndColumnSQL.Transaction := Transaction;
163			FGetGeneratorsSQL.Database := Database;
164			FGetGeneratorsSQL.Transaction := Transaction;
165			FGetGeneratorsSQL.SQL.Text := sqlGETGENERATORNAMES;
166			end;
167
168			procedure TIBSystemTables.GetTableNames(TableNames: TStrings);
169			begin
170			if not assigned(FGetTableNames.Database) or not FGetTableNames.Database.Connected or
171			not assigned(FGetTableNames.Transaction) then
172			Exit;
173			with FGetTableNames.Transaction do
174			if not InTransaction then StartTransaction;
175			TableNames.Clear;
176			FGetTableNames.ExecQuery;
177			try
178			while not FGetTableNames.EOF do
179			begin
180			TableNames.Add(FGetTableNames.FieldByName('TableName').AsString);
181			FGetTableNames.Next
182			end;
183			finally
184			FGetTableNames.Close
185			end;
186			end;
187
188			procedure TIBSystemTables.GetFieldNames(TableName: string; FieldNames: TStrings;
189			IncludePrimaryKeys:boolean=true);
190			begin
191			if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
192			not assigned(FGetFieldNames.Transaction) then
193			Exit;
194			with FGetFieldNames.Transaction do
195			if not InTransaction then StartTransaction;
196			FieldNames.Clear;
197			if IncludePrimaryKeys then
198			FGetFieldNames.SQL.Text := sqlGETFIELDS
199			else
200			FGetFieldNames.SQL.Text := sqlUPDATEFIELDS;
201			FGetFieldNames.Prepare;
202			FGetFieldNames.ParamByName('TableName').AsString := TableName;
203			FGetFieldNames.ExecQuery;
204			try
205			while not FGetFieldNames.EOF do
206			begin
207			FieldNames.Add(FGetFieldNames.FieldByName('ColumnName').AsString);
208			FGetFieldNames.Next
209			end;
210			finally
211			FGetFieldNames.Close
212			end;
213			end;
214
215			procedure TIBSystemTables.GetPrimaryKeys(TableName: string; PrimaryKeys: TStrings);
216			begin
217			if not assigned(FGetPrimaryKeys.Database) or not FGetPrimaryKeys.Database.Connected or
218			not assigned(FGetPrimaryKeys.Transaction) then
219			Exit;
220			with FGetPrimaryKeys.Transaction do
221			if not InTransaction then StartTransaction;
222			PrimaryKeys.Clear;
223			FGetPrimaryKeys.Prepare;
224			FGetPrimaryKeys.ParamByName('TableName').AsString := TableName;
225			FGetPrimaryKeys.ExecQuery;
226			try
227			while not FGetPrimaryKeys.EOF do
228			begin
229			PrimaryKeys.Add(FGetPrimaryKeys.FieldByName('ColumnName').AsString);
230			FGetPrimaryKeys.Next
231			end;
232			finally
233			FGetPrimaryKeys.Close
234			end;
235			end;
236
237			procedure TIBSystemTables.GetTableAndColumns(SelectSQL: string;
238			var FirstTableName: string; Columns: TStrings);
239			var I: integer;
240			begin
241			if not assigned(FTableAndColumnSQL.Database) or not FTableAndColumnSQL.Database.Connected or
242			not assigned(FTableAndColumnSQL.Transaction) then
243			Exit;
244			with FTableAndColumnSQL.Transaction do
245			if not InTransaction then StartTransaction;
246			FTableAndColumnSQL.SQL.Text := SelectSQL;
247			try
248			FTableAndColumnSQL.Prepare;
249			FirstTableName := strpas(FTableAndColumnSQL.Current.Vars[0].Data^.relname);
250			if assigned(Columns) then
251			begin
252			Columns.Clear;
253			for I := 0 to FTableAndColumnSQL.Current.Count - 1 do
254			Columns.Add(FTableAndColumnSQL.Current.Vars[I].Name)
255			end;
256			except on E:EIBError do
257			ShowMessage(E.Message);
258			end;
259			end;
260
261			procedure TIBSystemTables.GetGenerators(GeneratorNames: TStrings);
262			begin
263			if not assigned(FGetGeneratorsSQL.Database) or not FGetGeneratorsSQL.Database.Connected or
264			not assigned(FGetGeneratorsSQL.Transaction) then
265			Exit;
266			GeneratorNames.Clear;
267			with FGetGeneratorsSQL do
268			begin
269			with Transaction do
270			if not InTransaction then StartTransaction;
271			ExecQuery;
272			try
273			while not EOF do
274			begin
275			GeneratorNames.Add(FieldByName('RDB$GENERATOR_NAME').AsString);
276			Next;
277			end;
278			finally
279			Close
280			end;
281			end;
282
283			end;
284
285			procedure TIBSystemTables.GenerateSelectSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
286			var SelectSQL: string;
287			Separator : string;
288			begin
289			if not assigned(FGetFieldNames.Database) or not FGetFieldNames.Database.Connected or
290			not assigned(FGetFieldNames.Transaction) then
291			Exit;
292			SelectSQL := 'Select';
293			Separator := ' A.';
294			FGetFieldNames.SQL.Text := sqlGETFIELDS;
295			FGetFieldNames.Prepare;
296			FGetFieldNames.ParamByName('TableName').AsString := TableName;
297			FGetFieldNames.ExecQuery;
298			try
299			while not FGetFieldNames.EOF do
300			begin
301			if QuotedStrings then
302			SelectSQL := SelectSQL + Separator + '"' + FGetFieldNames.FieldByName('ColumnName').AsString + '"'
303			else
304			SelectSQL := SelectSQL + Separator + FGetFieldNames.FieldByName('ColumnName').AsString;
305			Separator := ', A.';
306			FGetFieldNames.Next
307			end;
308			finally
309			FGetFieldNames.Close
310			end;
311			SelectSQL := SelectSQL + ' From ' + TableName + ' A';
312			SQL.Add(SelectSQL);
313			end;
314
315			procedure TIBSystemTables.GenerateRefreshSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
316			begin
317			GenerateSelectSQL(TableName,QuotedStrings,SQL);
318			AddWhereClause(TableName,QuotedStrings,SQL)
319			end;
320
321			procedure TIBSystemTables.GenerateInsertSQL(TableName: string;
322			QuotedStrings: boolean; FieldNames,SQL: TStrings);
323			var InsertSQL: string;
324			Separator: string;
325			I: integer;
326			begin
327			SQL.Clear;
328			InsertSQL := 'Insert Into ' + TableName + '(';
329			Separator := '';
330			for I := 0 to FieldNames.Count - 1 do
331			begin
332			if QuotedStrings then
333			InsertSQL := InsertSQL + Separator + '"' + FieldNames[I] + '"'
334			else
335			InsertSQL := InsertSQL + Separator + FieldNames[I] ;
336			Separator := ',';
337			end;
338			InsertSQL := InsertSQL + ')';
339			SQL.Add(InsertSQL);
340			InsertSQL := 'Values(';
341			Separator := ':';
342			for I := 0 to FieldNames.Count - 1 do
343			begin
344			InsertSQL := InsertSQL + Separator + FieldNames[I] ;
345			Separator := ',:';
346			end;
347			InsertSQL := InsertSQL + ')';
348			SQL.Add(InsertSQL);
349			end;
350
351			procedure TIBSystemTables.GenerateModifySQL(TableName: string; QuotedStrings: boolean;
352			FieldNames,SQL: TStrings);
353			var UpdateSQL: string;
354			Separator: string;
355			I: integer;
356			begin
357			SQL.Clear;
358			Separator := #$0d#$0a' A.';
359			UpdateSQL := 'Update ' + TableName + ' A Set ';
360			for I := 0 to FieldNames.Count - 1 do
361			begin
362			if QuotedStrings then
363			UpdateSQL := UpdateSQL + Separator + '"' + FieldNames[I] + '" = :' + FieldNames[I]
364			else
365			UpdateSQL := UpdateSQL + Separator + FieldNames[I] + ' = :' + FieldNames[I];
366			Separator := ','#$0d#$0a' A.';
367			end;
368			SQL.Add(UpdateSQL);
369			AddWhereClause(TableName,QuotedStrings,SQL)
370			end;
371
372			procedure TIBSystemTables.GenerateDeleteSQL(TableName: string; QuotedStrings: boolean; SQL: TStrings);
373			begin
374			SQL.Clear;
375			SQL.Add('Delete From ' + TableName + ' A');
376			AddWhereClause(TableName,QuotedStrings,SQL)
377			end;
378
379			procedure TIBSystemTables.TestSQL(SQL: string);
380			begin
381			if not assigned(FTestSQL.Database) or not FTestSQL.Database.Connected or
382			not assigned(FTestSQL.Transaction) then
383			Exit;
384			FTestSQL.SQL.Text := SQL;
385			try
386			FTestSQL.Prepare;
387			ShowMessage('SQL '+ GetSQLType(FTestSQL.SQLType) + ' Statement Looks OK');
388			except on E:EIBError do
389			ShowMessage(E.Message);
390			end;
391			end;
392
393			end.
394