pfibdatainfo.pas

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

      FRefreshSQL.Text:=FieldByName('REFRESH_SQL').asString;
      FKeyField       :=FieldByName('KEY_FIELD').asString;
      FGeneratorName  :=FieldByName('NAME_GENERATOR').asString;
      FDescription    :=FieldByName('DESCRIPTION')   .asString;
      tf1:=FindField('FIB$VERSION');
      if Assigned(tf1) then
       FVersion:=FieldByName('FIB$VERSION').asInteger;
      tf1:=FindField('UPDATE_TABLE_NAME');
      if Assigned(tf1) then
        FUpdateTableName:=tf1.AsString;
      tf1:=FindField('UPDATE_ONLY_MODIFIED_FIELDS');
      if Assigned(tf1) then
        FUpdateOnlyModifiedFields:=tf1.AsInteger=1;
      tf1:=FindField('CONDITIONS');
      if Assigned(tf1) then
      begin
        FConditions:=tf1.AsString;
      end;
      q.Close;
     end;
    end
    else
    begin
//For design only    
      DI.Database:=DataSet.DataBase;
      DI.Transaction:=vTransaction;
      DI.UpdateTransaction:=vTransaction;
      DI.SelectSQL.Text:=
       'SELECT * FROM FIB$DATASETS_INFO WHERE DS_ID='+IntToStr(DataSet_ID);

     DI.InsertSQL.Text:=
      'INSERT INTO FIB$DATASETS_INFO (DS_ID,UPDATE_ONLY_MODIFIED_FIELDS) VALUES('
      +IntToStr(DataSet_ID)+',1)';
     DI.UpdateSQL.Text:=
      'UPDATE FIB$DATASETS_INFO SET SELECT_SQL=?SELECT_SQL,'+
     'DESCRIPTION=?DESCRIPTION,'+
     'UPDATE_SQL=?UPDATE_SQL,'+
     'INSERT_SQL=?INSERT_SQL,'+
     'DELETE_SQL=?DELETE_SQL,'+
     'REFRESH_SQL=?REFRESH_SQL,'+
     'NAME_GENERATOR=?NAME_GENERATOR,'+
     'KEY_FIELD=?KEY_FIELD, '+
     'UPDATE_TABLE_NAME=?UPDATE_TABLE_NAME, '+
     'UPDATE_ONLY_MODIFIED_FIELDS=?UPDATE_ONLY_MODIFIED_FIELDS, '+
     'CONDITIONS=?CONDITIONS '+
     'WHERE DS_ID='+IntToStr(DataSet_ID)
     ;
     try
      DI.QUpdate.Prepare;
     except
      Update2RepositaryTable(vTransaction);
      vTransaction.Commit;
      vTransaction.StartTransaction
     end;
     DI.Open;
     if DI.RecordCount=0  then
     begin
       DI.QInsert.ExecQuery;
       DI.Close;DI.Open;
       if DI.RecordCount=0  then
        raise Exception.Create(SCompEditUnableInsertInfoRecord);
     end;
      if Length(aDescription)= 0 then
       vDescription:=DI.FieldByName('DESCRIPTION')   .asString
      else
       vDescription:=aDescription;


{      Result:=False;

      if not InputQuery(SCompEditSaveDataSetProperty, SCompEditDataSetDesc, vDescription
      ) then Exit;}
      DI.Edit;
      DI.FieldByName('SELECT_SQL') .asString :=DataSet.SelectSQL.Text;
      DI.FieldByName('INSERT_SQL') .asString :=DataSet.InsertSQL.Text;
      DI.FieldByName('DELETE_SQL') .asString :=DataSet.DeleteSQL.Text;
      DI.FieldByName('UPDATE_SQL') .asString :=DataSet.UpdateSQL.Text;
      DI.FieldByName('REFRESH_SQL').asString :=DataSet.RefreshSQL.Text;
      DI.FieldByName('KEY_FIELD')  .asString :=AutoUpdateOptions.KeyFields;
      DI.FieldByName('NAME_GENERATOR').asString  :=AutoUpdateOptions.GeneratorName;
      DI.FieldByName('DESCRIPTION')   .asString  :=vDescription;
      DI.FieldByName('UPDATE_TABLE_NAME').asString  :=AutoUpdateOptions.UpdateTableName;
      DI.FieldByName('UPDATE_ONLY_MODIFIED_FIELDS').asInteger:=
        Ord(AutoUpdateOptions.UpdateOnlyModifiedFields);
      DI.FieldByName('CONDITIONS').asString  :=Conditions.ExchangeString;
      DI.Post;
    end;
    vTransaction.Commit;
    Result:=True;
   finally
    FreeQueryForUse(q);
    vTransaction.Free;
    DI.Free;
   end;
 end;
end;

function   SaveFIBDataSetInfo(DataSet:TFibDataSet;const Name:string):boolean;
begin
 Result:=ExchangeDataSetInfo(DataSet,nil,Name);
end;



function DoGetTableId(const TableName:string;  aTransaction:TFIBTransaction):integer;
var
   q:TFIBQuery;
const
 STabId =   'select RDB$RELATION_ID from RDB$RELATIONS '+
 'where RDB$RELATION_NAME=?TN';

begin
  if (aTransaction=nil) or (aTransaction.DefaultDatabase=nil) then
  begin
   Result:=-1;
   Exit;
  end;
  q:=GetQueryForUse(aTransaction,STabId);
  with q do
  try
   Params[0].AsString:=TableName;
   if not Transaction.InTransaction then
    Transaction.StartTransaction;
   ExecQuery;
   if Eof then
     Result:=-1
   else
     Result:=Fields[0].asInteger
  finally
    FreeQueryForUse(q);
  end
end;

function DBPrimaryKeyFields(const TableName:string;
  aTransaction:TFIBTransaction
 ):string;
var
   q:TFIBQuery;
const
  SGetPrimary=   'select i.rdb$field_name'#13#10+
   'from    rdb$relation_constraints r, rdb$index_segments i'#13#10+
   'where   r.rdb$relation_name=:TN and'#13#10+
   'r.rdb$constraint_type=''PRIMARY KEY'' and'#13#10+
   'r.rdb$index_name=i.rdb$index_name'#13#10 +
   'order by i.rdb$field_position';

begin
  if Length(TableName) = 0 then
  begin
    result := '';
    exit;
  end;
  if (aTransaction=nil) or (aTransaction.DefaultDatabase=nil) then
  begin
   Result:=SDefer;
   Exit;
  end;
  q:=GetQueryForUse(aTransaction,SGetPrimary);
  Result:='';
  with q do
  try
   q.Options:=[qoStartTransaction];
   if TableName[1]='"' then
    ParamByName('TN').AsString:=Copy(TableName,2,Length(TableName)-2)
   else
    ParamByName('TN').AsString:=TableName;
   ExecQuery;
   Result:=FastTrim(Fields[0].asString); Next;
   while not Eof do
   begin
    Result:=Result+';'+FastTrim(Fields[0].asString);
    Next
   end;
  finally
    FreeQueryForUse(q);
  end
end;

//StreamRtn
procedure WriteStrToStream(const s:string;Stream: TStream);
var
  L:integer;
begin
   L:=Length(s);
   with Stream do
   begin
    WriteBuffer(L,SizeOf(Integer));
    if L>0 then
     WriteBuffer(s[1],L);
   end;
end;


procedure ReadStrFromStream(const Stream: TStream;var ResStr:string);
var
  L:integer;
begin
   with Stream do
   begin
    ReadBuffer(L,SizeOf(Integer));
    SetLength(ResStr,L);
    if L>0 then
     ReadBuffer(ResStr[1],L);
   end;
end;

constructor TpFIBFieldInfo.Create;
begin
  inherited Create;
  FWithAdditionalInfo:=False;
  FIsTriggered       :=False;
  FOtherInfo         :=TStringList.Create;
  FDefaultValueEmptyString := False;
  FDisplayWidth      :=0;
  FCanBeBoolean      :=eUnknown;
  FCanBeGUID         :=eUnknown;
end;

destructor  TpFIBFieldInfo.Destroy;
begin
 FOtherInfo.Free;
 inherited Destroy;
end;

function  TpFIBFieldInfo.GetCanBeBoolean:boolean;
begin
  case FCanBeBoolean  of
   eTrue    : Result:=True ;
   eFalse   : Result:=False;
  else
   Result:=PosCI('BOOLEAN',DomainName)>0;
   FCanBeBoolean :=TExtBoolean(Result);
  end;
end;

function  TpFIBFieldInfo.GetCanBeGUID:boolean;
begin
  case FCanBeGuid  of
   eTrue    : Result:=True ;
   eFalse   : Result:=False;
  else
   Result:=PosCI('GUID',DomainName)>0;
   FCanBeGuid :=TExtBoolean(Result);
  end;
end;

function  TpFIBFieldInfo.GetCharSet:string;
begin
 if (FCharSet<0) or (FCharSet>IBStdCharSetsCount-1) then
  Result:=UnknownStr
 else
  Result:=IBStdCharacterSets[FCharSet]
end;

procedure TpFIBFieldInfo.SaveToStream(Stream:TStream);
begin
  with Stream do
  begin
   WriteBuffer(FIsComputed,SizeOf(boolean));
   WriteBuffer(FCanIncToWhereClause,SizeOf(boolean));
   WriteBuffer(FDefaultValueEmptyString,SizeOf(boolean));
   WriteBuffer(FWithAdditionalInfo,SizeOf(boolean));
   WriteBuffer(FVisible,SizeOf(boolean));
   WriteBuffer(FIsTriggered,SizeOf(boolean));
   WriteBuffer(FDisplayWidth,SizeOf(integer));
   WriteBuffer(FCharSet,SizeOf(integer));
   WriteStrToStream(FDefaultValue,Stream);
   WriteStrToStream(FDomainName,Stream);
   WriteStrToStream(FDisplayLabel,Stream);
   WriteStrToStream(FEditFormat,Stream);
   WriteStrToStream(FDisplayFormat,Stream);
   WriteStrToStream(FOtherInfo.Text,Stream);
  end;
end;

procedure TpFIBFieldInfo.LoadFromStream(Stream:TStream;FromBegin:boolean);
var 
   st:string ;
procedure RaizeErrStream;
begin
 raise Exception.Create(SCompEditFieldInfoLoadError);
end;

begin
  with Stream do
  begin
   if FromBegin then Seek(0,soFromBeginning);
   ReadBuffer(FIsComputed,SizeOf(boolean));
   ReadBuffer(FCanIncToWhereClause,SizeOf(boolean));
   ReadBuffer(FDefaultValueEmptyString,SizeOf(boolean));
   ReadBuffer(FWithAdditionalInfo,SizeOf(boolean));
   ReadBuffer(FVisible,SizeOf(boolean));
   ReadBuffer(FIsTriggered,SizeOf(boolean));
   ReadBuffer(FDisplayWidth,SizeOf(integer));
   ReadBuffer(FCharSet,SizeOf(integer));

   ReadStrFromStream(Stream,FDefaultValue);
   ReadStrFromStream(Stream,FDomainName);
   ReadStrFromStream(Stream,FDisplayLabel);
   ReadStrFromStream(Stream,FEditFormat);
   ReadStrFromStream(Stream,FDisplayFormat);
   ReadStrFromStream(Stream,st);
   FOtherInfo.Text:=st;
  end
end;

// TpFIBTableInfo
constructor TpFIBTableInfo.Create(AOwner:TpFIBTableInfoCollect);
begin
 inherited Create;
 FOwner:=AOwner;
 FFieldList:=TStringList.Create;
 FTableID            :=-1;
end;

procedure   TpFIBTableInfo.FillInfo(DB:TFIBDataBase;Tr:TFIBTransaction; const ATableName:string);

var
   vDatabase:TFIBDatabase;
   vForceTransaction:boolean;
begin
 inherited Create;
 FTableName:=ATableName;
 FPrimaryKeyFields:=SDefer;
 vDatabase:=DB;
 FDBName   :=vDatabase.DBName;
 vForceTransaction:=vDatabase.ActiveTransactionCount=0;
 if vForceTransaction then
 begin
   if Length(FTableName)>0 then
    GetInfoFields(FTableName,Tr);
 end
 else
 begin
   if Length(FTableName)>0 then
    GetInfoFields(FTableName,vDatabase.FirstActiveTransaction);
 end;

end;



destructor TpFIBTableInfo.Destroy;//override;
begin
 ClearFieldList;
 FFieldList.Free;
 inherited Destroy;
end;

procedure   TpFIBTableInfo.SaveToStream(Stream:TStream);
var i,L:integer;
begin
  with Stream do
  begin
   WriteStrToStream(FDBName,Stream);
   WriteStrToStream(FTableName,Stream);
   WriteBuffer(FWithFieldRepositaryInfo,SizeOf(boolean));
   WriteBuffer(FFormatNumber,SizeOf(Integer)); // 聍弪麒