home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
LZW4P12.ZIP
/
TEST_LZW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-21
|
6KB
|
205 lines
(*
** TEST_LZW.PAS Copyright (C) 1992 by MarshallSoft Computing, Inc.
**
** This program is used to compress, expand, and verify each specified
** file. It's purpose is for you to test the LZW4P library on your own
** files. Your files are never modified. However, you should NOT have a
** file named "XXX.XXX" or "YYY.YYY". Compression ratios are printed
** for each file compressed. For example, to compress all files ending
** in *.PAS in your current directory, type:
**
** TEST_LZW *.PAS
*)
program TEST_LZW;
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
FileName : String12;
InpFileName : String12;
OutFileName : String12;
Inp1FileName : String12;
Inp2FileName : String12;
MemoryP : Pointer;
AllocMemoryP : Pointer;
FreeMemoryP : Pointer;
ReaderP : Pointer;
WriterP : Pointer;
Size : Integer;
Code : Integer;
i, x : Integer;
DirInfo : SearchRec;
F1, F2 : file;
Buffer1 : array [1..1024] of Byte;
Buffer2 : array [1..1024] of Byte;
NumRead1 : Integer;
NumRead2 : Integer;
Index : LongInt;
Ratio : Real;
ReaderCnt : Real;
WriterCnt : Real;
Count : Integer;
begin
(* get file specs *)
if ParamCount <> 1 then
begin
writeln('Usage: TEST_LZW <filespec>');
halt;
end;
(* sign on *)
writeln('TEST_LZW 1.0: Type any key to abort...');
writeln;
Count := 0;
(* get pointers *)
AllocMemoryP := @AllocMemory;
FreeMemoryP := @FreeMemory;
ReaderP := @Reader;
WriterP := @Writer;
(* Initialize LZW *)
Code := InitLZW(AllocMemoryP);
writeln;
(* consider each file in FileSpec *)
FindFirst(ParamStr(1),0,DirInfo);
while DosError = 0 do
begin (* while *)
FileName := DirInfo.Name;
(*writeln('<',FileName,'>');*)
if (FileName<>'XXX.XXX') and (FileName<>'YYY.YYY') then
begin (* process file *)
if KeyPressed then
begin
writeln;
writeln('Aborted by USER');
Halt;
end;
Count := Count + 1;
InpFileName := FileName;
OutFileName := 'XXX.XXX';
(***** COMPRESSION *****)
(* open input file for compress *)
Code := ReaderOpen(InpFileName);
if Code <> 0 then
begin
writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
halt;
end;
(* open output *)
Code := WriterOpen(OutFileName);
if Code <> 0 then
begin
writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
halt;
end;
(* compress *)
write('COMPRESSING ',FileName:12,' ');
Code := Compress(ReaderP,WriterP);
if Code < 0 then
begin
SayError(Code);
end;
(* report compression ratio *)
if ReaderCount > 0 then
begin
ReaderCnt := ReaderCount;
WriterCnt := WriterCount;
Ratio := WriterCnt / ReaderCnt;
writeln('OK',Ratio:6:2);
end
else writeln('???');
(* close input & output *)
Code := ReaderClose;
Code := WriterClose;
(***** EXPANSION *****)
InpFileName := 'XXX.XXX';
OutFileName := 'YYY.YYY';
(* open input file for expansion *)
Code := ReaderOpen(InpFileName);
if Code <> 0 then
begin
writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
halt;
end;
(* open output *)
Code := WriterOpen(OutFileName);
if Code <> 0 then
begin
writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
halt;
end;
(* expand *)
write(' EXPANDING ',FileName:12,' ');
Code := Expand(ReaderP,WriterP);
if Code < 0 then
begin
SayError(Code);
end;
(* close input & output *)
Code := ReaderClose;
Code := WriterClose;
writeln('OK');
(*** COMPARING ***)
Inp1FileName := DirInfo.Name;
Inp2FileName := 'YYY.YYY';
(* open 1st input *)
Assign(F1,Inp1FileName);
{$I-}
Reset(F1,1);
{$I+}
if IOResult <> 0 then
begin
writeln('Cannot open ',Inp1FileName,' for input. IOResult = ',IOResult);
halt;
end;
(* open 2nd input *)
Assign(F2,Inp2FileName);
{$I-}
Reset(F2,1);
{$I+}
if IOResult <> 0 then
begin
writeln('Cannot open ',Inp2FileName,' for input. IOResult = ',IOResult);
halt;
end;
(* compare file byte for byte *)
write(' COMPARING ',FileName:12,' ');
Index := 0;
repeat
(* input 1st buffer *)
BlockRead(F1,Buffer1,Sizeof(Buffer1),NumRead1);
BlockRead(F2,Buffer2,Sizeof(Buffer2),NumRead2);
if NumRead1 <> NumRead2 then
begin
writeln('Error comparing files');
Halt;
end;
for i:= 1 to NumRead1 do
begin
Index := Index + 1;
if Buffer1[i] <> Buffer2[i] then
begin
writeln('Mismatch: Index=',Index,',Byte1=');
WriteHexByte(Buffer1[i]);
writeln(',Byte2=');
WriteHexByte(Buffer2[i]);
Halt;
end;
end;
until (NumRead1=0) or (NumRead2=0);
writeln('OK');
writeln;
close(F1);
close(F2);
end; (* process file *)
(* get next filename *)
FindNext(DirInfo);
end; (* while *)
(* Terminate LZW *)
writeln(Count,' files processed.');
Code := TermLZW(FreeMemoryP);
end.