(*****************************************************************************)
(* MODULE: BTRRES^                                                           *)
(* RIGHTS: Reggatta Systems, Inc. - COPYRIGHT 1995-1999                      *)
(* DESCR.: This module contains the classes to support Field information     *)
(*         to be placed into a Windows Resource file.                        *)
(*****************************************************************************)
Unit Bseres;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Classes,
  DB,
  BtrMain,
  Windows,

  BseTypes,
  BseTable;


Type
  TRCDataStream =
  Class( TFileStream )
    Private
      FResName : ShortString;
    Public
      Property ResName : ShortString
        Read  FResName
        Write FResName;
      Constructor Create( FileName, RName : ShortString );
      Function WriteResourceName : Boolean;
  end;


  TTblResBase =
  Class( TObject )
    Private
      FTitanTable : TBaseTable;
      Function GetVersSig : PChar;
      Function GetEndSig  : PChar;
    Public
      Constructor Create( T : TtbTable );
      Constructor CreateWithTitan( T : TBaseTable );
      Property Table   : TBaseTable
        Read  FTitanTable;
      Property VersSig : PChar
        Read  GetVersSig;
      Property EndSig  : PChar
        Read  GetEndSig;
  end;


  TTblResWriter =
  Class( TTblResBase )
    Function WriteResource( Name, FileName : ShortString ) : Boolean;
  end;


  TTblResReader =
  Class( TTblResBase )
    Function ReadResource( Name : ShortString ) : Boolean;
  end;


Implementation
Uses
  SysUtils,
  Forms,
  Dialogs,
  BDE,

  BseConst,
  BseUtils;


Procedure StreamToResource( Input, Output : TStream );
var
  Len          : Byte;
  MemorySize   : Longint;
  Header       : array[0..79] of Char;
  MemoryStream : TMemoryStream;
begin
  MemoryStream := TMemoryStream.Create;
  Try
    MemoryStream.LoadFromStream( Input );
    MemorySize := MemoryStream.Size;
    MoveZero( Header, SizeOf( Header ) );
    MemoryStream.Seek( 0, 0 );
    MemoryStream.Read( Len, 1 );
    MemoryStream.Read( Header[ 3 ], Len );

    StrUpper( @Header[ 3 ] );

    Byte( ( @Header[ 0 ] )^ )       := $FF;
    Word( ( @Header[ 1 ] )^ )       := 10;
    Word( ( @Header[ Len + 4 ] )^ ) := $1030;

    Longint( ( @Header[ Len + 6 ] )^ ) := MemorySize;

    Output.Write( Header, Len + 10 );
    Output.Write( MemoryStream.Memory^, MemorySize );
  Finally
    MemoryStream.Free;
  end;
end;


Constructor TTblResBase.Create( T : TtbTable );
begin
  CreateWithTitan( TBaseTable( T.Handle ) );
end;


Constructor TTblResBase.CreateWithTitan( T : TBaseTable );
begin
  Inherited Create;
  FTitanTable := T;
end;


Function TTblResBase.GetVersSig : PChar;
begin
  { Result := '0001'; Old release - Incompatible between 16 & 32 bit versions }
  Result := '0002'; { Only saves the first 48 bytes of FLDDesc record as the  }
                    { rest is computed anyway.  This keeps the resource size  }
                    { smaller, and allows compatibility between 16 & 32 bit   }
                    { versions of Delphi.                                     }
end;


Function TTblResBase.GetEndSig : PChar;
begin
  Result := 'ABCD';
end;


Function TTblResWriter.WriteResource( Name, FileName : ShortString ) : Boolean;
var
  TItem  : TFieldCacheItem;
  Source : TMemoryStream;
  Target : TFileStream;
  Fields : Word;
  RSize  : Word;
  i      : Word;
  iTmp   : SmallInt;
  wTmp   : Word;
  tmp    : String[ DBIMAXNAMELEN ];
begin
  Result := FALSE;
  If ( Table.TableName <> NIL ) then
  begin
    Table.GetFieldCount( Fields, RSize );
    Try
      Source := TMemoryStream.Create;
      Try
        Source.Write( Name, Succ( Length( Name ) ) );
        Source.Write( VersSig^, Succ( StrLen( VersSig ) ) );
        For i := 1 to Fields do
        begin
          TItem := Table.Fields[ Integer( i ) ];
          With TItem do
          begin
            wTmp := FieldNumber;
            Source.Write( wTmp, SizeOf( wTmp ) );

            tmp := FieldName;
            Source.Write( tmp, Succ( Length( tmp ) ) );

            wTmp := FieldType;
            Source.Write( wTmp, SizeOf( wTmp ) );

            wTmp := FieldSubType;
            Source.Write( wTmp, SizeOf( wTmp ) );

            iTmp := FieldUnits1;
            Source.Write( iTmp,  SizeOf( iTmp ) );

            iTmp := FieldUnits2;
            Source.Write( iTmp,  SizeOf( iTmp ) );

            wTmp := DataOffset;
            Source.Write( wTmp, SizeOf( wTmp ) );

            wTmp := FieldLength;
            Source.Write( wTmp, SizeOf( wTmp ) );

            wTmp := LocalType;
            Source.Write( wTmp, SizeOf( wTmp ) );

            wTmp := LocalSize;
            Source.Write( wTmp, SizeOf( wTmp ) );
          end;
        end;
        Source.Write( EndSig^, Succ( StrLen( EndSig ) ) );
        Target := TFileStream.Create( FileName, fmCreate );
        Try
          StreamToResource( Source, Target );
        Finally
          Target.Free;
        end;
      Finally
        Source.Free;
      end;
      Result := TRUE;
    Except
      Result := FALSE;
    end;
  end;
end;


Function TTblResReader.ReadResource( Name : ShortString ) : Boolean;
Var
  FFindHandle : THandle;
  FLoadHandle : THandle;
  ResPtr      : PChar;
  Field       : Word;
  Desc        : FldDesc;
  Local       : Word;
  LocalSz     : Word;
  NameLen     : Byte;
  VersionVal  : Integer;
  tmp         : String[ DBIMAXNAMELEN ];
  InstHandle  : LongInt;

  Procedure Fetch( Var Data; Size : Word );
  begin
    Move( ResPtr^, Data, Size );
    Inc( ResPtr, Size );
  end;

  Function LoadDDFResource( H : LongInt ) : Boolean;
  begin
    FFindHandle := FindResource( H, @Name[ 1 ], RT_RCDATA );
    Result := ( FFindHandle <> 0 );
    If Result then
      InstHandle := H;
  end;

begin
  AddChar( Name, #0 );
  { 11/30/98 TDF Fix for getting resource from EXE, not DLL }
  Result := LoadDDFResource( 0 );
  If not Result then
    Result := LoadDDFResource( HInstance );
  if Result then
  begin
    FLoadHandle := LoadResource( InstHandle, FFindHandle );
    Try
      if ( FLoadHandle <> 0 ) then
      begin
        ResPtr := LockResource( FLoadHandle );
        Try
          Result := Assigned( ResPtr );
          If Result then
          begin
            NameLen := Byte( ResPtr^ );
            Inc( ResPtr, Succ( NameLen ) );
            VersionVal := StrToInt( StrPas( ResPtr ) );
            Inc( ResPtr, Succ( StrLen( VersSig ) ) );
            Repeat
              If ( StrComp( ResPtr, EndSig ) = 0 ) then
                Break
              else
              begin
                Case VersionVal of
                  1 : begin
                        MessageDlg( 'Error - Resource [' + Name + '] ' +
                         ' in old format. Re-compile with RESMAIN.EXE', mtError, [mbOk], 0 );
                        Application.Terminate;
                      end;
                  2 : begin
                        MoveZero( Desc, SizeOf( Desc ) );
                        With Desc do
                        begin
                          Fetch( iFldNum,  SizeOf( iFldNum  ) );
                          Field := iFldNum;

                          Fetch( tmp, 1 );
                          Fetch( tmp[ 1 ], Length( tmp ) );
                          StrPLCopy( @szName, tmp, Pred( SizeOf( DBINAME ) ) );

                          Fetch( iFldType, SizeOf( iFldType ) );
                          Fetch( iSubType, SizeOf( iSubType ) );
                          Fetch( iUnits1,  SizeOf( iUnits1  ) );
                          Fetch( iUnits2,  SizeOf( iUnits2  ) );
                          Fetch( iOffset,  SizeOf( iOffset  ) );
                          Fetch( iLen,     SizeOf( iLen     ) );
                        end;
                      end;
                else
                  begin
                    Result := FALSE;
                    Break;
                  end;
                end;

                Fetch( Local, SizeOf( Local ) );
                Fetch( LocalSz, SizeOf( LocalSz ) ); { Local Size }

                TFieldCacheItem.CreateField( Table.Fields, @Desc, Field, Local, LocalSz );
              end;
            Until FALSE;
          end;
        Finally
          UnlockResource( FLoadHandle );
        end;
      end;
    Finally
      FreeResource( FLoadHandle );
    end;
  end;
end;


Constructor TRCDataStream.Create( FileName, RName : ShortString );
begin
  Inherited Create( FileName, fmCreate );
  ResName := RName;
end;


Function TRCDataStream.WriteResourceName : Boolean;
begin
  Write( FResName, Length( FResName ) + 1 );
  Result := TRUE;
end;


end.
