home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
l
/
lzw4p12.zip
/
MK_ARC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-21
|
4KB
|
125 lines
(*
** MK_ARC.PAS.C Copyright (C) 1993 by MarshallSoft Computing, Inc.
**
** This program is used to compress one or more files into a single
** archive file. For example, to compress all files ending with the
** extension '.PAS' into an archive named 'PAS.ARF', type:
**
** MK_ARC *.PAS PAS.ARF
*)
program MK_ARC;
uses dos, crt, memory, rw_io, hex_io, lzw_errs, LZW4P;
type
String12 = String[12];
AllocMemoryType = function(Size : Word) : Pointer;
FreeMemoryType = function(P : Pointer; Size : Word) : Integer;
Var
InpFileName : String12;
OutFileName : String12;
MemoryP : Pointer;
AllocMemoryP : Pointer;
FreeMemoryP : Pointer;
ReaderP : Pointer;
WriterP : Pointer;
Size : Integer;
Code : Integer;
i, x : Integer;
DirInfo : SearchRec;
Ratio : Real;
ReaderCnt : Real;
WriterCnt : Real;
Count : Integer;
AccumCnt : LongInt;
begin
(* get file specs *)
if ParamCount <> 2 then
begin
writeln('Usage: MK_ARC <file_specs> <arc_file>');
halt;
end;
(* sign on *)
writeln('MK_ARC 1.0: Type any key to abort...');
writeln;
Count := 0;
(* open output *)
OutFileName := ParamStr(2);
(* force to upper case *)
for i := 1 to Length(OutFileName) do OutFileName[i] := UpCase(OutFileName[i]);
Code := WriterOpen(OutFileName);
if Code <> 0 then
begin
writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
halt;
end;
(* get pointers *)
AllocMemoryP := @AllocMemory;
FreeMemoryP := @FreeMemory;
ReaderP := @Reader;
WriterP := @Writer;
(* Initialize LZW *)
Code := InitLZW(AllocMemoryP);
(* consider each input file *)
FindFirst(ParamStr(1),0,DirInfo);
while DosError = 0 do
begin (* while *)
InpFileName := DirInfo.Name;
(*writeln('<',InpFileName,'>');*)
if KeyPressed then
begin
writeln;
writeln('Aborted by USER');
Halt;
end;
(* don't compress output file ! *)
if InpFileName = OutFileName then
begin
writeln('WARNING: Input file ',InpFileName,' same as output (skipping)');
end
else
begin
(* write file name to disk *)
for i := 1 to Length(InpFileName) do Code := Writer(ord(InpFileName[i]));
Code := Writer(0);
(* compress this file *)
Count := Count + 1;
(* open input file for compress *)
Code := ReaderOpen(InpFileName);
if Code <> 0 then
begin
writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
halt;
end;
(* compress *)
write('COMPRESSING ',InpFileName:12,' ');
AccumCnt := WriterCount;
Code := Compress(ReaderP,WriterP);
if Code < 0 then
begin
SayError(Code);
Halt;
end;
(* report compression ratio *)
if ReaderCount > 0 then
begin
ReaderCnt := ReaderCount;
WriterCnt := WriterCount - AccumCnt;
Ratio := WriterCnt / ReaderCnt;
writeln('OK ',Ratio:6:2);
end
else writeln('???');
(* close input file *)
Code := ReaderClose;
end;
(* get next filename *)
FindNext(DirInfo);
end; (* while *)
(* close output *)
Code := WriterClose;
(* Terminate LZW *)
writeln(Count,' files archived.');
Code := TermLZW(FreeMemoryP);
end.