[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]

Program TestComp;  { tests Compression }

{ kludgy test of Compress Unit }

Uses Crt, Dos, Compress;

Const
  NumofStrings = 5;

Var
  ch : Char;
  LongestStringLength,i,j,len : Integer;
  Textfname,Compfname : String;
  TextFile : Text;
  ByteFile : File;
  CompArr : tCompressedStringArray;
  st : Array[1..NumofStrings] of String;
  Rec : SearchRec;
  BigArr : Array[1..5000] of Byte;
  Arr : Array[1..NumofStrings] of tCompressedStringArray;

begin
  Writeln('note:  No I/O checking in this test.');
  Write('Test <C>ompress or <U>nCompress? ');
  Repeat
    ch := upCase(ReadKey);
  Until ch in ['C','U',#27];
  if ch = #27 then halt;
  Writeln(ch);
  if ch = 'C' then begin
    Writeln('Enter ',NumofStrings,' Strings:');
    LongestStringLength := 0;
    For i := 1 to NumofStrings do begin
      Write(i,': ');
      readln(st[i]);
      if length(st[i]) > LongestStringLength then
        LongestStringLength := length(st[i]);
    end;
    Writeln;
    Writeln('Enter name of File to store unCompressed Strings in.');
    Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');
    readln(Textfname);
    assign(TextFile,Textfname);
    reWrite(TextFile);
    For i := 1 to NumofStrings do
      Writeln(TextFile,st[i]);
    close(TextFile);
    Writeln;
    Writeln('Enter name of File to store Compressed Strings in.');
    Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');
    readln(Compfname);
    assign(ByteFile,Compfname);
    reWrite(ByteFile,1);
    For i := 1 to NumofStrings do begin
      CompressString(st[i],CompArr,len);
      blockWrite(ByteFile,CompArr,len);
    end;
    close(ByteFile);
    FindFirst(Textfname,AnyFile,Rec);
    Writeln;
    Writeln;
    Writeln('Size of Text File storing Strings: ',Rec.Size);
    Writeln;
    Writeln('Using Typed Files, a File of Type String[',
             LongestStringLength,
             '] would be necessary.');
    Writeln('That would be ',
             (LongestStringLength+1)*NumofStrings,
             ' long, including length Bytes.');
    Writeln;
    FindFirst(Compfname,AnyFile,Rec);
    Writeln('Size of the Compressed File: ',Rec.Size);
    Writeln;
    Writeln('Now erase the Text File, and run this Program again, choosing');
    Writeln('<U>nCompress to show that the Compression retains all info.');
  end else begin                        { ch = 'U' }
    Write('Name of Compressed File: ');
    readln(Compfname);
    assign(ByteFile,Compfname);
    reset(ByteFile,1);
    blockread(ByteFile,BigArr,Filesize(ByteFile));
    close(ByteFile);
    For j := 1 to NumofStrings do begin
      i := 1;
      While BigArr[i] <> 0 do inc(i);
      move(BigArr[1],Arr[j],i);
      move(BigArr[i+1],BigArr[1],sizeof(BigArr));
    end;
    For i := 1 to NumofStrings do
      st[i] := GetCompressedString(Arr[i]);
    For i := 1 to NumofStrings do
      Writeln(st[i]);
  end;
end.

[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]