Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 897
  • Last Modified:

Compress and uncompress TFileStream

I am looking for the source code of free component that can compressing/uncompressing so as using TFileStream.

Thanks for any helping.
Ye Chen
0
yc
Asked:
yc
  • 10
  • 8
  • 4
  • +2
1 Solution
 
MatveyCommented:
There are lots of compression units with sources. I doubts there is something specific for TFileStream - what exatly do you expect it to do.

Anyway, if you're interested, you can find lots of ZIP like units for Delphi to allow compression with files.
0
 
ycAuthor Commented:
Hi, Matvey!

I found gwdc0061.zip has compress AND uncompress procedures.
But its compress ratio is low, and the speed is not important
for me.

Before i try to download zipsfx_s.zip and diffm134.zip, i want to know the two components has compress AND uncompress function.

Please give some time to try the other you offering.

Thanks for your help.

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
MatveyCommented:
Here, see this whole page of Delphi compression components:

http://torry.magnitka.ru/compress.htm
0
 
ycAuthor Commented:
I found Diffmake can only the different part of two files.

I just need Tfilestrem component that can compress and uncompress
with the max compress ratio.
0
 
MatveyCommented:
I can't believe you found nothing on the last page. Should I encist you visit it?

http://torry.magnitka.ru/compress.htm
0
 
ycAuthor Commented:
I had visited http://torry.magnitka.ru/compress.htm
On this Page, following are kind of FWS:
1) Chief's UnZip v1.00a
      Chiefzip.zip (Does it have compress function?)
2) ChiefLZ v1.02
      Chieflz.zip (I can't build it with Delphi 4.0)
3) Data Compressors for Delphi v1.00
      GWDC0061.zip (I wanted the higher compress ratio than it.)
4) Delphi Zip v1.40
      Delzip.exe (I can't link to http://www-afsc.saia.af.mil/~englere/)
5) Delphi Zip DLL v1.40
6) InfoZip
7) PPack v1.1
8) PasZLIB v1.1

Would tell me which is the I need?
0
 
ycAuthor Commented:
Adjusted points to 100
0
 
MatveyCommented:
OK, I'll look. As far as I know best compression is the RAR compressor. I saw there a RAR compression unit...
Anyway, I'll tell you what is working there.

c u, Matvey
0
 
MatveyCommented:
PS leave your email meanwhile...

bosism@netvision.net.il
0
 
kjtengCommented:
Did you try zLib? or PasZLib in torry is the pascal port of zLib.
If you have Delphi3 you should be able to find the zlib code in "extras" directtory, the homepage for zlib is http://www.cdrom.com/pub/infozip/zlib/


0
 
ycAuthor Commented:
Hi, kjteng

I am now using Delphi 4.0

I don't known the meaning of "extras", please give me the full path of the Zlib compontent i need to download.

I think the information you offered seems to be the thing i need.

Thanks very much.

Y.C.
0
 
ycAuthor Commented:
Hi, kjteng

I am now using Delphi 4.0

I don't known the meaning of "extras", please give me the full path of the Zlib compontent i need to download.

I feel the information you offered seems to be the thing i need.

Thanks very much.

Y.C.
0
 
kjtengCommented:
In delphi 3 CD. there is a info\extras\ folder which contains some extra stuff such as zlib and jpeg library.
I do not have delph4 but I think zlib should be in there.
In case you can find it or if you want to have the latest version, go to this site:
   http://www.cdrom.com/pub/infozip/zlib/



0
 
ycAuthor Commented:
Hi, kjteng

I think you have already give me an satisfaction already.

Thanks you again.

0
 
ycAuthor Commented:
Hi, Matvey

I think Kjteng have already give me an satisfaction already.

Thanks you again.
0
 
MatveyCommented:
OK, no problem. I still haven't looked at the tons of files on Torry's page, so if you don't want me to anymore - no problem...
0
 
millerwCommented:
I have some code that I use with Zlib for my program.  It has multiple file support and has simple to use methods (Add, Extract, CopyFrom, Delete, Pack).  It doesn't use a zip file format.....its kind of a propritary one.  If you are interested in the code I'd be glad to let you see it.  

Supports:
Multiple file compression
Saves all date/attributes/etc. information
Path modes full/relative/none
Full Grep support for compressed file as well as files on disk (eg you can say Extract '*.*' and it will based on the value of IncludeSubFolders)

I just finished modifing it yesterday and am still beta testing it completly.  I have tested all the above methods, but there could be bugs of course.

Let me know when you need,
Scott
0
 
ycAuthor Commented:
Hi, Scott

I am very glad to see the code you programming.

If it is large, please send email to yc@lansuite.com

Thanks very much.

Ye Chen
0
 
MatveyCommented:
Will you consider adding me to the list?

Many thanks,  bosism@netvision.net.il
0
 
kjtengCommented:
I'm interested too. gjdeng@yahoo.com
Thanks
0
 
millerwCommented:
I am adding comments to it so that it is easier to read.  

Also, give me a little time to do a little more debugging.  So far it is working perfectly.  I'm going to run a stress test on it today or next week.  Also, I have two procedures to finish really quickly so that it is fully functional  (A stream to stream copier and a verify directory procedure)

I'll send everyone the code next week sometime (More than likely on Monday or Tuesday).  I will include a project called Compressor/Decompressor that will allow you to view exactly how to make the calls.  I'll try to get delete and update included in the project.

I didn't realize everyone would want it.  (Should have kept my mouth shut for a few more days :-)

To give you an idea of what you will get here is a list of objects that you will be able to use when I get it out:

TCompressFile  -- Has all functions for the compression and decompression
TGrepControl -- This is a "list" of greps for multiple level grepping.  You can start a new grep while one is running and, when you are done with the new grep, the old grep will be reactivated.
TGrep -- This is a single grep.  It supports only * and ? and characters right now.  It is mainly a DOS filemask utility for filename comparison.

Also, if you are concerned about cost, it will all be FREEWARE with SOURCE CODE included.  (I had to write it for a current project, so I'm already being paid for it :-)

Scott
0
 
millerwCommented:
Ok, I tested it and found one bug.  The Update function was malfunctioning.  I'm ready to send it to you all, but I'd like a good "freeware license" to put inside all my Units.  Additionally, I'd like everyone to look at it and tell me what you think needs to be added, removed, etc and what you would like to see in a component of it.  Right now, it is a TObject decendant.  I'm not sure what to make properties and what not to.  The main reason for this is that for each call to Add or Extract the preferences could change (IncludeSubFolders, PathMode, etc) and making them properties would just make changing preferences a pain---but at the same time, maybe a person wants the same preferences all the time....you see my dilema.  

Anyway, if I can find a good freeware license, I'll send it to you right away.

Scott
0
 
JaccoCommented:
Here is a freeware thing I use. I have a TFileSource and a TFileList component working with it. It is freeware. I don't know if it is allowed to post the code but I just did. Here are the credentials:

TFileSource component by Peter Martinsson (1997.01.01)

I didn't actually post the TFileSource component but only the compression part. (It is for Delphi 2). If you want I can send you the components I have made with it.

Regards, Jacco

*** start of compression unit ***
{$R-} { NO range checking !! }

{
---------------------------------------------------------------
    This posting includes the sources for the Turbo Pascal
version of the LZRW1/KH compression algoritm.
---------------------------------------------------------------
File #1 : The LZRW1KH unit
--------------------------
}
{    ###################################################################   }
{    ##                                                               ##   }
{    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
{    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
{    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
{    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
{    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
{    ##                                                               ##   }
{    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
{    ##                                                               ##   }
{    ###################################################################   }
{    ##                                                               ##   }
{    ##   This unit implements the updated LZRW1/KH algoritm which    ##   }
{    ##   also implements  some RLE coding  which is usefull  when    ##   }
{    ##   compress files  containing  a lot  of consecutive  bytes    ##   }
{    ##   having the same value.   The algoritm is not as good  as    ##   }
{    ##   LZH, but can compete with Lempel-Ziff.   It's the fasted    ##   }
{    ##   one I've encountered upto now.                              ##   }
{    ##                                                               ##   }
{    ##                                                               ##   }
{    ##                                                               ##   }
{    ##                                                Kurt HAENEN    ##   }
{    ##                                                               ##   }
{    ###################################################################   }

UNIT LZRW1KH;

INTERFACE

uses SysUtils;

{$IFDEF WIN32}
type Int16 = SmallInt;
{$ELSE}
type Int16 = Integer;
{$ENDIF}

CONST
    BufferMaxSize  = 32768;
    BufferMax      = BufferMaxSize-1;
    FLAG_Copied    = $80;
    FLAG_Compress  = $40;

TYPE
    BufferIndex    = 0..BufferMax + 15;
    BufferSize     = 0..BufferMaxSize;
       { extra bytes needed here if compression fails      *dh *}
    BufferArray    = ARRAY [BufferIndex] OF BYTE;
    BufferPtr      = ^BufferArray;


    ELzrw1KHCompressor = Class(Exception);


FUNCTION  Compression    (    Source,Dest    : BufferPtr;
                              SourceSize     : BufferSize   )    : BufferSize;

FUNCTION  Decompression  (    Source,Dest    : BufferPtr;
                              SourceSize     : BufferSize   )    : BufferSize;

IMPLEMENTATION

type
  HashTable      = ARRAY [0..4095] OF Int16;
  HashTabPtr     = ^Hashtable;

VAR
  Hash                     : HashTabPtr;

                             { check if this string has already been seen }
                             { in the current 4 KB window }
FUNCTION  GetMatch       (    Source         : BufferPtr;
                              X              : BufferIndex;
                              SourceSize     : BufferSize;
                              Hash           : HashTabPtr;
                          VAR Size           : WORD;
                          VAR Pos            : BufferIndex  )    : BOOLEAN;
VAR
  HashValue      : WORD;
  TmpHash        : Int16;
BEGIN
  HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
                                     Source^[X+2]) SHR 4) AND $0FFF;
  Result := FALSE;
  TmpHash := Hash^[HashValue];
  IF (TmpHash <> -1) and (X - TmpHash < 4096) THEN BEGIN
    Pos := TmpHash;
    Size := 0;
    WHILE ((Size < 18) AND (Source^[X+Size] = Source^[Pos+Size])
                       AND (X+Size < SourceSize)) DO begin
      INC(Size);
    end;
    Result := (Size >= 3)
  END;
  Hash^[HashValue] := X
END;
                                    { compress a buffer of max. 32 KB }
FUNCTION  Compression(Source, Dest : BufferPtr;
                      SourceSize   : BufferSize) :BufferSize;
VAR
  Bit,Command,Size         : WORD;
  Key                      : Word;
  X,Y,Z,Pos                : BufferIndex;
BEGIN
  FillChar(Hash^,SizeOf(Hashtable), $FF);
  Dest^[0] := FLAG_Compress;
  X := 0;
  Y := 3;
  Z := 1;
  Bit := 0;
  Command := 0;
  WHILE (X < SourceSize) AND (Y <= SourceSize) DO BEGIN
    IF (Bit > 15) THEN BEGIN
      Dest^[Z] := HI(Command);
      Dest^[Z+1] := LO(Command);
      Z := Y;
      Bit := 0;
      INC(Y,2)
    END;
    Size := 1;
    WHILE ((Source^[X] = Source^[X+Size]) AND (Size < $FFF)
                         AND (X+Size < SourceSize)) DO begin
              INC(Size);
    end;
    IF (Size >= 16) THEN BEGIN
      Dest^[Y] := 0;
      Dest^[Y+1] := HI(Size-16);
      Dest^[Y+2] := LO(Size-16);
      Dest^[Y+3] := Source^[X];
      INC(Y,4);
      INC(X,Size);
      Command := (Command SHL 1) + 1;
    END
    ELSE begin { not size >= 16 }
      IF (GetMatch(Source,X,SourceSize,Hash,Size,Pos)) THEN BEGIN
        Key := ((X-Pos) SHL 4) + (Size-3);
        Dest^[Y] := HI(Key);
        Dest^[Y+1] := LO(Key);
        INC(Y,2);
        INC(X,Size);
        Command := (Command SHL 1) + 1
      END
      ELSE BEGIN
        Dest^[Y] := Source^[X];
        INC(Y);
        INC(X);
        Command := Command SHL 1
      END;
    end; { size <= 16 }
    INC(Bit);
  END; { while x < sourcesize ... }
  Command := Command SHL (16-Bit);
  Dest^[Z] := HI(Command);
  Dest^[Z+1] := LO(Command);
  IF (Y > SourceSize) THEN BEGIN
    MOVE(Source^[0],Dest^[1],SourceSize);
    Dest^[0] := FLAG_Copied;
    Y := SUCC(SourceSize)
  END;
  Result := Y
END;

                                    { decompress a buffer of max 32 KB }
FUNCTION  Decompression(Source,Dest    : BufferPtr;
                        SourceSize     : BufferSize) : BufferSize;
VAR
  X,Y,Pos                  : BufferIndex;
  Command,Size,K           : WORD;
  Bit                      : BYTE;
  SaveY                    : BufferIndex; { * dh * unsafe for-loop variable Y }

BEGIN
  IF (Source^[0] = FLAG_Copied) THEN  begin
    FOR Y := 1 TO PRED(SourceSize) DO begin
      Dest^[PRED(Y)] := Source^[Y];
      SaveY := Y;
    end;
    Y := SaveY;
  end
  ELSE BEGIN
    Y := 0;
    X := 3;
    Command := (Source^[1] SHL 8) + Source^[2];
    Bit := 16;
    WHILE (X < SourceSize) DO BEGIN
      IF (Bit = 0) THEN BEGIN
        Command := (Source^[X] SHL 8) + Source^[X+1];
        Bit := 16;
        INC(X,2)
      END;
      IF ((Command AND $8000) = 0) THEN BEGIN
           Dest^[Y] := Source^[X];
           INC(X);
           INC(Y)
      END
      ELSE BEGIN  { command and $8000 }
        Pos := ((Source^[X] SHL 4)
               +(Source^[X+1] SHR 4));
        IF (Pos = 0) THEN BEGIN
          Size := (Source^[X+1] SHL 8) + Source^[X+2] + 15;
          FOR K := 0 TO Size DO begin
               Dest^[Y+K] := Source^[X+3];
          end;
          INC(X,4);
          INC(Y,Size+1)
        END
        ELSE BEGIN  { pos = 0 }
          Size := (Source^[X+1] AND $0F)+2;
          FOR K := 0 TO Size DO
               Dest^[Y+K] := Dest^[Y-Pos+K];
          INC(X,2);
          INC(Y,Size+1)
        END; { pos = 0 }
      END;  { command and $8000 }
      Command := Command SHL 1;
      DEC(Bit)
    END { while x < sourcesize }
  END;
  Result := Y
END;  { decompression }

{
  Unit "Finalization" as Delphi 2.0 would have it
}

var
  ExitSave : Pointer;

Procedure Cleanup; far;
begin
  ExitProc := ExitSave;
  if (Hash <> Nil) then
    Freemem(Hash, Sizeof(HashTable));
end;


Initialization

  Hash := Nil;
  try
    Getmem(Hash,Sizeof(Hashtable));
  except
    Raise ELzrw1KHCompressor.Create('LZRW1KH : no memory for HASH table');
  end;
  ExitSave := ExitProc;
  ExitProc := @Cleanup;
END.
*** end of compression unit ***

*** start of object code ***
interface

type
  TCompressStream = class(TObject)
  private
    FSignature: array[0..5] of Char; {= 'PMCS10' }
  public
    constructor Create; virtual;
    procedure Compress(InStream, OutStream: TStream; InSize: LongInt);
    procedure DeCompress(InStream, OutStream: TStream);
  end;

implementation

uses
  LZWR1KH;


// TCompressStream

constructor TCompressStream.Create;
begin
  FSignature := 'PMCS10';
end;

procedure TCompressStream.Compress(InStream, OutStream: TStream; InSize: LongInt);
var InBuffer, OutBuffer: BufferArray;
    CompressedSize, BytesRead, FinalPos, SizePos, TotalSize: LongInt;
begin
  TotalSize := 0;
  OutStream.WriteBuffer(FSignature, SizeOf(FSignature));
  SizePos := OutStream.Position;
  OutStream.WriteBuffer(TotalSize, SizeOf(TotalSize));
  while InSize > 0 do
  begin
    BytesRead := InStream.Read(InBuffer, SizeOf(InBuffer));
    CompressedSize := Compression(@InBuffer, @OutBuffer, BytesRead);
    OutStream.WriteBuffer(CompressedSize, SizeOf(CompressedSize));
    OutStream.WriteBuffer(OutBuffer, CompressedSize);
    TotalSize := TotalSize + CompressedSize + SizeOf(CompressedSize);
    InSize := InSize - BytesRead;
  end;
  FinalPos := OutStream.Position;
  OutStream.Position := SizePos;
  OutStream.WriteBuffer(TotalSize, SizeOf(TotalSize));
  OutStream.Position := FinalPos;
end;

procedure TCompressStream.DeCompress(InStream, OutStream: TStream);
var InBuffer, OutBuffer: BufferArray;
    CompressedSize, UnCompressedSize, InSize: LongInt;
    Sig: array[0..SizeOf(FSignature)-1] of Char;
begin
  InStream.ReadBuffer(Sig, SizeOf(FSignature));
  if Sig <> FSignature then raise Exception.Create('Wrong file type');
  InStream.ReadBuffer(InSize, SizeOf(InSize));
  while InSize > 0 do
  begin
    InStream.ReadBuffer(CompressedSize, SizeOf(CompressedSize));
    InStream.ReadBuffer(InBuffer, CompressedSize);
    UnCompressedSize := DeCompression(@InBuffer, @OutBuffer, CompressedSize);
    OutStream.WriteBuffer(OutBuffer, UnCompressedSize);
    InSize := InSize - CompressedSize - SizeOf(CompressedSize);
  end;
end;

end;
*** end of object code ***
0
 
millerwCommented:
I'd like to see your work Jacco.

My e-mail is Scott.Miller@imb.org
0
 
ycAuthor Commented:
Hi!

I think my question should be ended.

I think Kjteng's help is the key for my question.

Thanks for the helping from Kjteng, Millerw, Matvey.

Ye Chen
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 10
  • 8
  • 4
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now