Solved

Compress and uncompress TFileStream

Posted on 1998-08-04
26
840 Views
Last Modified: 2008-02-07
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
Comment
Question by:yc
  • 10
  • 8
  • 4
  • +2
26 Comments
 
LVL 3

Expert Comment

by:Matvey
ID: 1359664
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
 
LVL 3

Expert Comment

by:Matvey
ID: 1359665
0
 

Author Comment

by:yc
ID: 1359666
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
 
LVL 3

Expert Comment

by:Matvey
ID: 1359667
Here, see this whole page of Delphi compression components:

http://torry.magnitka.ru/compress.htm
0
 

Author Comment

by:yc
ID: 1359668
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
 
LVL 3

Expert Comment

by:Matvey
ID: 1359669
I can't believe you found nothing on the last page. Should I encist you visit it?

http://torry.magnitka.ru/compress.htm
0
 

Author Comment

by:yc
ID: 1359670
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
 

Author Comment

by:yc
ID: 1359671
Adjusted points to 100
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1359672
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
 
LVL 3

Expert Comment

by:Matvey
ID: 1359673
PS leave your email meanwhile...

bosism@netvision.net.il
0
 
LVL 2

Expert Comment

by:kjteng
ID: 1359674
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
 

Author Comment

by:yc
ID: 1359675
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
 

Author Comment

by:yc
ID: 1359676
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 2

Expert Comment

by:kjteng
ID: 1359677
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
 

Author Comment

by:yc
ID: 1359678
Hi, kjteng

I think you have already give me an satisfaction already.

Thanks you again.

0
 

Author Comment

by:yc
ID: 1359679
Hi, Matvey

I think Kjteng have already give me an satisfaction already.

Thanks you again.
0
 
LVL 3

Expert Comment

by:Matvey
ID: 1359680
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
 
LVL 1

Expert Comment

by:millerw
ID: 1359681
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
 

Author Comment

by:yc
ID: 1359682
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
 
LVL 3

Expert Comment

by:Matvey
ID: 1359683
Will you consider adding me to the list?

Many thanks,  bosism@netvision.net.il
0
 
LVL 2

Expert Comment

by:kjteng
ID: 1359684
I'm interested too. gjdeng@yahoo.com
Thanks
0
 
LVL 1

Expert Comment

by:millerw
ID: 1359685
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
 
LVL 1

Expert Comment

by:millerw
ID: 1359686
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
 
LVL 10

Accepted Solution

by:
Jacco earned 100 total points
ID: 1359687
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
 
LVL 1

Expert Comment

by:millerw
ID: 1359688
I'd like to see your work Jacco.

My e-mail is Scott.Miller@imb.org
0
 

Author Comment

by:yc
ID: 1359689
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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now