H-READ ME à9CPM INC@l¶DOS INCW/9SQZ PAS†?=@SQZMAIN INCÅy/ETURBOSQZDQC><rUSQZ PASzKa›USQZMAININCÅ ¯ÿ ÿ ÿ [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] [] [] SQZ.PAS USQZ.PAS CPM.INC TURBOSQZ.DQC [] [] SQZMAIN.INC USQZMAIN.INC DOS.INC [] [] [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] Turbo Pascal (Version 2.x or 3.x) source for a CP/M or MsDos/PcDos file "Squeezer" and "UnSqueezer". These file compression programs are compatible with CP/M public domain SQ.COM and USQ.COM (the "old-timers' standard"), as well as a recent MsDos public domain Squeezer, which stores the original file date and time. File CheckSums are developed and verified. The CPM.INC or DOS.INC files provide source compatibility between CP/M and MSDOS/PCDOS. Usage notes: (Sqz and USqz are parallel in operation.) 1 A file name (including wildcards) may be entered on the command line: A>SQZ *.PAS A>USQZ B:*.?Q? 2 Printer Echo may be turned on: A>SQZ *.PAS /P A>USQZ /P 3 If no file name was entered, you will be prompted for one (again, may include wildcards.) 4 Respond to prompt 3 with a blank file name (just ) to exit the program. 5 If the file/(s) are not found you return to prompt 3. 6 If the file(s) are found you may specify a different output drive. 7 File statistics are displayed, showing input and output file sizes and the output file size as a percentage of the input file size. 8 The CheckSum of the original file is stored upon Squeezing, and verified upon UnSqueezing (any discrepancy is displayed.) 9 When the file / all files have been processed, you return to prompt 3 to continue with more, or to exit. For a relatively complete version history and some specific programming notes, see TURBOSQZ.DOC, which is included in this library in squeezed form: USQZ TURBOSQZ.DQC Bob Berry CompuServe 76555,167 { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] The Squeeze/UnSqueeze CP/M routines. [] [] [] [] CP/M files are all multiples of 128 byte records. I/O must be [] [] handled with BlockRead and BlockWrite. Files opened for input [] [] only do not need to be closed. The file size in bytes (real) [] [] must be calculated as (turbo function) FileSize * 128.0 [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } Const CommandLineLoc = $80; DisplayCharacter = $02; PrintCharacter = $05; SearchForFirst = $11; SearchForNext = $12; ReturnLoggedDrive = $19; SetDMA = $1A; Type AFile = File; FCBType = Array[0..31] of Char; DMAType = Record Drive: Byte; FName: Array[1..11] of Char; Extnt: Byte; Rsrvd: Array[0..1] of Byte; RcCnt: Byte; Block: Array[1..8] of Integer; end; Var CommandLine: String[127] Absolute CommandLineLoc; InFile, OutFile: AFile; DMA: Array[0..3] of DMAType; FCB: FCBType; InBuffer, OutBuffer: Array[1..128] of Char; InBuffPointer, OutBuffPointer: Byte; Procedure GetLoggedDrive; begin LoggedDrive:=chr(BDOS(ReturnLoggedDrive)+ord('A')); end; { Procedure GetLoggedDrive } Procedure FindFiles(FileMask: FileName); Var FoundFile: FileName; FCBDone, DoingExt: Boolean; SearchFunction, SearchReturn, NByte: Byte; begin FillChar(FCB,SizeOf(FCB),0); For i:=1 to 11 do FCB[i]:=' '; FCB[0]:=Chr(Ord(FileMask[1])-Ord('@')); { eg. A: -> 1 } FCBDone:=False; i:=2; NByte:=1; DoingExt:=False; While not FCBDone do begin i:=Succ(i); If i > Length(FileMask) then FCBDone:=true else Case FileMask[i] of ^@..' ', '_', ';', ':', '=', '<', '>': FCBDone:=true; '.': If DoingExt then FCBDone:=True else begin DoingExt:=True; NByte:=9; end; '*': If DoingExt then begin FCBDone:=True; While NByte<12 do begin FCB[NByte]:='?'; NByte:=Succ(NByte); end; end else begin While NByte<9 do begin FCB[NByte]:='?'; NByte:=Succ(NByte); end; end; else If (DoingExt and (NByte<12)) or (NByte<9) then begin FCB[NByte]:=FileMask[i]; NByte:=Succ(NByte); end; end; { Case FileMask[i] } end; FFirst:=Nil; FLast:=Nil; BDOS(SetDMA,Addr(DMA)); SearchFunction:=SearchForFirst; Repeat { Until SearchReturn>3 } SearchReturn:=BDOS(SearchFunction,Addr(FCB)); If SearchReturn<4 then begin FoundFile:=''; For i:=1 to 8 do If DMA[SearchReturn].FName[i]<> ' ' then FoundFile:=FoundFile+DMA[SearchReturn].FName[i]; FoundFile:=FoundFile+'.'; For i:=9 to 11 do If DMA[SearchReturn].FName[i]<> ' ' then FoundFile:=FoundFile+DMA[SearchReturn].FName[i]; New(FCurrent); FCurrent^.FNme:=FoundFile; FCurrent^.NxtF:=Nil; If FFirst=Nil then FFirst:= FCurrent else FLast^.NxtF:= FCurrent; FLast:=FCurrent; SearchFunction:=SearchForNext; end; Until SearchReturn>3; FCurrent:=FFirst; end; { Procedure FindFiles } Function NextFile: FileName; begin If FCurrent=Nil then NextFile:='' else begin NextFile:=FCurrent^.FNme; FCurrent:=FCurrent^.NxtF; end; end; { Function NextFile } Procedure WriteCharToCon(AChar: Char); begin BDOS(DisplayCharacter,Ord(AChar)); BDOS(PrintCharacter, Ord(AChar)); end; { Procedure WriteCharToCon } Procedure SetEchoToPrinter; begin ConOutPtr:=Addr(WriteCharToCon); end; { Procedure SetEchoToPrinter } Function TheSizeOf(Var TheFile: AFile): Real; { CP/M must calculate } begin TheSizeOf:=(128.0*FileSize(TheFile)); end; { Function TheSizeOf } Procedure ResetInFile; { CP/M: do reset and initialize pointer } begin Reset(InFile); InBuffPointer:=129; end; { Procedure ResetInFile } Procedure ReadInFile(Var C: Char); { CP/M move char from buffer, read block } begin If InBuffPointer>128 then begin BlockRead(InFile,InBuffer,1); InBuffPointer:=1; end; C:=InBuffer[InBuffPointer]; InBuffPointer:=succ(InBuffPointer); end; { Procedure ReadInFile } Function GetC: Char; { CP/M return next char or EOFile } var C: Char; begin If ((InBuffPointer>128) and EOF(InFile)) then EOFile:=true else begin ReadInFile(c); crc:=crc+ord(C); end; GetC:=C; end; { Function GetC } Procedure CloseInFile; { CP/M doesn't need to close } begin end; { Procedure CloseInFile } Procedure InitializeOutBuffer; { Fill Buffer with ^Z's } begin FillChar(OutBuffer,SizeOf(OutBuffer),26); OutBuffPointer:=1; end; { Procedure InitializeOutBuffer } Procedure ReWriteOutFile; { CP/M reset drives, do ReWrite, init pointer } begin BDOS(13); BDOS(14,ord(LoggedDrive)-ord('A')); ReWrite(OutFile); InitializeOutBuffer; end; { Procedure ReWriteOutFile } Procedure WriteOutFile(Var C: Char); { CP/M move char to buffer, write block } begin If OutBuffPointer>128 then begin BlockWrite(OutFile,OutBuffer,1); InitializeOutBuffer; end; OutBuffer[OutBuffPointer]:=C; OutBuffPointer:=succ(OutBuffPointer); end; { Procedure WriteOutFile } Procedure CloseOutFile; { CP/M write block before close } begin If OutBuffPointer>1 then BlockWrite(OutFile,OutBuffer,1); Close(OutFile); end; { Procedure CloseOutFile } Function GetSizeOfOutFile: Real; { CP/M doesn't need to close } begin Reset(OutFile); GetSizeOfOutFile:=TheSizeOf(OutFile); end; { Function GetSizeOfOutFile } Pointer:=1; end; { Procedure InitializeOutBuffer } Procedure ReWriteOutFile; { CP/M reset drives, do ReWrite, init pointer } begin BDOS(13); BDOS(14,ord(LoggedDrive)-ord('A')); ReWrite(OutFile); InitializeOutBuffer; end; { Procedure ReWriteOutFile } Procedure WriteOutFile(Var C: Char); { CP/M move char to buffer, write block } begin If OutBuffPointer>128 then begin BlockWrite(OutFile,OutBuffer,1); InitializeOutBuffer; end; OutBuffer[OutBuffPointer]:=C; OutBuffPointer:=succ(OutBuffPointer); end; { Procedure WriteOutFile } Procedure CloseOutFile; { CP/M write block before close } begin If OutBuffPointer>1 then BlockWrite(OutFile,OutBuffer,1); Clo { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] The Squeeze/UnSqueeze MsDos routines. [] [] [] [] DOS files are "file of char", which keeps read/write procedures [] [] simple. DOS Turbo 3.0 must close all file (handles), even if [] [] read only. File sizes are determined with LongFileSize function. [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } Const CommandLineLoc = $80; DisplayCharacter = $0200; PrintCharacter = $0500; ReturnLoggedDrive = $1900; SetDTA = $1A00; FindFirstFile = $4E00; FindNextFile = $4F00; Type AFile = File of Char; FlagType = (CarryFlag, NoFlag2, ParityFlag, NoFlag8, AuxCarryFlag, NoFlag20, ZeroFlag, SignFlag, StepTrapFlag, InterruptFlag, DirectionFlag, OverflowFlag, NoFlag100, NoFlag200, NoFlag400, NoFlag800); FlagSet = Set of FlagType; MsDosRegisters = Record Case Byte of 0: (Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags: Integer); 1: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh: Byte); 2: (RegArray: Array[1..9] of Integer; FlagRegister: FlagSet); end; DTAType = Record Reserved: Array[1..21] of Byte; Attribute: Byte; FileTime, FileDate: Integer; FileSize: Array[0..1] of Integer; FName: Array[1..13] of Char; end; Var CommandLine: String[127] Absolute CSeg:CommandLineLoc; InFile, OutFile: AFile; DTA: DTAType; DosRec: MsDosRegisters; Procedure GetLoggedDrive; begin With DosRec do begin Ax:=ReturnLoggedDrive; MsDos(DosRec); LoggedDrive:=chr(Lo(ax)+65); end; end; { Procedure GetLoggedDrive } Procedure FindFiles(FileMask: FileName); Var FindFile, FoundFile: FileName; begin With DosRec do begin Ax:=SetDTA; Ds:=Seg(DTA); Dx:=Ofs(DTA); MsDos(DosRec); FindFile:=FileMask+#0; FFirst:=Nil; FLast:=Nil; Ax:=FindFirstFile; Repeat { Until CarryFlag in FlagRegister } Ds:=Seg(FindFile[1]); Dx:=Ofs(FindFile[1]); Cx:=0; MsDos(DosRec); If not (CarryFlag in FlagRegister) then begin FoundFile[0]:=#30; Move(DTA.FName,FoundFile[1],13); FoundFile[0]:=Chr(Pred(Pos(#0,FoundFile))); New(FCurrent); FCurrent^.FNme:=FoundFile; FCurrent^.NxtF:=Nil; If FFirst=Nil then FFirst:= FCurrent else FLast^.NxtF:= FCurrent; FLast:=FCurrent; end; Ax:=FindNextFile; Until CarryFlag in FlagRegister; FCurrent:=FFirst; end; end; { Procedure FindFiles } Function NextFile: FileName; begin If FCurrent=Nil then NextFile:='' else begin NextFile:=FCurrent^.FNme; FCurrent:=FCurrent^.NxtF; end; end; { Function NextFile } Procedure WriteCharToCon(AChar: Char); begin With DosRec do begin Ax:=DisplayCharacter; Dl:=Ord(AChar); MsDos(DosRec); Ax:=PrintCharacter; Dl:=Ord(AChar); MsDos(DosRec); end; end; { Procedure WriteCharToCon } Procedure SetEchoToPrinter; begin ConOutPtr:=Ofs(WriteCharToCon); end; { Procedure SetEchoToPrinter } Function TheSizeOf(Var TheFile: AFile): Real; { DOS can use LongFileSize } begin TheSizeOf:=LongFileSize(TheFile); end; { Function TheSizeOf } Procedure ResetInFile; { DOS reads file of char } begin Reset(InFile); end; { Procedure ResetInFile } Procedure ReadInFile(Var C: Char); { DOS just reads the next char } begin Read(InFile,C); end; { Procedure ReadInFile } Function GetC: Char; { DOS get next character } var C: Char; begin If EOF(InFile) then EOFile:=true else begin ReadInFile(c); crc:=crc+ord(C); end; GetC:=C; end; { Function GetC } Procedure CloseInFile; { DOS Turbo 3.0 needs to close the handle } begin Close(InFile); end; { Procedure CloseInFile } Procedure ReWriteOutFile; { DOS just writes a file of char } begin ReWrite(OutFile); end; { Procedure ReWriteOutFile } Procedure WriteOutFile(Var C: Char); { DOS just writes a char } begin Write(OutFile,C); end; { Procedure WriteOutFile } Procedure CloseOutFile; { DOS just closes } begin Close(OutFile); end; { Procedure CloseOutFile } Function GetSizeOfOutFile: Real; { DOS Turbo 3.0 needs to close the handle } begin Reset(OutFile); GetSizeOfOutFile:=TheSizeOf(OutFile); CloseOutFile; end; { Function GetSizeOfOutFile } 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.{ Initialize all nodes to single element binary trees with zero weight and depth. } Procedure ZeroTree; var i: integer; begin For i := 0 to NumNodes do with Node[i] do begin Weight:=0.0; TDepth:=0; LChild:=NoChild; RChild:=NoChild; end; end; { Procedure ZeroTree } Procedure PutWe(w: integer); var b1, b2: char; begin b1 := chr(w and $FF); b2 := chr(w shr 8); WriteOutFile(b1); WriteOutFile(b2); end; { Procedure PutWe } Function GetCNr: char; Var return: char; Function Alike: boolean; begin If EOFile then EOFlag:=true else NewChar:=GetC; If EOFile then Alike:=false else Alike:=( (NewChar=LastChar) and (LikeCt<255) ); end; { Function Alike } Procedure NoHistory; {set up the state machine} begin State:=SentChar; If not EOFile then LastChar:=GetC; EoFlag:=EoFile; If EOFlag then State:=EndFile; Return:=LastChar; end; { Procedure NoHistory } Procedure SentAChar; {LastChar is sent, need lookahead} Procedure SentDLE; begin State:=NoHist; Return:=chr(0); end; { Procedure SentDLE } Procedure CheckAlike; begin LikeCt:=1; While alike do LikeCt:=succ(LikeCt); Case LikeCt of 1: begin LastChar:=NewChar; Return:=LastChar; EoFlag:=EoFile; end; 2: begin { just pass through } State:=SendNewC; Return:=LastChar; end; else begin State:=SendCnt; Return:=DLE; end; end; end; { Procedure CheckAlike } begin If EOFlag then State := EndFile {no return value, set to SPEOF in calling routine} else If LastChar=DLE then SentDLE else CheckAlike; end; { Procedure SentAChar } Procedure SendNewChar; {Previous sequence complete, newchar set} begin EOFlag:=EOFile; State:=SentChar; LastChar:=NewChar; Return:=LastChar; end; { Procedure SendNewChar } Procedure SendCount; {Sent DLE for repeat sequence, send count} begin State:=SendNewC; Return:=chr(LikeCt); end; { Procedure SendCount } begin Case State of NoHist: NoHistory; SentChar: SentAChar; SendNewC: SendNewChar; SendCnt: SendCount; else WriteLn('Program Bug - Bad State!'); end; GetCnr:=Return; end; { Function GetCNr } Procedure WriteHeader; Var i, k, l, r, NumNodes: integer; { NumNodes: nbr of nodes in simplified tree } begin PutWe(Recognize); { identifies as compressed } PutWe(Crc); { unsigned sum of original data } { Record the original file name w/o drive } If (InFileName[2]=':') then InFileName:=copy(InFileName,3,length(InFileName)-2); InFileName:=InFileName+chr(0); {mark end of file name} For i:=1 to Length(InFileName) do WriteOutFile(InFileName[i]); { Write out a simplified decoding tree. Only the interior nodes are written. When a child is a leaf index (representing a data value) it is recoded as -(index + 1) to distinguish it from interior indexes which are recoded as positive indexes in the new tree. Note that this tree will be empty for an empty file. } If DcTreeHd b return true, else return false. } Function CmpTrees(a, b: integer): boolean; {entry with root nodes} begin CmpTrees:=false; If Node[a].Weight>Node[b].Weight then CmpTrees:=true else If Node[a].Weight=Node[b].Weight then If Node[a].TDepth>Node[b].TDepth then CmpTrees:=true; end; { Function CmpTrees } begin k:=succ(2*Top); { left child of top } Temp:=List[Top]; { remember root node of top tree } If (k<=Bottom) then begin If ( k(Ceil-Sum) then OvFlw:=succ(OvFlw); Sum:=Sum+Node[i].Weight; end; Divisor:=succ(Ovflw); { Ensure no non-zero values are lost } Increased:=false; For i:=0 to pred(NumVals) do begin w:=Node[i].Weight; If (w0) then begin { Don't fail to provide a code if it's used at all } Node[i].Weight:=Divisor; Increased:=true; end; end; Until not Increased; { Scaling factor choosen, now scale } If Divisor>1 then For i:=0 to pred(NumVals) do with Node[i] do Weight:=int((Weight/Divisor)+0.5); end; { Procedure Scale } {$A-} { Recursive routine to walk the indicated subtree and level and maintain the current path code in bstree. When a leaf is found the entire code string and length are put into the encoding table entry for the leaf's data value. Returns ERROR if codes are too long. } Function BuildEnc(Level, Root: integer): integer; {returns error or null} Var l, r, Return: integer; begin Return:=Null; l:=Node[Root].LChild; r:=Node[Root].RChild; If (l=NoChild) and (r=NoChild) then begin {have a leaf} CodeLen[Root]:=Level; Code[Root]:=TCode and ($FFFF shr (16-Level)); If Level>16 then Return:=Error else Return:=Null; end else begin If l<>NoChild then begin {Clear path bit and go deeper} TCode:=TCode and not(1 shl Level); If BuildEnc(succ(Level),l)=Error then Return:=Error; end; If r<>NoChild then begin {Set path bit and go deeper} TCode:=TCode or (1 shl Level); If BuildEnc(succ(Level),r)=Error then Return:=Error; end; end; BuildEnc:=Return; end; { Function BuildEnc } {$A+} Procedure BuildTree(Var List: ValType; Len: integer); {Huffman algorithm} Var FreeNode: integer; {next free node in tree} LCh, RCh: integer; {temporaries for left, right children} i: integer; Function Maximum(a, b: integer): integer; begin If a>b then Maximum:=a else Maximum:=b; end; { Function Maximum } begin { Initialize index to next available (non-leaf) node. Lower numbered nodes correspond to leaves (data values). } FreeNode:=NumVals; { Take from list two btrees with least weight and build an interior node pointing to them. This forms a new tree. } While (Len>1) do begin LCh:=List[0]; { This one will be left child } { delete top (least) tree from the list of trees } Len:=pred(Len); List[0]:=List[Len]; Adjust(0,pred(Len),List); { Take new top (least) tree. Reuse list slot later } RCh:=List[0]; { This one will be right child } { Form new tree from the two least trees using a free node as root. Put the new tree in the list. } With Node[FreeNode] do begin LChild:=LCh; RChild:=RCh; Weight:=Node[LCh].Weight+Node[RCh].Weight; TDepth:=succ(Maximum(Node[LCh].TDepth,Node[RCh].TDepth)); end; List[0]:=FreeNode; {put at top for now} FreeNode:=succ(FreeNode); {next free node} { reheap list to get least tree at top } Adjust(0,pred(Len),List); end; DcTreeHd:=List[0]; { head of final tree } end; { Procedure BuildTree } { Initialize the Huffman translation. This requires reading the input file through any preceding translation functions to get the frequency distribution of the various values. } Procedure InitializeHuffman; var c, i: integer; BtList: ValType; { list of intermediate binary trees } ListLen: integer; { length of btlist } Ceiling: integer; { limit for scaling } { Heap and Adjust maintain a list of binary trees as a heap with the top indexing the binary tree on the list which has the least weight or, in case of equal weights, least depth in its longest path. The depth part is not strictly necessary, but tends to avoid long codes which might provoke rescaling. } Procedure Heap(Var List: ValType; l: integer); Var i, len: integer; begin Len:=(l-2) div 2; For i:=Len DownTo 0 do Adjust(i,pred(l),List); end; { Procedure Heap } begin Write('Pass 1: Analysis,'); Crc:=0; ZeroTree; State:=NoHist; EOFile:=false; EOFlag:=false; Repeat { Until EOFlag } { Build frequency info in tree } C:=ord(GetCnr); If EOFlag then C:=SpEOF; With Node[C] do If Weight 16 bits long. } Repeat { Until BuildEnc(0,DcTreeHd) <> Error } If (Ceiling<>MaxCount) then Write(' *** rescaling ***,'); Scale(Ceiling); Ceiling:=Ceiling div 2; {in case we rescale again} ListLen:=0; {find length of list and build single nodes} For i:=0 to pred(NumVals) do If Node[i].Weight>0.0 then begin Node[i].TDepth:=0; BtList[listlen]:=i; ListLen:=succ(ListLen); end; Heap(BtList,pred(ListLen)); Write(' Building tree'); BuildTree(BtList,ListLen); For i:=0 to pred(NumVals) do CodeLen[i]:=0; until (BuildEnc(0,DcTreeHd)<>Error); { PrintList;} { Initialize encoding variables } CBitsRem:=0; CurIn:=0; end; { Procedure InitializeHuffman } { Get an encoded byte or EOF. Reads from specified stream AS NEEDED. There are two unsynchronized bit-byte relationships here: The input stream bytes are converted to bit strings of various lengths via the static variables named Cxxxxx. These bit strings are concatenated without padding to become the stream of encoded result bytes, which this function returns one at a time. The EOF (end of file) is converted to SPEOF for convenience and encoded like any other input value. True EOF is returned after that. } Function GetHuff: char; {returns byte values except for EOF} Var RByte: integer; {Result byte value} Need, Take: integer; {numbers of bits} Return: integer; begin RByte:=0; Need:=8; {build one byte per call} Return:=Error; {start off with an error} { Loop to build a byte of encoded data. Initialization forces read the first time} While Return=Error do begin If CBitsRem>=Need then begin {Current code fullfills our needs} If need = 0 then Return:=RByte and $00FF else begin RByte:=RByte or (CCode shl (8-Need)); {take what we need} CCode:=CCode shr Need; {and leave the rest} CBitsRem:=CBitsRem-Need; Return:=RByte and $00FF; end; end else begin If CBitsRem>0 then begin {We need more than current code} RByte:=RByte or (CCode shl (8-Need)); {take what there is} Need:=Need-CBitsRem; end; If curin=SpEOF then begin CBitsRem:=0; If Need=8 then begin {end of file} Done:=true; Return:=0; {any valid char value} end else Return:=RByte and $00FF; {data first} end else begin CurIn:=ord(GetCnr); If EOFlag then CurIn:=SpEOF; CCode:=Code[CurIn]; CBitsRem:=CodeLen[CurIn]; end; end; end; GetHuff:=chr(Return); end; { Function GetHuff } vÿ!TURBOSQZ.DOCdßÿ šÿ ‹ÿÿ–ÿ‘ÿÿžÿŒÿ“ÿ—ÿ›ÿõÿòÿœÿŠÿ !™ÿ#"$’ÿ%˜ÿ&ÿoÿ')(ÿˆÿ+*-,†ÿÑÿ/.1032546Óÿ7‰ÿ98Öÿ:¼ÿ¬ÿÝÿ;<×ÿÅÿ=?>¯ÿ@ùÿ¹ÿŽÿ«ÿBA…ÿÒÿ½ÿÏÿ²ÿÐÿDCFEÄÿ»ÿG”ÿØÿH¶ÿüÿI¾ÿJ³ÿºÿÎÿKûÿLM±ÿ°ÿÿNO¨ÿQPªÿR®ÿSTøÿ·ÿÍÿU©ÿ¥ÿ‡ÿÕÿúÿ•ÿÂÿÉÿVXWYZ¢ÿÈÿ[¤ÿËÿÀÿ÷ÿÌÿÇÿÁÿ]óÿ^\_`¸ÿéÿ¡ÿÆÿÞÿÊÿcb‚ÿañÿ„ÿÛÿÃÿôÿ¦ÿèÿåÿíÿ´ÿäÿÿþÞóîÉ³FFz&'¼Ók¬°¯{"«Ók¬°ßÊ~G–®ÎÇ2×©„Ru³&B©TQEU¡Ø•e½Ø²åµæXvK· ±º… êo!½[`ïUÖ QEÕµì ~Ùìó)•n¤¿’óp¨¸½Åß#¯o·ä‡wHnÏØdü²ÓXæïl@œ2UÞ¥÷±ñÆ=Âa¿·‡V*éßàádö]t VpË0õ=ðòßÔ‘¥«óO’Û#¸—ÐT¦ÊÛaã}lèï¤2¶þáðVR’>/ÿö–^B^ßçpïÈÒÕù$¹=‚{œ8JETQEÕ5OORædV³ø'ÉmN(ÿ™¼k\k×²k û£^k"ÛÇò”¤OÕµæ'ÉmN#XÖÏë'[Ý‹þÉmNxpŽcoÙ'>ñë¿Cr›öï‘ŒÝ&é—©ºÖ|Q9•.dìIr¼WzE/ÿ³}h°¦4¼å„Z¦ŠªkžZ¿³´bd{ì-»|o‡ËfŸ×H'cW–u^Sš Ì› Ëò39¡“Ð¤ßñäÎ•ªkÍ×Ø‡{&'t²ÞÊ~G–®N™*ª®yj}o‡Ÿ—=ÇÇ2—9ì9ÞrB}oÊä„Kû76A“þ}Ç“ûû²»×¿åª®5ßçp'”Z~'¯ ‡ëTB©7¼1…ìÒÙ`·Œúpxe+\Ú·œp^T]k¾W Tý ¥Þ{Þ=¹Ô/‰/À<äF>V)/ÿÕÆÄ#=äÝû=¦îT]k^Úc’mþIæú#¦ò¬wdéêèóîÉû›õÑ—ŸWÀÇ®ÿˆ?¨ºÖ|>¯ÅËÿ¥ý1&÷¦(Ù0Mo9áM™œpi_Ö4uý!?¬à¶ô‡U×šOâó4Ò¿1É6OX~¸e¾1É6Ÿd^Q~§|®¼ü7erÂ¥}‡»é—EÕµæyÙsü ÃÔ?æÝ“‡ÙÚ˜âáð–w·2ï÷Jziÿpø[NøC¨ºÖü$+¯?}9¯€]Ë÷0bÞ#¥ÒÃq}ŸSú’xìã¼j¥êZóáð·œð÷GýÇóH©ôicÌ-HøÅïM„”…Çg‘òHRÅu>ê?þ¦LNø¥¥êZóeaSWù™²ß‘¥«£8œ—=ÇÇ2—9ì9ÞrB}>×xošW”l˜¦¿å„JÕµæ›29 ©Kÿa>–ysÖûîI¦î¤0ÌÇ2·H2u'¹9P¦ŠªkžZŸ¦yW&ã··L0óFýÇ2;¯)XV½ÖpÃkæ?þ¦âÖMÿ$¹Í ›ªkÍÞ˜‚ÉxÈû²»^ûYº:y÷¤LU×²“äp8T|’ÜÁ=N¥Û[z y}ËÙÂè/—pØ··ø{äïÍþ?lcÃ”©*Ç2ÖÒZ·œ 8\6û¼Fº½Åß#?ç9@*½bÅÃávi?¹±ÇØÿX†ªÀÎy€)ÿÅWéŸÜØc ìú÷Oîïcã6FÀ|Ä±Ì/íßrÂß—9™¿ªbÏkSþ‹¿#KWç-'¼ïxrÇ20ïs¸×Ø¼üKû–Û(xÙ4«o,ÞÙÑ Áe¬¥¥ªå„®÷eNæ=|^Õk¬`òñÊËO8ñ²)¿ø ¥¾å„÷OîXæ}÷ñ›—O•´?ØwQº'Íêû2'óyU¯°ÂC>^yù ÷¤üFB©o9¡ÞÈj_€ùø‰—ÍßÊ¦ª€ÇLý?ê¿á)d—þî€]{LÝ/íÃá Ëwiÿpø[Nøyý½R –»¨*>Åíc?ÜX‡7%ñy©é-'¼1ƒUXæÒ>žFWL!û\¿dç#¥Ò›ü±{ÃGS¹‹*ª®e÷vøe³Ïk¤ßÞâï‘×¿†l˜7Î¶¬W¯°âåw=þ–þÉaê^ç\ÿ÷æ ª‘W`Ë)•ºÝõ²°ù'Éí±yù8ü2‡=ÇßrÂò‡Ã?9LÝëœÿ²¨šWõš+^~ùÞ=!ãMXÆZZë–¾acDmº½¥—s…ùøä0u¯sþcoÙzªúŽ'÷7xË»Æ ×IÈØ0ï;¬jðòoe¿i’ÜÁ=N¥¦¿Ïá~{î%ž¨2’^oìÈÒÕézg7ºD:»)SEÕµìÞŸæ½±âdìÊ².íÃáö¼±v}sÅ—|r˜º×9?ö–]ßH¤³›l~#¨TMSw¢téÿ±ÌÃáö¼~l|’ÜÁ½„÷9Ü;»Ñ%ÒÙMùÅS•‡ÃßdoXW¯°BUc™¿É–Öóª^3`…¦¿å„ú|ÄäŽlÇ©ôÆñœçsþ ¯™7r¬ J×ïí¸þnTªzÀ:›[†y+ûYº:ïs¸wê(wxÔùXæìzì|ŸÃ½Ã£NV¹Ã£N™*ª®e÷vø‹™Û6ëÉ—ÍáòŸë?l{l¬H¥ß€Œ$6Ìo¸m±±"•þvKþ‡U5Æ2c›nwýöÜK<ýFòÁëÝèéìæö¼¾1ÞAª£Y½´‡¿zÍ€ÌßrB¥ÊÈjÏGL®Üõb¤2¶þá¸žë¥ý’Wö·<5AÿQ?ÞrÂ«×XÁ¼ÏáTÙs/ñt#ùàu{‹¿Gþi¬÷ðyU¯°‚yŸÃ=óîÉí-þ¹þc™“yÂÉØuPÕçpÿ’r˜º×9ÿ±·ìªÿÇ2ïs¸‡Ãe{Ž¿å„ÙŽ)RéÏGLŽ—ÿ‡U²Ùç5R™*ª®eÏä5R*éÿ>‡{8ÜÞâï‘×÷ewçå’½1E*éßàñÑ“9ò|tÇÃ!ÿU‰#žPë§9ïaWÉQ¾·Ãe³Ïk¤Û[ü=òú¾ÌÉ¼‡'æc™‡Ãú¨ÝßÊ¦*þ–¾FŽ7.¹½…Ì•e=äö¨õáð–¾FŽ·[ò‡Ã'Éó±ÌŸxAÿJUSñBvv“Í;‹ëd.P&ôØÑTîº·Ãí-þùû2'ópX¯^3`…Ëþ¼ª×Xááð–þ±U=‘xIæ÷ÆÔý!‡×R äå{Ë|, ‡ý–ô/Éü¾ÌÉ¼ÆØñvKþpxSñB6QeoÉí(¿Á‡10ETQu-»õ³¶¹²¬‡¼Ú˜¸-=Þò®ñ–¾FŽËz8|’<Ë<ñB™*ª®e·¾G;XÖH¯6&nyÁ².íÇ ·-6V\æ°ç¸ÙLF™*ª®e·~G–®ÎIÁº°ø¹½AÆŠ[zì<)]ÇÞ²ëe=.sØsÜl&£üF–ùŸÆ¢êZFíû†k÷J”.ª¨º–Ýú…bsËÓ–uio9á“ÃÔ½Îùe}^Õk¬xùeª¨º–Ýú1‚kðT_ôyùo9¡²>–¹=aÅðQ/íe{Ž‡œ—=Ç[N¨eª¨º–Ýú¤`cÄçœ>ÞÔKcuozË _#Ç¹+°aÞèÙ\ã$8íBv•©¢êZvëwÂ{Þè] Ó»áÇ2'é‘‰oà8]ß2/Ô‡|L“ä¹˜x8ÜpÛbcM¨T]Ëè!úÀzG–®ÎÇ2×©„RËTQEU…bW–õbË¯5´,¨[,ñuAÚµ†Ò»ö.Qe‘UT]ËnýâÆÀœ$'Ó1¶yË ¯6&nyÁ²j™*ª®e·~qc`žµyöLNÊTQu-»õÅ®,ëÅ–¾?êí-¹0·7çcs*½Wz8¼•”¤ÏË/¢Šªk™²ÿÆ®ú¿#KWço,ÉüyûYº:]w£þn˜ßž{‰§ßH>xý-'Pu-c’ÜÞ¨•eýö¼þƒ<8^BùZÃÉsY©tá4R‚ù›:»!R @6šþ±U×2šˆxèì†HÙhúÃ¡â··ø{äõ“¬Vvó?þVR’>/ÿoª^3`ÓDÕµŒ–nÐòâ`YETQu-Ã¢¸¥åoY°ècWÀÇÖ?3“XÒŠÑ?^½fÀ æ-'¼¡žªkÄm¬!æ…;-ô×é´¸ìKÚyÝÒRÿÌÌóºeÁ.ª®eX”·,öÖ·lnÑÇ:¯€8¼å„w8LÝ;ç\ÿp8¯€ý‰ªkÄ•ö#¥Onì1v=¯‡Ãe³Ïk¤·œP¦êZ†E)pËnÝúÝîvÑÃá²Ùç5Ò[Nø9Þçp_sJo´´ìz`ç¼FÈ¦êq+¯ ‡W¯°‚yË w£~¼©›¦úp êéª˜d™Onì1ö¥}8¼å„#ÛÀª,«ÜEÕµŒLIIú0·(ýcWÀÇÖ?¾æ¼‡}i¿Ä ž×Ãá±ª®·7sŠ÷ÖÃá-'¼?ê«×XÁ”©º–‘))Iæ¥¢¿XO<ˆA=¯€]‹ ”©º–‘))Iæ¥¢ßÛá^3`ó–ÊTQu-ƒ&¬H¥ÄŸ0jü²ð…þ[ÙùˆKûê5V0Ë ¿õ¯ónÇS¦êZFqÛ+Réçõõäv<äöFÅ&ãápÂøÇ2¿7çø¥ýÓ¨AÕµŒþæÀßw<¹_§Jý³&B©]¯!õ£Þ;~iÿñÞ˜BvéÇŠ]ÒSu-c|¡ÿVv>âýQo@æ SDU×2,J[ZÞú–‹>Öy|ìgj ‹£8|¡ÿê5V0o9á ©º–aQ Ü²Ø[¿ÛÝ.z8\6û¼FzË _#‡þkNéóS¦êZF¦¤$}˜[”Šþñ5§ôÀÎy€yñÎŽ ^cóòßçp‡·œp3eª®edJJÒ‡¹E©è_sJo´±Ý°ëÇ×œÒ;ç5æ56/¿Û]T]ËÈ””¤s‹RÑ?Ö‹wv4hðËXKkÝrÂ'7ö˜ûÄËæž¿`ñbº¨º–‘))Iæ¥¢?ÞrÂ;¦îsNÕµŒLIIú0·(ýcWÀÇÖ?®S ¥¾1³Ãâì|D×[N¸2U×22%%éÃÜ¢Tôu^[ÿp¸N%”úÆÌ‹·²ó]o9áÁ9ÊT]ËÈ””¤s‹RÑ?Öy|lýÃákÎ{Ø—öKj™ªk™’’ôanQ*ú‹õÄƒÔó øØµèáð¦Ø@S™ªk™’’ôanQ*ú½Þé5V0Ïä„2UT]Ëðv\{‹¿Gþ÷9¥k ‰¬N¯°Âµ†-'Ôk ¥½Öûoeç#ô¿^>U×2&Éí„Àßá0uïœóŸŒÍ-O#X–þËü}NéFþ*¿¬ûïÈÒÕ¡êZ†ìzìü$¹=v}c¯ôŠ„)xù‡ÛÞbo—xèx.fNè*SEÕµBYÍâïá¯ó¶7Wýï¤2¶þÜ¾$ó ×IÈØ ñ%á°ÿVv>‚ªk}Ç“ûÃqýí-þùou5‹c±Êƒø+×?6þ±ñ/ô©º–Ñé5VÐ%²:½fÀ ×Ú[ü=òz¡-¶ÍË¿Öp¶¯5)]k×çÐÿ}GÕµŒ1‡“]ÿ¾“?¥I¼‡‡È'Yö‚ùèÉ8ü“äöîqâ(ýÒRu-#xßÞâï‘×÷9ÜÃá5.íÃáób2vE™*ª¨ºV¶Þ-°w‰ªkåÉí¹›ŒKQµ†ú‚¤KUTQEU¿·Ã[IIú¼ü™æ+F°¬s=¯)Íæí–üáð&Ùìó©éö¼–©ò\#UTQ•¹%g7Ù”³ŠwQEU$úŽ,]O’Û#¸—ð–^½fÀ ûspâ(•©¢ê÷v\{¬šF°¬Ïõáðbæ¶ÍÇúH¾l—?äd$±?Þã5vé±ªþ {£b/ÿápƒI/ÿ¼ZÙù–õVöÇÉcóè%aùáÎõ¼Î‹Œ]q{‹-;XÖCÎQ©úÛ ¯k*]ÚÛÆØcM8¯‡ÃyM’óòoFŒ×Øyù÷v8Ö$†—ÿ½„s¥ê7ØL†y»%8Ü`ÃËŒ^B™*ª~o‡ï±|\Ú“GbsòH3êy…<^ÌÜ¶ùXÉ—Íáò‡ÃÉ#Í¨—öã½R€ª¿†l˜óúXçð±o§¹>^mL<Ò±LË '4ã““Šõ÷ð±>ŒgcÂ ª~òH3Ê÷HÆ)éoiÝ™UÀcf™*ª~o‡äËæpù ÈHb×‡Ã+/?áHÈ±â±z^!¯¼ü„÷x]zlà½U+;çå¿Î½Ø@ý ˜ó:¯ÀfÙ_bPï™—ÿ>ØwQ¯y¤‡<^çüÒRõ÷Á¾‹zi?Rz8ð¾A°VÔeî™—;Ü'™WÔó2<àå?¨ú ìp—öáÀûI–·G¸Z¦ŠªŸ¤ÃúHé±z7ÈxXoeç0çòñÊËOxlàu×¶ÄË8ÜaØTýö;Jo”õ>Øw¡ŸÃÝÀ÷Q?Œ÷6Fwì®‡Ãz8¼ÇkìÒ'1 êµ²¿`òñ„Ñ¾‘<ÒŒ‡¼‡cMb`ºÎõá°¯ØŒziŸÐÆ-»>–¡êßì»xcÁ®Û#\}Â0¼ü·[ò‡Ã·H<äáð„Ñ–x¸ Ô ªþ\È0o·ä‡;æ‰k¼Wz.d^þÃáiÔ8r¬¸±±„+¨úÇ2ßp6/ÿáðêdö×(SEÕï-oçû“äöF‡ËöŸÄà56F®ÿHé½R ÞµÞðÆ©ôp[fßQõ#Û v¼•]DÕ5Ov°ps=Ö$æ£¾‘°pý°¥«LÕ5O‹íú†0ï•'4£¾q’yÅéù›Ûõ±q¬IÌG}#y¤ú. ÿ$óŠ®2UTý ÖÃá²Ùç5Ò *ûëïúƒóp#>^ÌÜ¶ùXŸÄà}™“yËq^ªþ:r|ÍyûÒ¾ÇQnÄûœÒ$ópxóKû‘ÒÃá“Ì+jùÞnÄû£Rõ®ö2Ö{¥Ï»Y}Ë Ë¼?êÇ÷ØxoŽójG.s}oöË÷v\OÆ®,‹ªD ·£>ä“©øÈeù‡×ž¤ý œxùË|ƒûXØ#XÖ¹~#6Ã”©¢ê÷vxÓƒ¦½GéÒ¾Æž§˜7ê'Y1xÕ‡Ã—ÔKûpx×Ø¥ÇÊ÷v êoy×¸":…/Üù%õcãáð„AF½´‡Ç>–ù†½Q±âápòH3ê¥¥ê‡›ã½R ¾^þ±&10Ë<^mL<Ò±LË úwfð˜Y¾·Ã7òÁ‹—OÕ¿Ä ¾‡Ir<Î+°×H_bP/íÃá±2UTýY[ü=ò×ZDÕ5O=H1\ãZv#«Y|’UÙ`ßÞ ³Ìõ¼ì9¨ºæi'Vt¸±ÿ4jLnìW„þKžDº‡a^BPuÍÓN,ãýŽ¡?¹±_úÛd–¹¾ÂkÆšp#T]ó´Ët¬¸Öp¡?¹±_ú.ðŠúW,óIæ_È6¨"ª¨jôäynùÛ¦ÑÃœ:R½ª®©í=ˆÑLL™$ØwQHË‡Ã¢êé{ðyQuD<+ò¼ÎÓÔèYU×H„äæ@Z…kè›yƒ7ÓsQsõÍNì»8×7Ó{¢™˜2I°ï¢¨[E–]T]#=–! êZsHn^…ktœäæ@áÕX¸†¾™·ÄH÷ Ÿd^q®o¦÷¬‹€ªkX†€*ª®eÏÚ2ÁÌÏÚ¼¢0× êZF¡cŸ‹®5äð± ¨º¦jì¢×Ø¼|¢ZC@ÕµŒ|^T]kÉÍÂ«±™þýÁÁËoÖEp!)Sx5ÖØ]T]kN¦ìs‘ç–¹½a=Ìy¡#Õ®¡êšêÁçEÕ5Ò“ÜhlæaÎ{Øo¦ç¢æê›ý Ë÷fú1(ŒE4ST¬žªk$®Ùßû.ÞL¿Ä€h&¦Lì»(êV‘eU×Hß }‡Æ"š‰)¤åÃa=kó ŽÚØ!…±ˆfbôb@4ÓEÕ5Ò#Uœäæ@áE@Õ5…e¨º–e¨ú=é¢ŠªLRuN¤³›lÊYÅ;‹¨¢ŠD©ú½×Û[ü=òÏ«zÍ€êÇ[NxßñäîF}X¯^3`sÙŸ$·7j…yUÿ†™'<^í1á^3o˜‡¼†lœã²n¸v/ßÛáöüýQ?É"cU»%8\6û¼F:»²¬÷7G`½•ýŽ,]óz8¼ãi,>Ê¿·ãz{‹¿GNÕ?õ>W˜‡|^Õk¬ð–êûŽ'w7ÈxX7Ò_I†y»%?©Ž,]×R ä•ª¿ï°ñ‘r©ñ‘Ò[N¨¯ƒs^ÇõÕk¬`ÞÊÎG”©¢ê÷vx`r‹½f|®0çúpx1sÛæckÃË`r‹½f¼ïxrŸd‘±£>žK ªþIò\Ö'7ö˜»ž×Ãá¼ì9ÞrÂC>>InoÔ óÇklŒüÒÞŒå{;®Týöüóª^3`…ú:OîãÅÌm›u¬IÌ[N(SEÕŸEÄ¢pƒŽzÔ)ÞÀÃŸ ¤·xÈ ×ØÜ›Çõö¼|Bù’¸á›{sàï•¨ú'Ésì‰GzŽ±êe?Ýñ±JŸÜØ>ÞÊ~8®·ý¼LU¡Ø•e½`Ùò·¾%ñu-‰ª[ˆbÿÎI"^XÚ@]¨•ª¿PìÊ²^°\ð·¾eA]KÒtÑÜ¿¸10Ÿ†=zœ8JyÍö¥moÍQzãÜRuÄÈöo9á\È6Ê/°ã…¡3J'¶`·šKT=±Íµ¤ê/»²¬,û[ß’XÝb-uÑ’EÆ˜‡Ü{Þ=yÖ¨ÓHåwÈxæò±¨"ª¨¢Š*ÒMbProgram UnSqueeze; (* Written: 01/29/1986 15:59:57 *) { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] Program UnSqueeze [] [] [] [] A file de-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; Recognize = $FF76; Recognize2 = $FFFA; NumVals = 257; { max tree size + 1 } SpEOF = 256; { special end of file marker } DLE: char = #$90; Space = ' '; Type Tree = array [0..255,0..1] of integer; HexStr = string[4]; FileName = string[30]; FlePtr = ^FileLst; FileLst = Record FNme: FileName; NxtF: FlePtr; end; Var InFileName, OutFileName, FMask, FileDateString, AnotherString, DrivePrefix, OutDrive: FileName; InFileSize, OutFileSize: real; DNode: Tree; InChar, CurIn, FileCkSum, Crc, BPos, FileDate, FileTime, i, RepCt, NumNodes: integer; HeapTop: ^Integer; FFirst, FLast, FCurrent: FlePtr; LoggedDrive, C, LastChar: char; PrinterEcho, AllDone, EoFile: boolean; { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] Pick One: CP/M or DOS and comment out the one that doesn't apply [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } (* {$I cpm.inc } *) {$I dos.inc } {$I usqzmain.inc } Procedure Compress(Var TheString: FileName); begin While Pos(' ',TheString) > 0 do Delete(TheString,Pos(' ',TheString),1); end; { Procedure Compress } Procedure UnSqueeze; begin NumNodes:=ord(GetW); If (NumNodes<0) or (NumNodes>=NumVals) then begin WriteLn('File has invalid decode tree size.'); CloseInFile; end else begin Assign(OutFile,OutFileName); ReWriteOutFile; WriteLn; WriteLn('The file ',InFileName,' (',InFileSize:6:0, ' bytes ) is being UnSqueezed to ',OutFilename); DNode[0,0]:=-(succ(SpEOF)); DNode[0,1]:=-(succ(SpEOF)); NumNodes:=pred(NumNodes); For i:=0 to NumNodes do begin DNode[i,0]:=GetW; DNode[i,1]:=GetW; end; Crc:=0; If FileDateString>'' then Write('[ File Date: ',FileDateString,' ] '); Write('UnSqueezing,'); While not EOF(InFile) or (not EoFile) do begin C:=GetCr; If not EoFile then begin WriteOutFile(C); Crc:=Crc+ord(C); end; end; CloseInFile; CloseOutFile; WriteLn(' Done.'); If Crc<>FileCkSum then begin WriteLn('File CheckSum Was ',Hex(FileCkSum),', Is ',Hex(Crc)); end; OutFileSize:=GetSizeOfOutFile; WriteLn('The file ',OutFileName,' is',OutFileSize:6:0, ' bytes (',(100.0*OutFileSize/InFileSize):5:1,'%).'); end; end; { Procedure UnSqueeze } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] UnSqueeze 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 UnSqueezer'); For i:=1 to 64-Length(Version) do Write(Space); WriteLn(Version); Repeat AllDone:=false; If InFileName='' then begin WriteLn; Write('Enter file to UnSqueeze ( 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 ',InFileName[1],': ) >'); ReadLn(OutDrive); Repeat { Until InFileName='' } InFileName:=NextFile; If InFileName>'' then begin InFileName:=DrivePrefix+InFileName; OutFileName:=Copy(InFileName,1,2); If Length(OutDrive)>0 then OutFileName[1]:=UpCase(OutDrive[1]); Assign(InFile,InFileName); Reset(InFile); InFileSize:=TheSizeOf(InFile); If InFileSize=0 then begin WriteLn('Input file ',InFileName,' is empty.'); CloseInFile; end else begin CloseInFile; ResetInFile; RepCt:=0; BPos:=99; EoFile:=false; FileDateString:=''; AnotherString:=''; i:=GetW; Case i of Recognize: begin FileCkSum:=GetW; Repeat { Until InChar=0 } InChar:=GetI; If InChar<>0 then OutFileName:=OutFileName+Chr(InChar); Until InChar=0; UnSqueeze; end; Recognize2: begin Repeat { Until InChar=0 } InChar:=GetI; If InChar<>0 then OutFileName:=OutFileName+Chr(InChar); Until InChar=0; Repeat { Until InChar=0 } InChar:=GetI; If InChar<>0 then FileDateString:=FileDateString+ Chr(InChar); Until InChar=0; Repeat { Until InChar=0 } InChar:=GetI; If InChar<>0 then AnotherString:=AnotherString+ Chr(InChar); Until InChar=0; InChar:=GetI; { ^Z (ASCII EOF) } FileCkSum:=GetW; FileDate:=GetW; FileTime:=GetW; UnSqueeze; end; Else begin CloseInFile; WriteLn('I don''t recognize ',InFileName, ' as a squeezed file.'); end; end; { Case i } end; end; Until InFileName=''; end; end; InFileName:=''; Until AllDone; If PrinterEcho then Write(Lst,FormFeed); end.Function Hex(num: integer): HexStr; Const h: String[16]='0123456789ABCDEF'; Var i, j: integer; str: hexstr; begin Str:='0000'; j:=num; For i:=4 DownTo 1 do begin Str[i]:=h[succ(j and $F)]; j:=j shr 4; end; Hex:=Str; end; { Function Hex } { getw - get a word value from the input file } Function GetW: integer; Var in1,in2: char; begin ReadInFile(In1); ReadInFile(In2); GetW:=ord(in1) + ord(in2) shl 8; end; { Function GetW } Function GetI: integer; Var ch: Char; begin ReadInFile(ch); GetI:=ord(ch); end; { Function GetI } Function GetUHuff: char; Var i: integer; begin i:=0; Repeat BPos:=succ(BPos); If BPos>7 then begin CurIn:=GetI; BPos:=0; end else CurIn:=CurIn shr 1; i:=ord(DNode[i,ord(CurIn and $0001)]); Until (i<0); i:=-(succ(i)); If i=SpEOF then begin EoFile:=true; GetuHuff:=chr(26) end else GetUHuff:=chr(i); end; { Function GetUHuff } Function GetCr: char; var C: char; begin If (RepCt>0) then begin RepCt:=pred(RepCt); GetCr:=LastChar; end else begin C:=GetuHuff; If C<>DLE then begin GetCr:=C; LastChar:=C; end else begin RepCt:=ord(GetuHuff); If RepCt=0 then GetCr:=DLE else begin RepCt:=pred(pred(RepCt)); GetCr:=LastChar; end; end; end; end; { Function GetCr }