pfibdatainfo.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

     s:=DatabaseRepositories[Index];

   aTransaction:=TFIBTransaction.Create(nil);
   aTransaction.TimeoutAction  :=TACommit;
   aTransaction.DefaultDatabase:=DB;
   qry:=TFIBQuery.Create(nil);
   with qry do
   try
    ParamCheck:=True;
    Database:=DB;  Transaction:=aTransaction;
    SQL.Text:='select COUNT(RDB$RELATION_NAME)'#13#10+
                      'from RDB$RELATIONS where RDB$FLAGS = 1'#13#10+
                      'and RDB$RELATION_NAME=?RT';
    aTransaction.StartTransaction;
    case Kind of
      1: Params[0].asString:='FIB$FIELDS_INFO';
      2: Params[0].asString:='FIB$DATASETS_INFO';
      3: Params[0].asString:='FIB$ERROR_MESSAGES';
    end;

    ExecQuery;
    if Fields[0].asInteger>0 then
     s[Kind]:='1'
    else
     s[Kind]:='0';
    Close;

    if Index<0 then
     DatabaseRepositories.AddObject(s,DB)
    else
     DatabaseRepositories[Index]:=s;

    Result:=RepositaryIsRegistered=eTrue;
   finally
    aTransaction.Free;
    Free;
   end;
 finally
    LeaveCriticalSection(LockRepList);
 end;
end;

function ExistDRepositaryTable(DB:TFIBDatabase):boolean;
begin
 Result:=ExistRepositaryTable(DB,2)
end;

function ExistERepositaryTable(DB:TFIBDatabase):boolean;
begin
 Result:=ExistRepositaryTable(DB,3)
end;

function ExistBooleanDomain(DB:TFIBDatabase):boolean;
var
    Transaction:TFibTransaction;
    qry:TFIBQuery;
begin
 qry:=TFIBQuery.Create(nil);
 Transaction:=TFIBTransaction.Create(nil);
 try
  Transaction.DefaultDatabase:=DB;
  qry.Transaction:=Transaction;
  with qry,qry.SQL do
  begin
   ParamCheck:=False;
   Database:=DB;
   ParamCheck:=False;
   Transaction.StartTransaction;
   Text:=
       'Select Count(*) FROM RDB$FIELDS FLD'#13#10 +
       'WHERE FLD.RDB$FIELD_NAME = ''FIB$BOOLEAN''' ;
   ExecQuery;
   Result:=qry.Fields[0].asInteger<>0;
  end
 finally
  Transaction.Free;
  qry.Free;
 end;
end;

function ExistFRepositaryTable(DB:TFIBDatabase):boolean;
begin
 Result:=ExistRepositaryTable(DB,1)
end;

procedure   Update1RepositaryTable(Tr:TFIBTransaction);
var qry:TFIBQuery;
begin
 qry:=TFIBQuery.Create(nil);
 with qry,qry.SQL do
 try
  Database:=Tr.DefaultDatabase;  Transaction:=Tr;
  ParamCheck:=False;
  if not Tr.InTransaction then Tr.StartTransaction;
  try
   Text:='CREATE GENERATOR FIB$FIELD_INFO_VERSION';
   ExecQuery;
  except
  end;
  try
   Text:='ALTER TABLE FIB$FIELDS_INFO ADD DISPLAY_WIDTH INTEGER DEFAULT 0';
   ExecQuery;
  except
  end;
  try
   Text:='ALTER TABLE FIB$FIELDS_INFO ADD FIB$VERSION INTEGER';
   ExecQuery;
  except
  end;

  try
   Text:=
   'CREATE TRIGGER FIB$FIELDS_INFO_BI FOR FIB$FIELDS_INFO '+
   'ACTIVE BEFORE INSERT POSITION 0 as '+#13#10+
   'begin '+#13#10+
     'new.fib$version=gen_id(fib$field_info_version,1);'+#13#10+
   'end';
   ExecQuery;
  except
  end;
  try
   Text:=
   'CREATE TRIGGER FIB$FIELDS_INFO_BU FOR FIB$FIELDS_INFO '+
   'ACTIVE BEFORE UPDATE POSITION 0 as '+#13#10+
   'begin '+#13#10+
     'new.fib$version=gen_id(fib$field_info_version,1);'+#13#10+
   'end';
   ExecQuery;
  except
  end;
 finally
  Tr.CommitRetaining;
  Free
 end;
end;

procedure   Update2RepositaryTable(Tr:TFIBTransaction);
var qry:TFIBQuery;
begin
 qry:=TFIBQuery.Create(nil);
 with qry,qry.SQL do
 try
  Database:=Tr.DefaultDatabase;  Transaction:=Tr;
  ParamCheck:=False;
  if not ExistBooleanDomain(Transaction.DefaultDatabase) then
  begin
   Text:=
   'CREATE DOMAIN FIB$BOOLEAN AS SMALLINT DEFAULT 1 NOT NULL CHECK (VALUE IN (0,1))';
   ExecQuery;
  end;
  try
   Text:='ALTER TABLE FIB$DATASETS_INFO ADD UPDATE_TABLE_NAME  VARCHAR(68)';
   ExecQuery;
  except
  end;
  try
   Text:='ALTER TABLE FIB$DATASETS_INFO ADD UPDATE_ONLY_MODIFIED_FIELDS  FIB$BOOLEAN NOT NULL';
   ExecQuery;
  except
  end;
  try
   Text:='ALTER TABLE FIB$DATASETS_INFO ADD CONDITIONS  BLOB sub_type 1 segment size 80';
   ExecQuery;
  except
  end;

  if not Tr.InTransaction then Tr.StartTransaction;
  try
   Text:='CREATE GENERATOR FIB$FIELD_INFO_VERSION';
   ExecQuery;
  except
  end;

  try
   Text:='ALTER TABLE FIB$DATASETS_INFO ADD fib$version  INTEGER';
   ExecQuery;
   Text:=
   'CREATE TRIGGER FIB$DATASETS_INFO_BI FOR FIB$DATASETS_INFO '+
   'ACTIVE BEFORE INSERT POSITION 0 as '+#13#10+
   'begin'#13#10+
     'new.fib$version=gen_id(fib$field_info_version,1);'#13#10+
   'end';
   ExecQuery;

   Text:=
   'CREATE TRIGGER FIB$DATASETS_INFO_BU FOR FIB$DATASETS_INFO '+
   'ACTIVE BEFORE UPDATE POSITION 0 as '+#13#10+
   'begin'#13#10+
     'new.fib$version=gen_id(fib$field_info_version,1);'#13#10+
   'end';
   ExecQuery;
   
  except
  end;

 finally
   Tr.CommitRetaining;
   qry.Free
 end
end;

procedure   DoCreateRepositaryTable(DB:TFIBDatabase;Kind:byte);
var Index:integer;
    Transaction:TFibTransaction;
    qry:TFIBQuery;
begin
 qry:=TFIBQuery.Create(nil);
 Transaction:=TFibTransaction.Create(nil);
 try
  Transaction.DefaultDatabase:=DB;
  qry.Database:=DB;  qry.Transaction:=Transaction;
  qry.ParamCheck:=False;
  Transaction.StartTransaction;
  with qry,qry.SQL do
  case Kind of
  1: begin
      if not ExistBooleanDomain(DB) then
      begin
       Text:=
       'CREATE DOMAIN FIB$BOOLEAN AS SMALLINT DEFAULT 1 NOT NULL CHECK (VALUE IN (0,1))';
       ExecQuery;
      end;
      Text:=
       'CREATE TABLE FIB$FIELDS_INFO (TABLE_NAME VARCHAR(31) NOT NULL,'#13#10+
       'FIELD_NAME VARCHAR(31) NOT NULL,'#13#10+
       'DISPLAY_LABEL VARCHAR(25),'#13#10+
       'VISIBLE FIB$BOOLEAN DEFAULT 1 NOT NULL,'#13#10+
       'DISPLAY_FORMAT VARCHAR(15),'#13#10+
       'EDIT_FORMAT VARCHAR(15),'#13#10+
       'TRIGGERED FIB$BOOLEAN DEFAULT 0 NOT NULL,'#13#10+
       'CONSTRAINT PK_FIB$FIELDS_INFO PRIMARY KEY (TABLE_NAME, FIELD_NAME))';
      ExecQuery;
      Text:='GRANT SELECT ON TABLE FIB$FIELDS_INFO TO PUBLIC';
      ExecQuery;
      Update1RepositaryTable(Transaction);      
     end;
   2:
    begin
      Text:=
       'CREATE TABLE FIB$DATASETS_INFO (DS_ID INTEGER NOT NULL,'#13#10+
       'DESCRIPTION VARCHAR(40),'+
       'SELECT_SQL BLOB sub_type 1 segment size 80,'#13#10+
       'UPDATE_SQL BLOB sub_type 1 segment size 80,'#13#10+
       'INSERT_SQL BLOB sub_type 1 segment size 80,'#13#10+
       'DELETE_SQL BLOB sub_type 1 segment size 80,'#13#10+
       'REFRESH_SQL BLOB sub_type 1 segment size 80,'#13#10+
       'NAME_GENERATOR VARCHAR(68), '+
       'KEY_FIELD VARCHAR(68),'+
       'CONSTRAINT PK_FIB$DATASETS_INFO PRIMARY KEY (DS_ID))';
      ExecQuery;
      Text:=
       'GRANT SELECT ON TABLE FIB$DATASETS_INFO TO PUBLIC';
      ExecQuery;
      Update2RepositaryTable(Transaction);
    end;
   3:
    begin
      Text:=
      'CREATE TABLE FIB$ERROR_MESSAGES ('+
      'CONSTRAINT_NAME  VARCHAR(67) NOT NULL,'+
      'MESSAGE_STRING   VARCHAR(100),'+
      'FIB$VERSION      INTEGER,'+
      'CONSTR_TYPE      VARCHAR(11) DEFAULT ''UNIQUE'' NOT NULL,'+
      'CONSTRAINT PK_FIB$ERROR_MESSAGES PRIMARY KEY (CONSTRAINT_NAME))'
      ;

      ExecQuery;
      Text:=
       'GRANT SELECT ON TABLE FIB$ERROR_MESSAGES TO PUBLIC';
      ExecQuery;

      try
       Text:='CREATE GENERATOR FIB$FIELD_INFO_VERSION';
       ExecQuery;
      except
      end;
      Text:=
       'CREATE TRIGGER BI_FIB$ERROR_MESSAGES FOR FIB$ERROR_MESSAGES '+
       'ACTIVE BEFORE INSERT POSITION 0 AS '#13#10+
       'begin '#13#10'new.fib$version=gen_id(fib$field_info_version,1);'#13#10' end';
      ExecQuery;

      Text:=
       'CREATE TRIGGER BU_FIB$ERROR_MESSAGES FOR FIB$ERROR_MESSAGES '+
       'ACTIVE BEFORE UPDATE POSITION 0 AS '#13#10+
       'begin '#13#10'new.fib$version=gen_id(fib$field_info_version,1);'#13#10' end';
      ExecQuery;
    end;
  end;
  Transaction.Commit;
 finally
  Transaction.Free;
  qry.Free;
 end;
 with DatabaseRepositories do
 begin
  Index:=IndexOfObject(DB);
  if Index=-1 then
   AddObject(FastCopy('222',1,Kind-1)+'1'+FastCopy('222',1,Kind+1),DB)
  else
   DatabaseRepositories[Index]:=
     FastCopy(DatabaseRepositories[Index],1,Kind-1)+'1'+FastCopy(DatabaseRepositories[Index],1,Kind+1);
 end;
end;

procedure   CreateDRepositaryTable(DB:TFIBDatabase);
begin
 DoCreateRepositaryTable(DB,2)
end;

procedure   CreateFRepositaryTable(DB:TFIBDatabase);
begin
 DoCreateRepositaryTable(DB,1)
end;

procedure   CreateERepositaryTable(DB:TFIBDatabase);
begin
 DoCreateRepositaryTable(DB,3)
end;

function   ExchangeDataSetInfo(DataSet:TFibDataSet;DS_Info:TpDataSetInfo;aDescription:string=''):boolean;
var
    vTransaction:TFibTransaction;
    DI:TpFIBDataset;
    vDescription:string;
    tf1:TFIBXSQLVAR;
    q:TFIBQuery;

begin
 Result:=True;
 if DataSet is TpFIBDataSet then
 with TpFIBDataSet (DataSet) do
 begin
   if DataSet_ID= 0 then
    raise Exception.Create(Name + SCompEditDataSet_ID);
   if DataBase=nil then  raise Exception.Create(SDataBaseNotAssigned);
   if not (urDataSetInfo in DataSet.Database.UseRepositories) then
     raise Exception.Create(SCompEditDataSetInfoForbid);
   if not ExistDRepositaryTable(DataSet.Database) then
     raise Exception.Create(SCompEditDataSetInfoNotExists);

   DI:=TpFIBDataset.Create(nil);
   vTransaction:=TFibTransaction.Create(nil);
   vTransaction.DefaultDatabase:=DataSet.DataBase;
   q:=GetQueryForUse(vTransaction,'SELECT * FROM FIB$DATASETS_INFO WHERE DS_ID=:DS_ID');
   try
    vTransaction.StartTransaction;
    if DS_Info<>nil then
    begin
     q.Params[0].asInteger:=DataSet_ID;
     q.ExecQuery;
     if q.RecordCount=0 then
      Exit;
     with DS_Info,q do
     begin
      FSelectSQL.Text :=FieldByName('SELECT_SQL').asString;
      FUpdateSQL.Text :=FieldByName('UPDATE_SQL').asString;
      FInsertSQL.Text :=FieldByName('INSERT_SQL').asString;
      FDeleteSQL.Text :=FieldByName('DELETE_SQL').asString;