home *** CD-ROM | disk | FTP | other *** search
- (*
- ** 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;
- BitCode : Integer;
- begin
- (* get file specs *)
- if (ParamCount <> 1) and (ParamCount <> 2) then
- begin
- writeln('Usage: TEST_LZW <filespec>');
- halt;
- end;
- (* sign on *)
- writeln('TEST_LZW 1.1: Type any key to abort...');
- writeln;
- Count := 0;
- BitCode := 0;
- (* get pointers *)
- AllocMemoryP := @AllocMemory;
- FreeMemoryP := @FreeMemory;
- ReaderP := @Reader;
- WriterP := @Writer;
- (* Initialize LZW *)
- if ParamCount = 2 then Val(ParamStr(2),BitCode,Code)
- else BitCode := 14;
- writeln('BitCode=',BitCode);
- Code := InitLZW(AllocMemoryP,BitCode);
- if Code < 0 then
- begin
- SayError(Code);
- Halt;
- end;
- 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.