home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / SQZTURBO.LBR / USQZ.PAS < prev    next >
Pascal/Delphi Source File  |  2000-06-30  |  10KB  |  240 lines
  1. Program UnSqueeze;                          (* Written: 01/29/1986  15:59:57 *)
  2.  
  3.  {
  4.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  5.  []                        Program UnSqueeze                           []
  6.  []                                                                    []
  7.  []    A file de-compression program. Compatible with CP/M or DOS,     []
  8.  [] Turbo Pascal Version 2.0 and above.                                []
  9.  []                                                                    []
  10.  []                                                                    []
  11.  []                            Bob Berry, CompuServe 76555,167         []
  12.  []                                                                    []
  13.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  14.  }
  15.  
  16. Const Version                         = 'Version 2.1  Last Update 01/29/1986';
  17.       PrinterToggle                   = '/P';
  18.       FormFeed                        = ^L;
  19.       Recognize                       = $FF76;
  20.       Recognize2                      = $FFFA;
  21.       NumVals                         = 257;     { max tree size + 1 }
  22.       SpEOF                           = 256;     { special end of file marker }
  23.       DLE: char                       = #$90;
  24.       Space                           = ' ';
  25.  
  26. Type  Tree                            = array [0..255,0..1] of integer;
  27.       HexStr                          = string[4];
  28.       FileName                        = string[30];
  29.       FlePtr                          = ^FileLst;
  30.       FileLst                         = Record
  31.                                           FNme: FileName;
  32.                                           NxtF: FlePtr;
  33.                                         end;
  34.  
  35. Var   InFileName,
  36.       OutFileName,
  37.       FMask,
  38.       FileDateString,
  39.       AnotherString,
  40.       DrivePrefix,
  41.       OutDrive:                         FileName;
  42.  
  43.       InFileSize,
  44.       OutFileSize:                      real;
  45.  
  46.       DNode:                            Tree;
  47.  
  48.       InChar, CurIn,
  49.       FileCkSum, Crc, BPos,
  50.       FileDate, FileTime,
  51.       i, RepCt, NumNodes:               integer;
  52.  
  53.       HeapTop:                          ^Integer;
  54.       FFirst, FLast, FCurrent:          FlePtr;
  55.  
  56.       LoggedDrive,
  57.       C, LastChar:                      char;
  58.  
  59.       PrinterEcho, AllDone,
  60.       EoFile:                           boolean;
  61.  
  62.  {
  63.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  64.  []  Pick One: CP/M or DOS and comment out the one that doesn't apply  []
  65.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  66.  }
  67.  
  68. (*
  69. {$I cpm.inc   }
  70. *)
  71. {$I dos.inc    }
  72.  
  73. {$I usqzmain.inc }
  74.  
  75. Procedure Compress(Var TheString: FileName);
  76.   begin
  77.     While Pos(' ',TheString) > 0 do Delete(TheString,Pos(' ',TheString),1);
  78.   end;   { Procedure Compress }
  79.  
  80. Procedure UnSqueeze;
  81.   begin
  82.     NumNodes:=ord(GetW);
  83.     If (NumNodes<0) or (NumNodes>=NumVals) then
  84.       begin
  85.         WriteLn('File has invalid decode tree size.');
  86.         CloseInFile;
  87.       end
  88.     else
  89.       begin
  90.         Assign(OutFile,OutFileName); ReWriteOutFile;
  91.         WriteLn;
  92.         WriteLn('The file ',InFileName,' (',InFileSize:6:0,
  93.                                ' bytes ) is being UnSqueezed to ',OutFilename);
  94.         DNode[0,0]:=-(succ(SpEOF));
  95.         DNode[0,1]:=-(succ(SpEOF));
  96.         NumNodes:=pred(NumNodes);
  97.         For i:=0 to NumNodes do begin DNode[i,0]:=GetW; DNode[i,1]:=GetW; end;
  98.         Crc:=0;
  99.         If FileDateString>'' then Write('[ File Date: ',FileDateString,' ] ');
  100.         Write('UnSqueezing,');
  101.         While not EOF(InFile) or (not EoFile) do
  102.           begin
  103.             C:=GetCr;
  104.             If not EoFile then begin WriteOutFile(C); Crc:=Crc+ord(C); end;
  105.           end;
  106.         CloseInFile; CloseOutFile;
  107.         WriteLn(' Done.');
  108.         If Crc<>FileCkSum then
  109.           begin
  110.             WriteLn('File CheckSum Was ',Hex(FileCkSum),', Is ',Hex(Crc));
  111.           end;
  112.         OutFileSize:=GetSizeOfOutFile;
  113.         WriteLn('The file ',OutFileName,' is',OutFileSize:6:0,
  114.                           ' bytes (',(100.0*OutFileSize/InFileSize):5:1,'%).');
  115.       end;
  116.   end;   { Procedure UnSqueeze }
  117.  
  118.  {
  119.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  120.  []                        UnSqueeze MainLine                          []
  121.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  122.  }
  123.  
  124. begin
  125.   ClrScr; GetLoggedDrive;
  126.   If CommandLine > '' then                 { Get InFileName from Command Line }
  127.     begin
  128.       WriteLn;
  129.       InFileName:=CommandLine; 
  130.       For i:=1 to Length(InFileName) do
  131.         InFileName[i]:=UpCase(InFileName[i]);
  132.       PrinterEcho:= ( Pos(PrinterToggle,InFileName) > 0 );
  133.       If PrinterEcho then
  134.         begin
  135.           SetEchoToPrinter; Delete(InFileName,Pos(PrinterToggle,InFileName),2);
  136.         end;
  137.       Compress(InFileName);
  138.     end
  139.   else
  140.     begin
  141.       InFileName:=''; PrinterEcho:=False;
  142.     end;
  143.  
  144.   Write('File UnSqueezer');
  145.   For i:=1 to 64-Length(Version) do Write(Space); WriteLn(Version);
  146.  
  147.   Repeat
  148.     AllDone:=false;
  149.     If InFileName='' then
  150.       begin
  151.         WriteLn; Write('Enter file to UnSqueeze ( or <cr> to exit ) >');
  152.         ReadLn(InFileName);
  153.         For i:=1 to Length(InFileName) do InFileName[i]:=UpCase(InFileName[i]);
  154.         Compress(InFileName);
  155.       end;
  156.  
  157.     If Pos('.',InFileName)=0 then InFileName:=InFileName+'.';
  158.     If Pos(':',InFileName)=0 then InFileName:=LoggedDrive+':'+InFileName;
  159.     DrivePrefix:=Copy(InFileName,1,2);
  160.     If Length(InFileName)<4 then AllDone:=true       { <= Blank name, AllDone }
  161.     else
  162.       begin
  163.         Mark(HeapTop); FindFiles(InFileName);
  164.  
  165.         If FFirst=Nil then
  166.           WriteLn('Input file(s) ',InFileName,' not found.')
  167.         else
  168.           begin
  169.             Write('Output Drive ( or <cr> for ',InFileName[1],': ) >');
  170.             ReadLn(OutDrive);
  171.             Repeat { Until InFileName='' }
  172.               InFileName:=NextFile;
  173.               If InFileName>'' then
  174.                 begin
  175.                   InFileName:=DrivePrefix+InFileName;
  176.                   OutFileName:=Copy(InFileName,1,2);
  177.                   If Length(OutDrive)>0 then
  178.                     OutFileName[1]:=UpCase(OutDrive[1]);
  179.                   Assign(InFile,InFileName); Reset(InFile);
  180.                   InFileSize:=TheSizeOf(InFile);
  181.                   If InFileSize=0 then
  182.                     begin
  183.                       WriteLn('Input file ',InFileName,' is empty.');
  184.                       CloseInFile;
  185.                     end
  186.                   else
  187.                     begin
  188.                       CloseInFile; ResetInFile;
  189.                       RepCt:=0; BPos:=99; EoFile:=false;
  190.                       FileDateString:=''; AnotherString:='';
  191.                       i:=GetW;
  192.                       Case i of
  193.                          Recognize: begin
  194.                                       FileCkSum:=GetW;
  195.                                       Repeat { Until InChar=0 }
  196.                                         InChar:=GetI;
  197.                                         If InChar<>0 then
  198.                                           OutFileName:=OutFileName+Chr(InChar);
  199.                                       Until InChar=0;
  200.                                       UnSqueeze;
  201.                                     end;
  202.                         Recognize2: begin
  203.                                       Repeat { Until InChar=0 }
  204.                                         InChar:=GetI;
  205.                                         If InChar<>0 then
  206.                                           OutFileName:=OutFileName+Chr(InChar);
  207.                                       Until InChar=0;
  208.                                       Repeat { Until InChar=0 }
  209.                                         InChar:=GetI;
  210.                                         If InChar<>0 then
  211.                                           FileDateString:=FileDateString+
  212.                                                                    Chr(InChar);
  213.                                       Until InChar=0;
  214.                                       Repeat { Until InChar=0 }
  215.                                         InChar:=GetI;
  216.                                         If InChar<>0 then
  217.                                           AnotherString:=AnotherString+
  218.                                                                    Chr(InChar);
  219.                                       Until InChar=0;
  220.                                       InChar:=GetI;          { ^Z (ASCII EOF) }
  221.                                       FileCkSum:=GetW;
  222.                                       FileDate:=GetW;
  223.                                       FileTime:=GetW;
  224.                                       UnSqueeze;
  225.                                     end;
  226.                               Else  begin
  227.                                       CloseInFile;
  228.                                       WriteLn('I don''t recognize ',InFileName,
  229.                                                      ' as a squeezed file.');
  230.                                     end;
  231.                       end;   { Case i }
  232.                     end;
  233.                 end;
  234.             Until InFileName='';
  235.           end;
  236.       end;
  237.     InFileName:='';
  238.   Until AllDone;
  239.   If PrinterEcho then Write(Lst,FormFeed);
  240. end.