Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d345/JWTOOL.ZIP/jwtool/JwBinRES.PAS

Pascal/Delphi Source File | 2001-09-29 | 11.3 KB | 384 lines

unit JwBinRES;

interface
{
        OH Heaven Above this was a long time comming!!!!!!  Why the RTTI information is so poorly
documented, I'll never know.  It was only through scowering the Classes.pas, DsgnIntf.pas, and
a goodly amount from TurboPower's documentation of SysTools (good product by the way) was I
able to finally do this thing.
        Well, here's the deal.  As with the "TStringResourse" and the "TBMPResourse" I was trying
to make non-graphic ways of storing files into the executable.  I realize of course I could just
stick these in with the resource file, and the load it up from there, but the one that comes
with delphi just doesn't cut it for me (maybe I'm just not skilled enough...) but I thought that
since a TBitMap was stored in the DFM file, why not a zip file?  Well, it was easy for the first
two, but for just plain binary stuff that had no property edit already made, I was out-of-luck.
I think my biggest mistake was that I was trying to do it with TStream descendants.  I had such
good luck with a file I made "TMemoryFile" that I used to read in raw files.  The problem, as I have
found out, is that they are not descendant from TPersistent.  Finally I gave up with that Idea
and went to a just plain Pointer variable wrapped up in a TPersistent class.  That was the big
secret I had a hard time to figure out.
        Well, my plans are to use this with Turbopower's abrevia (of course now that v3 is out
I'm gonna have to scrape up some money for that...grumble....) that has a UnZip and Zip from a
stream.  So I can use my WriteToStream property, unzip it with a call to abrevia, and then
I'm on my way.

}

//  Version History
//     Num     Date            Notes
//     1.00  August 1, 1999   Initial Release

//  Created By:
//    Joseph Wilcock
//    [e-mail]
//    http://msnhomepages.talkcity.com/RedmondAve/coockoo/


uses Windows, SysUtils, Classes, Controls, DsgnIntf;

type
  TJwMemoryDataProperty = Class( TPropertyEditor )
    public
      Function GetAttributes: TPropertyAttributes; Override;
      Function GetValue: String; Override;
      Procedure Edit; Override;
    End;

  TJwMemoryData = Class( TPersistent )
    Private
      FData: Pointer;
      FFileSize: Longint;
      FOrgFileName: AnsiString;
      FOnFailToRead: TNotifyEvent;
      FOnFailToWrite: TNotifyEvent;
      FOnFailToDelete: TNotifyEvent;
    private
      Procedure FillData( aSize: LongInt; aData: Pointer );
      function GetSize: LongInt;
      procedure SetFileName(const Value: String);
    Protected
      Procedure DefineProperties( Filer: TFiler ); Override;
      Procedure ReadData( Stream: TStream ); Virtual;
      Procedure WriteData( Stream: TStream ); Virtual;
    Public
      Constructor Create;
      Destructor Destroy; Override;
      Procedure Clear;
      Procedure LoadFromFile( const FileName: String ); Virtual;
      Procedure Assign( Source: TPersistent ); Override;
      Procedure SaveToFile( const FileName: String ); Virtual;
      Procedure SaveToStream( Stream: TStream );
    published
      Property FileName: String Read FOrgFileName Write SetFileName;
      Property CurrentSize: LongInt Read GetSize;
      Property OnFailToRead: TNotifyEvent Read FOnFailToRead Write FOnFailToRead;
      Property OnFailToWrite: TNotifyEvent Read FOnFailToWrite Write FOnFailToWrite;
      Property OnFailToDelete: TNotifyEvent Read FOnFailToDelete Write FOnFailToDelete;
    End;

  TJwBinRes = Class( TComponent )
    Private
      FFileData: TJwMemoryData;
      FTagName: String;
    private
      function GetOriginalFileName: String;
      procedure SetTagName(const Value: String);
      Procedure SetjwMemoryData( Value: TJwMemoryData );
      function GetOnFailToDelete: TNotifyEvent;
      function GetOnFailToRead: TNotifyEvent;
      function GetOnFailToWrite: TNotifyEvent;
      procedure SetOnFailToDelete(const Value: TNotifyEvent);
      procedure SetOnFailToRead(const Value: TNotifyEvent);
      procedure SetOnFailToWrite(const Value: TNotifyEvent);
    Public
      Procedure SaveToStream( Stream: TStream );
      Procedure SaveThroughStream( const FileName: String );
      Procedure SaveToFile( const FileName: String );
      Constructor Create( AOwner: TComponent ); Override;
      Destructor Destroy; Override;
    Published
      Property FileData: TJwMemoryData Read FFileData Write SetjwMemoryData;
      Property TagName: String Read FTagName Write SetTagName;
      Property OriginalFileName: String Read GetOriginalFileName;
      Property OnFailToRead: TNotifyEvent Read GetOnFailToRead Write SetOnFailToRead;
      Property OnFailToWrite: TNotifyEvent Read GetOnFailToWrite Write SetOnFailToWrite;
      Property OnFailToDelete: TNotifyEvent Read GetOnFailToDelete Write SetOnFailToDelete;
    End;

Procedure Register;

implementation

uses Dialogs;

Procedure Register;
Begin
  RegisterPropertyEditor( TypeInfo( TJwMemoryData ), TJwBinRes, '', TJwMemoryDataProperty );
  RegisterComponents( 'JwTools', [ TJwBinRes ] );
End;

/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
Function TJwMemoryDataProperty.GetAttributes: TPropertyAttributes;
Begin
  Result := Inherited GetAttributes + [ paDialog ];
End;

Function TJwMemoryDataProperty.GetValue: String;
Begin
  If TJwMemoryData( GetOrdValue ).CurrentSize=0 Then
    Result := '<No Data>'
  Else
    Result := '<Data Loaded>';
End;

Procedure TJwMemoryDataProperty.Edit;
Var
  NewData: TJwMemoryData;
Begin
  NewData := TJwMemoryData.Create;
  With TOpenDialog.Create( Nil ) Do
    Begin
      If Execute Then
        NewData.LoadFromFile( FileName );
      Free;
    End;
  SetOrdValue( LongInt( NewData ) );
  Modified;
  NewData.Free;
End;
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
Procedure TJwMemoryData.Clear;
Begin
  If FFileSize > 0 Then
    Begin
      FreeMem( FData, FFileSize );
      FFileSize := 0;
      FOrgFileName := '';
    End;
End;

Procedure TJwMemoryData.FillData( aSize: LongInt; aData: Pointer );
Begin
  Self.Clear;
  If aSize > 0 Then
    Begin
      FFileSize := aSize;
      GetMem( FData, FFileSize );
      Move( aData^, FData^, FFileSize );
    End;
End;

Procedure TJwMemoryData.Assign( Source: TPersistent );
Begin
  If Source = Nil Then
    Self.Clear
  Else
    begin
      If Source Is TJwMemoryData Then
        FillData( TJwMemoryData( Source ).FFileSize, TJwMemoryData( Source ).FData )
      Else
        Inherited Assign( Source );
    end;
End;

Procedure TJwMemoryData.LoadFromFile( const FileName: String );
var
  FromF: File;
  OrgFileMode, NumRead: LongInt;
Begin
  Self.Clear;
  OrgFileMode := FileMode;
  FileMode := 0;
  try
    If FileExists( FileName ) Then
      Begin
        Assignfile( FromF, FileName );
        Reset( FromF, 1 );
        try
          If FileSize( FromF ) > 0 Then
            Begin
              FFileSize := FileSize( FromF );
              GetMem( FData, FFileSize );
              BlockRead( FromF, FData^, FFileSize, NumRead );
              if ( NumRead < FFileSize ) and Assigned( FOnFailToRead ) then
                FOnFailToRead( Self.GetOwner );
            End;
        finally
          CloseFile( FromF );
        end;
      End;
  finally
    FileMode := OrgFileMode;
  end;
  FOrgFileName := ExtractFileName( FileName );
End;

Procedure TJwMemoryData.SaveToFile( const FileName: String );
Var
  ToF: File;
  OrgFileMode, NumWritten: LongInt;
Begin
  OrgFileMode := FileMode;
  FileMode := 2;
  try
    if FileExists( FileName ) then
      begin
        try
          DeleteFile( FileName );
        except  end;
      end;
    if Not( FileExists( FileName ) ) then
      begin
        AssignFile( ToF, FileName );
        ReWrite( ToF, 1 );
        try
          BlockWrite( ToF, FData^, FFileSize, NumWritten );
          if ( NumWritten < FFileSize ) and Assigned( FOnFailToWrite ) then
            FOnFailToWrite( Self.GetOwner );
        finally
          CloseFile( ToF );
        end;
      end
    else if Assigned( FOnFailToDelete ) then
      FOnFailToDelete( Self.GetOwner );
  finally
    FileMode := OrgFileMode;
  end;
End;

procedure TJwMemoryData.SaveToStream(Stream: TStream);
begin
  if Assigned( Stream ) then
    Stream.WriteBuffer( FData^, FFileSize );
end;

function TJwMemoryData.GetSize: LongInt;
begin
  Result := FFileSize;
end;

procedure TJwMemoryData.SetFileName(const Value: String);
begin
  FOrgFileName := Value;
end;

Procedure TJwMemoryData.WriteData( Stream: TStream );
Begin
  Stream.Write( FFileSize, SizeOf( FFileSize ) );
  Stream.Write( FData^, FFileSize );
End;

Procedure TJwMemoryData.ReadData( Stream: TStream );
Begin
  Clear;
  Stream.Read( FFileSize, SizeOf( FFileSize ) );
  If FFileSize > 0 Then
    Begin
      GetMem( FData, FFileSize );
      Stream.Read( FData^, FFileSize );
    End;
End;

Procedure TJwMemoryData.DefineProperties( Filer: TFiler );
Begin
  Inherited DefineProperties( Filer );
  Filer.DefineBinaryProperty( 'jwBinData', ReadData, WriteData, FFileSize > 0 );
End;

Constructor TJwMemoryData.Create;
begin
  Inherited Create;
  fFileSize := 0;
  FOrgFileName := '';
end;

Destructor TJwMemoryData.destroy;
Begin
  Clear;
  Inherited destroy;
End;
/////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////
Procedure TJwBinRes.SaveToFile( const FileName: String );
Begin
  FFileData.SaveToFile( FileName );
End;

Procedure TJwBinRes.SetjwMemoryData( Value: TJwMemoryData );
Begin
  FFileData.Assign( Value );
End;

Constructor TJwBinRes.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FFileData := TJwMemoryData.Create;
End;

Destructor TJwBinRes.Destroy;
Begin
  FFileData.Free;
  Inherited Destroy;
End;

function TJwBinRes.GetOnFailToDelete: TNotifyEvent;
begin
  Result := FFileData.FOnFailToDelete;
end;

function TJwBinRes.GetOnFailToRead: TNotifyEvent;
begin
  Result := FFileData.FOnFailToRead;
end;

function TJwBinRes.GetOnFailToWrite: TNotifyEvent;
begin
  Result := FFileData.FOnFailToWrite;
end;

procedure TJwBinRes.SetOnFailToDelete(const Value: TNotifyEvent);
begin
  FFileData.FOnFailToDelete := Value;
end;

procedure TJwBinRes.SetOnFailToRead(const Value: TNotifyEvent);
begin
  FFileData.FOnFailToRead := Value;
end;

procedure TJwBinRes.SetOnFailToWrite(const Value: TNotifyEvent);
begin
  FFileData.FOnFailToWrite := Value;
end;

procedure TJwBinRes.SaveThroughStream(const FileName: String);
var
  outStream: TFileStream;
begin
  outStream := TFileStream.Create( FileName, fmCreate );
  try
    FFileData.SaveToStream( outStream );
  finally
    outStream.Free;
  end;
end;

procedure TJwBinRes.SaveToStream(Stream: TStream);
begin
  FFileData.SaveToStream( Stream );
end;

procedure TJwBinRes.SetTagName(const Value: String);
begin
  FTagName := Value;
end;

function TJwBinRes.GetOriginalFileName: String;
begin
  Result := FFileData.FOrgFileName;
end;

end.