Program Squeeze; (* Written: 01/29/1986 17:31:13 *) { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] Program Squeeze [] [] [] [] A file compression program. Compatible with CP/M or DOS, Turbo [] [] Pascal Version 2.0 and above. [] [] [] [] [] [] Bob Berry, CompuServe 76555,167 [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } Const Version = 'Version 2.1 Last Update 01/29/1986'; PrinterToggle = '/P'; FormFeed = ^L; Space = ' '; Error = -1; Null = -2; Recognize = $FF76; DLE = #$90; SPEOF = 256; { special endfile token } NumVals = 257; { 256 data values plus SPEOF } NumNodes = 513; { 2*NUMVALS-1 = number of nodes } NoChild = -1; { indicates end of path } MaxCount = MAXINT; { biggest UNSIGNED integer } Type FileName = String[30]; ValType = Array[0..NumVals] of integer; StateTypes = (NoHist,SentChar,SendNewC, SendCnt,EndFile); NodeType = Record Weight: real; Tdepth: integer; LChild, RChild: integer; end; FlePtr = ^FileLst; FileLst = Record FNme: FileName; NxtF: FlePtr; end; Var InFileName, OutFileName, FMask, DrivePrefix, OutDrive: FileName; InFileSize, OutFileSize: real; Finish, i, Crc, DcTreeHd, LikeCt: integer; HeapTop: ^Integer; FFirst, FLast, FCurrent: FlePtr; LoggedDrive, LastChar, NewChar: char; State: StateTypes; PrinterEcho, EOFile, EOFlag, AllDone, Done: boolean; Node: array[0..NumNodes] of NodeType; { This is the encoding table: The bit strings have first bit in = low bit. Note that counts were scaled so code fits UNSIGNED integer } CodeLen, Code: array[0..numvals] of integer; { number of bits in code & code itself, right adjusted } TCode, { temporary code value } CurIn, { Value currently being encoded } CBitsRem, { Number of code string bits remaining } CCode: integer; { Current code shifted so next code bit is at right } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] Pick one: CP/M or DOS and comment out the one that doesn't apply [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } (* {$I cpm.inc } *) {$I dos.inc } {$I sqzmain.inc } Procedure Compress(Var TheString: FileName); begin While Pos(' ',TheString) > 0 do Delete(TheString,Pos(' ',TheString),1); end; { Procedure Compress } Procedure Squeeze; Var C: Char; begin InFileName:=DrivePrefix+InFileName; OutFileName:=InFileName; If Length(OutDrive)>0 then OutFileName[1]:=UpCase(OutDrive[1]); While (Pos('.',OutFileName)+3)>Length(OutFileName) do OutFileName:=OutFileName+Space; Finish:=succ(Pos('.',OutFileName)); OutFileName[succ(Finish)]:='Q'; If OutFileName[Finish]=Space then begin OutFileName[Finish]:='Q'; OutFileName[succ(succ(Finish))]:='Q'; end; Assign(InFile,InFileName); Reset(InFile); InFileSize:=TheSizeOf(InFile); If InFileSize=0 then begin WriteLn('Input file ',InFileName,' is empty.'); CloseInFile; end else begin WriteLn; WriteLn('The file ',InFileName,' (',InFileSize:6:0, ' bytes ) is being squeezed to ',OutFilename); InitializeHuffman; WriteLn('.'); Assign(OutFile,OutFileName); ReWriteOutFile; Write('Pass 2: Squeezing,'); CloseInFile; ResetInFile; EOFile:=false; EOFlag:=false; Write(' header,'); WriteHeader; Write(' body,'); State:=NoHist; Done:=false; C:=GetHuff; While not Done do begin WriteOutFile(C); C:=GetHuff; end; CloseInFile; CloseOutFile; OutFileSize:=GetSizeOfOutFile; WriteLn(' Done.'); WriteLn('The file ',OutFileName,' is',OutFileSize:6:0, ' bytes (',(100.0*OutFileSize/InFileSize):5:1,'%).'); end; end; { Procedure Squeeze } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] Squeeze MainLine [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } begin ClrScr; GetLoggedDrive; If CommandLine > '' then { Get InFileName from Command Line } begin WriteLn; InFileName:=CommandLine; For i:=1 to Length(InFileName) do InFileName[i]:=UpCase(InFileName[i]); PrinterEcho:= ( Pos(PrinterToggle,InFileName) > 0 ); If PrinterEcho then begin SetEchoToPrinter; Delete(InFileName,Pos(PrinterToggle,InFileName),2); end; Compress(InFileName); end else begin InFileName:=''; PrinterEcho:=False; end; Write('File Squeezer'); For i:=1 to 66-Length(Version) do Write(Space); WriteLn(Version); Repeat { Until AllDone } AllDone:=false; If InFileName='' then begin WriteLn; Write('Enter file to squeeze ( or to exit ) >'); ReadLn(InFileName); For i:=1 to Length(InFileName) do InFileName[i]:=UpCase(InFileName[i]); Compress(InFileName); end; If Pos('.',InFileName)=0 then InFileName:=InFileName+'.'; If Pos(':',InFileName)=0 then InFileName:=LoggedDrive+':'+InFileName; DrivePrefix:=Copy(InFileName,1,2); If Length(InFileName)<4 then AllDone:=true { <== Blank name, AllDone } else begin Mark(HeapTop); FindFiles(InFileName); If FFirst=Nil then WriteLn('Input file(s) ',InFileName,' not found.') else begin Write('Output Drive ( or for ',DrivePrefix,' ) >'); ReadLn(OutDrive); Repeat { Until InFileName='' } InFileName:=NextFile; If InFileName > '' then Squeeze; Until InFileName=''; end; Release(HeapTop); end; InFileName:=''; Until AllDone; If PrinterEcho then Write(Lst,FormFeed); end.