home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / compmrk.com / COMPFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-27  |  2.7 KB  |  94 lines
  1. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V+}
  2. {$M 8192,0,655360}
  3. Program CompFile;
  4. { This is a simple minded test program which uses COMPMARK to compress a file.
  5.   This is intended as a demonstration of the objects in COMPMARK, not as a
  6.   serious file compression program.  See the comments in COMPMARK for
  7.   information on appropriate use of these objects. }
  8. Uses CompMark, Dos, Crt;
  9. Const
  10.   BufferSize = 20000; { Input buffer size }
  11.   BufferPad = 5000;   { Output buffer is this much bigger than input buffer }
  12.   DefaultBits = 6;    { If COMPBITS not specified, start with 6 }
  13.   ReadMode = $20;     { Deny Write, Read access for input file }
  14. Var
  15.   InBuffer : Pointer;
  16.   InFile : File;
  17.   OutFile : CompFileOut;
  18.   InName, OutName : String;
  19.  
  20. Procedure Initialize;
  21. Var
  22.   MaxMemory : LongInt;
  23.   i, j : Word;
  24.   ch : Char;
  25.   Bits : Byte;
  26.   OldMode : Byte;
  27.   s : String[3];
  28. Begin
  29.   MaxMemory := MaxAvail - 2 * BufferSize - BufferPad;
  30.   Bits := DefaultBits;
  31.   s := GetEnv('COMPBITS');
  32.   If s <> '' Then Begin
  33.     Val(s, i, j);
  34.     If (j = 0) And (i <= 8) Then Bits := i;
  35.   End;
  36.   While (Bits > 0) And (WorkAreaSize(Bits) > MaxMemory) Do Dec(Bits);
  37.   WriteLn('Using ', Bits, ' Bits, work area size is ', WorkAreaSize(Bits));
  38.   InitCompress(Bits);
  39.   GetMem(InBuffer, BufferSize);
  40.   {$I-}
  41.   If ParamCount > 0 Then InName := ParamStr(1) Else Begin
  42.     Write('Enter input file name: ');
  43.     ReadLn(InName);
  44.   End;
  45.   OldMode := FileMode;
  46.   FileMode := ReadMode;
  47.   Assign(InFile, InName);
  48.   Reset(InFile, 1);
  49.   FileMode := OldMode;
  50.   {$I+}
  51.   If IoResult <> 0 Then Begin
  52.     WriteLn('Unable to open input file ', InName);
  53.     Halt(1);
  54.   End;
  55.   If ParamCount > 1 Then OutName := ParamStr(2) Else Begin
  56.     Write('Enter output file name: ');
  57.     ReadLn(OutName);
  58.   End;
  59.   WriteLn('COMPFILE will compress ', InName, ' to ', OutName);
  60.   Write('OK? (Y/N): ');
  61.   ch := UpCase(ReadKey);
  62.   Write(ch, ' ');
  63.   If ch <> 'Y' Then Begin
  64.     WriteLn('Program terminated');
  65.     Halt(1);
  66.   End;
  67.   OutFile.Init(OutName, BufferSize + BufferPad);
  68.   WriteLn(MemAvail, ' bytes free space remains');
  69.   Write('Working');
  70. End;
  71.  
  72. Procedure WriteCompressedBuffer;
  73. Var
  74.   Len : LongInt;
  75. Begin
  76.   Len := FileSize(InFile) - FilePos(InFile);
  77.   If Len > BufferSize Then Len := BufferSize;
  78.   BlockRead(InFile, InBuffer^, Len);
  79.   OutFile.PutRecord(InBuffer^, Len);
  80.   Write('.');
  81. End;
  82.  
  83. Begin
  84.   Initialize;
  85.   While Not Eof(InFile) Do WriteCompressedBuffer;
  86.   WriteLn;
  87.   OutFile.Flush;
  88.   WriteLn(InName, ' Compressed (',
  89.     (FileSize(InFile) - FileSize(OutFile.CompFile)) * 100
  90.       Div FileSize(InFile), '%)');
  91.   OutFile.Done;
  92.   Close(InFile);
  93.   WriteLn('Compression done');
  94. End.