home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 16
/
CD_ASCQ_16_0994.iso
/
maj
/
swag
/
archives.swg
< prev
next >
Wrap
Text File
|
1994-08-29
|
126KB
|
1 lines
SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00022 ARCHIVE HANDLING 1 05-28-9313:33ALL SWAG SUPPORT TEAM Get Archive ID IMPORT 19 «Q¥∩ {π > I'm looking For descriptions of the formats of headers inπ > all popular archive Files, ie .ZIP, .ARC, .LZH, .ARJ, etc.π > I just want to be able to read the headers of all of theseπ > archives, not necessarily manipulate them. Anyone knowπ > where such can be had?ππHere's a Program that will determine most of the major archive Types.πI've made a couple of additions, but the original source was fromπa message on this echo...the original author's name has since beenπlost. To use the Procedure, just call it as follows:π If GetArcType(FileName.Ext)=Zip then....π}ππUsesπ Dos;ππTypeπ ArcType = (FileError, Unknown, Zip, Zoo, Arc, Lzh, Pak, Arj);ππFunction GetArcType(FName : String) : ArcType;πVarπ ArcFile : File of Byte;π i : Integer;π Gat : ArcType;π c : Array[1..5] of Byte;πbeginπ Assign(ArcFile, FName);π {$I-}π Reset(ArcFile);π {$I+}π if IOResult <> 0 thenπ Gat := FileErrorπ elseπ if FileSize(ArcFile) < 5 thenπ Gat := FileErrorπ elseπ beginπ For i := 1 to 5 doπ Read(ArcFile, c[i]);π Close(ArcFile);π if ((c[1] = $50) and (c[2] = $4B)) thenπ Gat := Zipπ elseπ if ((c[1] = $60) and (c[2] = $EA)) thenπ Gat := Arjπ elseπ if ((c[4] = $6c) and (c[5] = $68)) thenπ Gat := Lzhπ elseπ if ((c[1] = $5a) and (c[2] = $4f) and (c[3] = $4f)) thenπ Gat := Zooπ elseπ if ((c[1] = $1a) and (c[2] = $08)) thenπ Gat := Arcπ elseπ if ((c[1] = $1a) and (c[2] = $0b)) thenπ Gat := Pakπ elseπ Gat := Unknown;π end;ππ GetArcType := Gat;πend;ππVarπ FileName : String;π Return : ArcType;π {ArcType = (FileError,Unknown,Zip,Zoo,Arc,Lzh,Pak,Arj)}πππbeginπ if ParamCount = 1 thenπ beginπ FileName := ParamStr(1);π Return := GetArcType(FileName);π Case Return ofπ ARJ : Writeln(FileName, ' = ARJ ');π PAK : Writeln(FileName, ' = PAK ');π LZH : Writeln(FileName, ' = LZH ');π ARC : Writeln(FileName, ' = ARC ');π ZOO : Writeln(FileName, ' = ZOO ');π ZIP : Writeln(FileName, ' = ZIP ');π UNKNOWN : Writeln(FileName, ' = Unknown!')π elseπ Writeln('File Not Found');π end;π end {IF}π elseπ Writeln('No parameter');πend.π 2 05-28-9313:33ALL MIKE COPELAND Display Archive Files IMPORT 73 «Q╪{ {π Hmmmm, I thought I responded to you on this before. Whether I did orπnot, I will post what I did before (in the next two messages), but Iπdon't want to post the entire Program - I'm building a ShareWareπprogream I plan to market, and I don't think I should give it _all_πaway. The code I post is pertinent to reading the headers and Filenameπinfo in the Various archive Types, and I Really think you can work outπthe rest without much trouble. If you can't, please post a specificπquestion...π}ππConstπ BSize = 4096; { I/O Buffer Size }π HMax = 512; { Header Maximum Size }πVarπ I,J,K : Integer;π CT,RC,TC : Integer;π RES : Word; { Buffer Residue }π N,P,Q : LongInt;π C : LongInt; { Buffer Offset }π FSize : LongInt; { File Size }π DEVICE : Char; { Disk Device }π F : File;π SNAME : String;π DATE : String[8]; { formatted date as YY/MM/DD }π TIME : String[5]; { " time as HH:MM }π DirInfo : SearchRec; { File name search Type }π SR : SearchRec; { File name search Type }π DT : DateTime;π PATH : PathStr;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π Regs : Registers;π BUFF : Array[1..BSize] of Byte;ππProcedure FDT (LI : LongInt); { Format Date/Time fields }πbeginπ UnPackTime (LI,DT);π DATE := FSI(DT.Month,2)+'/'+FSI(DT.Day,2)+'/'+Copy(FSI(DT.Year,4),3,2);π if DATE[4] = ' ' then DATE[4] := '0';π if DATE[7] = ' ' then DATE[7] := '0';π TIME := FSI(DT.Hour,2)+':'+FSI(DT.Min,2);π if TIME[4] = ' ' then TIME[4] := '0';πend; { FDT }ππProcedure MY_FFF;πVar I,J,K : LongInt;ππ(**************************** ARJ Files Processing ***************************)πType ARJHead = Recordπ FHeadSize : Byte;π ArcVer1,π ArcVer2 : Byte;π HostOS,π ARJFlags,π Method : Byte; { MethodType = (Stored, LZMost, LZFast); }π R1,R2 : Byte;π Dos_DT : LongInt;π CompSize,π UCompSize,π CRC : LongInt;π ENP, FM,π HostData : Word;π end;πVar ARJ1 : ARJHead;π ARJId : Word; { 60000, if ARJ File }π HSize : Word; { Header Size }πProcedure GET_ARJ_ENTRY;πbeginπ FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);π Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES); { read header into buffer }π Move (BUFF[1],ARJId,2); Move (BUFF[3],HSize,2);π if HSize > 0 thenπ With ARJ1 doπ beginπ Move (BUFF[5],ARJ1,SizeOf(ARJHead));π I := FHeadSize+5; SNAME := B40;π While BUFF[I] > 0 do Inc (I);π I := I-FHeadSize-5;π Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);π FSize := CompSize; Inc (C,HSIZE);π end;πend; { GET_ARJ_ENTRY }ππProcedure DO_ARJ (FN : String);πbeginπ Assign (F,FN); Reset (F,1); C := 1;π GET_ARJ_ENTRY; { Process FileπHeader }π Repeatπ Inc(C,FSize+10);π GET_ARJ_ENTRY;π if HSize > 0 thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := ARJ1.UCompSize;π RType := 4; D_T := ARJ1.Dos_DT; ANUM := ADX; VNUM := VDX;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Until HSize <= 0;π Close (F);πend; { DO_ARJ }ππ(**************************** ZIP Files Processing ***************************)πType ZIPHead = Recordπ ExtVer : Word;π Flags : Word;π Method : Word;π Fill1 : Word;π Dos_DT : LongInt;π CRC32 : LongInt;π CompSize : LongInt;π UCompSize : LongInt;π FileNameLen : Word;π ExtraFieldLen : Word;π end;πVar ZIPCSize : LongInt;π ZIPId : Word;π ZIP1 : ZIPHead;πProcedure GET_ZIP_ENTRY;πbeginπ FillChar(ZIP1,SizeOf(ZIPHead),#0); Move (BUFF[C+1],ZIPId,2);π if ZIPId > 0 thenπ beginπ Move (BUFF[C+1],ZIP1,SizeOf(ZIPHead));π Inc (C,43); SNAME := '';π With ZIP1 doπ beginπ Move (BUFF[C],SNAME[1],FileNameLen); SNAME[0] := Chr(FileNameLen);π FSize := CompSize;π end;π end;πend; { GET_ZIP_ENTRY }ππProcedure DO_ZIP (FN : String);πConst CFHS : String[4] = 'PK'#01#02; { CENTRAL_File_HEADER_SIGNATURE }π ECDS : String[4] = 'PK'#05#06; { end_CENTRAL_DIRECTORY_SIGNATURE }πVar S4 : String[4];π FOUND : Boolean;π QUIT : Boolean; { "end" sentinel encountered }πbeginπ--- GOMail v1.1 [DEMO] 03-09-93π * Origin: The Private Reserve - Phoenix, AZ (602) 997-9323 (1:114/151)π<<<>>>πππDate: 03-23-93 (22:30) Number: 16806 of 16859 (Echo)π To: EDDIE BRAITER Refer#: NONEπFrom: MIKE COPELAND Read: NOπSubj: FORMAT VIEWER - PART 2 of Status: PUBLIC MESSAGEπConf: F-PASCAL (1221) Read Type: GENERAL (+)ππ(**************************** ARC Files Processing ***************************)πType ARCHead = Recordπ ARCMark : Char;π ARCVer : Byte;π FN : Array[1..13] of Char;π CompSize : LongInt;π Dos_DT : LongInt;π CRC : Word;π UCompSize : LongInt;π end;πConst ARCFlag : Char = #26; { ARC mark }πVar WLV : LongInt; { Working LongInt Variable }π ARC1 : ARCHead;π QUIT : Boolean; { "end" sentinel encountered }ππProcedure GET_ARC_ENTRY;πbeginπ FillChar(ARC1,SizeOf(ARCHead),#0); L := SizeOf(ARCHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],ARC1,L);π With ARC1 doπ if (ARCMark = ARCFlag) and (ARCVer > 0) thenπ beginπ SNAME := ''; I := 1;π While FN[I] <> #0 doπ beginπ SNAME := SNAME+FN[I]; Inc(I)π end;π WLV := (Dos_DT Shr 16)+(Dos_DT Shl 16); { flip Date/Time }π FSize := CompSize;π end;π QUIT := ARC1.ARCVer <= 0;πend; { GET_ARC_ENTRY }ππProcedure DO_ARC (FN : String);πbeginπ Assign (F,FN); Reset (F,1); C := 0;π Repeatπ GET_ARC_ENTRY;π if not QUIT thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := ARC1.UCompSize; RType := 4; { comp File }π D_T := WLV; ANUM := ADX; VNUM := VDX;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Inc (C,FSize+SizeOf(ARCHead))π Until QUIT;π Close (F);πend; { DO_ARC }ππ(************************* LZH Files Processing ******************************)πType LZHHead = Recordπ HSize : Byte;π Fill1 : Byte;π Method : Array[1..5] of Char;π CompSize : LongInt;π UCompSize : LongInt;π Dos_DT : LongInt;π Fill2 : Word;π FileNameLen : Byte;π FileName : Array[1..12] of Char;π end;ππVar LZH1 : LZHHead;ππProcedure GET_LZH_ENTRY;πbeginπ FillChar(LZH1,SizeOf(LZHHead),#0); FillChar (DT,SizeOf(DT),#0);π L := SizeOf(LZHHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],LZH1,L);π With LZH1 doπ if HSize > 0 thenπ beginπ Move (FileNameLen,SNAME,FileNameLen+1);π UnPackTime (Dos_DT,DT);π FSize := CompSize;π endπ else QUIT := Trueπend; { GET_LZH_ENTRY }ππProcedure DO_LZH (FN : String);πbeginπ Assign (F,FN); Reset (F,1);π FSize := FileSize(F); C := 0; QUIT := False;π Repeatπ GET_LZH_ENTRY;π if not QUIT thenπ beginπ Inc (WPX); New(SW[WPX]); { store Filename info in dynamic Array }π With SW[WPX]^ doπ beginπ FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+' ',1,4)π SIZE := LZH1.UCompSize;π RType := 4; ANUM := ADX; VNUM := VDX; D_T := LZH1.Dos_DT;π ADD_CNAME;π end;π Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)π end;π Inc (C,FSize+LZH1.HSize+2)π Until QUIT;π Close (F);πend; { DO_LZH }π 3 05-28-9313:33ALL SWAG SUPPORT TEAM String Compression IMPORT 22 «Q▐å {You won't get that sort of compression from my routines, but hereπthey are anyway. When testing, you'll get best compression if youπuse English and longish Strings.π}πUnit Compress;ππInterfaceππConstπ CompressedStringArraySize = 500; { err on the side of generosity }ππTypeπ tCompressedStringArray = Array[1..CompressedStringArraySize] of Byte;ππFunction GetCompressedString(Arr : tCompressedStringArray) : String;ππProcedure CompressString(st : String; Var Arr : tCompressedStringArray;π Var len : Integer);π { converts st into a tCompressedStringArray of length len }ππImplementationππConstπ FreqChar : Array[4..14] of Char = 'etaonirshdl';π { can't be in [0..3] because two empty bits signify a space }πππFunction GetCompressedString(Arr : tCompressedStringArray) : String;πVarπ Shift : Byte;π i : Integer;π ch : Char;π st : String;π b : Byte;ππ Function GetHalfNibble : Byte;π beginπ GetHalfNibble := (Arr[i] shr Shift) and 3;π if Shift = 0 then beginπ Shift := 6;π inc(i);π end else dec(Shift,2);π end;ππbeginπ st := '';π i := 1;π Shift := 6;π Repeatπ b := GetHalfNibble;π if b = 0 thenπ ch := ' 'π else beginπ b := (b shl 2) or GetHalfNibble;π if b = $F then beginπ b := GetHalfNibble shl 6;π b := b or GetHalfNibble shl 4;π b := b or GetHalfNibble shl 2;π b := b or GetHalfNibble;π ch := Char(b);π end elseπ ch := FreqChar[b];π end;π if ch <> #0 then st := st + ch;π Until ch = #0;π GetCompressedString := st;πend;ππProcedure CompressString(st : String; Var Arr : tCompressedStringArray;π Var len : Integer);π{ converts st into a tCompressedStringArray of length len }πVarπ i : Integer;π Shift : Byte;ππ Procedure OutHalfNibble(b : Byte);π beginπ Arr[len] := Arr[len] or (b shl Shift);π if Shift = 0 then beginπ Shift := 6;π inc(len);π end else dec(Shift,2);π end;ππ Procedure OutChar(ch : Char);π Varπ i : Byte;π bych : Byte Absolute ch;π beginπ if ch = ' ' thenπ OutHalfNibble(0)π else beginπ i := 4;π While (i<15) and (FreqChar[i]<>ch) do inc(i);π OutHalfNibble(i shr 2);π OutHalfNibble(i and 3);π if i = $F then beginπ OutHalfNibble(bych shr 6);π OutHalfNibble((bych shr 4) and 3);π OutHalfNibble((bych shr 2) and 3);π OutHalfNibble(bych and 3);π end;π end;π end;ππbeginπ len := 1;π Shift := 6;π fillChar(Arr,sizeof(Arr),0);π For i := 1 to length(st) do OutChar(st[i]);π OutChar(#0); { end of compressed String signaled by #0 }π if Shift = 6π then dec(len);πend;ππend.π 4 05-28-9313:33ALL DOUGLAS WEBB Code for LZH.PAS IMPORT 167 «Qfú πUnit LZH;ππ {$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V-}ππ(*π * LZHUF.C English version 1.0π * Based on Japanese version 29-NOV-1988π * LZSS coded by Haruhiko OKUMURAπ * Adaptive Huffman Coding coded by Haruyasu YOSHIZAKIπ * Edited and translated to English by Kenji RIKITAKEπ * Translated from C to Turbo Pascal by Douglas Webb 2/18/91π * Update and bug correction of TP version 4/29/91 (Sorry!!)π *)ππ{π This Unit allows the user to commpress data using a combination ofπ LZSS Compression and adaptive Huffman coding, or conversely to deCompressπ data that was previously Compressed by this Unit.ππ There are a number of options as to where the data being Compressed/π deCompressed is coming from/going to.ππ In fact it requires that you pass the "LZHPack" Procedure 2 proceduralπ parameter of Type 'GetProcType' and 'PutProcType' (declared below) whichπ will accept 3 parameters and act in every way like a 'BlockRead'/'BlockWrite'π Procedure call. Your 'GetProcType' Procedure should return the dataπ to be Compressed, and Your 'PutProcType' Procedure should do something withπ the Compressed data (ie., put it in a File). In Case you need to know (andπ you do if you want to deCompress this data again) the number of Bytes in theπ Compressed data (original, not Compressed size) is returned in 'Bytes_Written'.ππ GetBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);π π DTA is the start of a memory location where the inFormation returned shouldπ be. NBytes is the number of Bytes requested. The actual number of Bytesπ returned must be passed in Bytes_Got (if there is no more data then 0π should be returned).ππ PutBytesProc = Procedure(Var DTA; NBytes:Word; Var Bytes_Got : Word);ππ As above except instead of asking For data the Procedure is dumping outπ Compressed data, do somthing With it.πππ "LZHUnPack" is basically the same thing in reverse. It requiresπ procedural parameters of Type 'PutProcType'/'GetProcType' whichπ will act as above. 'GetProcType' must retrieve data Compressed usingπ "LZHPack" (above) and feed it to the unpacking routine as requested.π 'PutProcType' must accept the deCompressed data and do somethingπ withit. You must also pass in the original size of the deCompressed data,π failure to do so will have adverse results.πππ Don't Forget that as procedural parameters the 'GetProcType'/'PutProcType'π Procedures must be Compiled in the 'F+' state to avoid a catastrophe.ππππ}ππ{ note: All the large data structures For these routines are allocated whenπ needed from the heap, and deallocated when finished. So when not in useπ memory requirements are minimal. However, this Unit Uses about 34K ofπ heap space, and 400 Bytes of stack when in use. }πππInterfaceππTypeπππ PutBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Put : Word);π GetBytesProc = Procedure(Var DTA; NBytes : Word; Var Bytes_Got : Word);ππππProcedure LZHPack(Var Bytes_Written : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);πππProcedure LZHUnpack(TextSize : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);πππImplementationππConstπ Exit_OK = 0;π Exit_FAILED = 1;ππ { LZSS Parameters }π N = 4096; { Size of String buffer }π F = 60; { Size of look-ahead buffer }π THRESHOLD = 2;π NUL = N; { end of tree's node }ππ { Huffman coding parameters }π N_Char = (256 - THRESHOLD + F);ππ { Character code (:= 0..N_Char-1) }π T = (N_Char * 2 - 1); { Size of table }π R = (T - 1); { root position }ππ { update when cumulative frequency }π { reaches to this value }π MAX_FREQ = $8000;ππ{π * Tables For encoding/decoding upper 6 bits ofπ * sliding dictionary Pointerπ }ππ { encoder table }π p_len : Array[0..63] of Byte =π ($03, $04, $04, $04, $05, $05, $05, $05,π $05, $05, $05, $05, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $08, $08, $08, $08, $08, $08, $08, $08);ππ p_code : Array[0..63] of Byte =π ($00, $20, $30, $40, $50, $58, $60, $68,π $70, $78, $80, $88, $90, $94, $98, $9C,π $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,π $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,π $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,π $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,π $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,π $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);ππ { decoder table }π d_code : Array[0..255] of Byte =π ($00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $00, $00,π $01, $01, $01, $01, $01, $01, $01, $01,π $01, $01, $01, $01, $01, $01, $01, $01,π $02, $02, $02, $02, $02, $02, $02, $02,π $02, $02, $02, $02, $02, $02, $02, $02,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $04, $04, $04, $04, $04, $04, $04, $04,π $05, $05, $05, $05, $05, $05, $05, $05,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $09, $09, $09, $09, $09, $09, $09, $09,π $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,π $0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,π $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D,π $0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,π $10, $10, $10, $10, $11, $11, $11, $11,π $12, $12, $12, $12, $13, $13, $13, $13,π $14, $14, $14, $14, $15, $15, $15, $15,π $16, $16, $16, $16, $17, $17, $17, $17,π $18, $18, $19, $19, $1A, $1A, $1B, $1B,π $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,π $20, $20, $21, $21, $22, $22, $23, $23,π $24, $24, $25, $25, $26, $26, $27, $27,π $28, $28, $29, $29, $2A, $2A, $2B, $2B,π $2C, $2C, $2D, $2D, $2E, $2E, $2F, $2F,π $30, $31, $32, $33, $34, $35, $36, $37,π $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);ππ d_len : Array[0..255] of Byte =π ($03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $03, $03, $03, $03, $03, $03, $03, $03,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $04, $04, $04, $04, $04, $04, $04, $04,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $05, $05, $05, $05, $05, $05, $05, $05,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $06, $06, $06, $06, $06, $06, $06, $06,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $07, $07, $07, $07, $07, $07, $07, $07,π $08, $08, $08, $08, $08, $08, $08, $08,π $08, $08, $08, $08, $08, $08, $08, $08);ππ getbuf : Word = 0;π getlen : Byte = 0;π putlen : Byte = 0;π putbuf : Word = 0;π TextSize : LongInt = 0;π codesize : LongInt = 0;π printcount : LongInt = 0;π match_position : Integer = 0;π match_length : Integer = 0;πππTypeπ FreqType = Array[0..T] of Word; π FreqPtr = ^FreqType;π PntrType = Array[0..pred(T + N_Char)] of Integer;π pntrPtr = ^PntrType;π SonType = Array[0..pred(T)] of Integer;π SonPtr = ^SonType;π TextBufType = Array[0..N + F - 2] of Byte;π TBufPtr = ^TextBufType;π WordRay = Array[0..N] of Integer;π WordRayPtr = ^WordRay;π BWordRay = Array[0..N + 256] of Integer;π BWordRayPtr = ^BWordRay;ππVarπ Text_buf : TBufPtr;π lson, dad : WordRayPtr;π rson : BWordRayPtr;π freq : FreqPtr; { cumulative freq table }ππ{π * pointing parent nodes.π * area [T..(T + N_Char - 1)] are Pointers For leavesπ }π prnt : pntrPtr;ππ { pointing children nodes (son[], son[] + 1)}π son : SonPtr;πππ Procedure InitTree; { Initializing tree }π Varπ i : Integer;π beginπ For i := N + 1 to N + 256 doπ rson^[i] := NUL; { root }π For i := 0 to N doπ dad^[i] := NUL; { node }π end;πππ Procedure InsertNode(R : Integer); { Inserting node to the tree }π Varπ tmp, i, p, cmp : Integer;π key : TBufPtr;π c : Word;π beginπ cmp := 1;π key := @Text_buf^[R];π p := succ(N) + key^[0];π rson^[R] := NUL;π lson^[R] := NUL;π match_length := 0;π While match_length < F doπ beginπ if (cmp >= 0) thenπ beginπ if (rson^[p] <> NUL) thenπ p := rson^[p]π elseπ beginπ rson^[p] := R;π dad^[R] := p;π Exit;π end;π endπ elseπ beginπ if (lson^[p] <> NUL) thenπ p := lson^[p]π elseπ beginπ lson^[p] := R;π dad^[R] := p;π Exit;π end;π end;π i := 0;π cmp := 0;π While (i < F) and (cmp = 0) doπ beginπ inc(i);π cmp := key^[i] - Text_buf^[p + i];π end;π if (i > THRESHOLD) thenπ beginπ tmp := pred((R - p) and pred(N));π if (i > match_length) thenπ beginπ match_position := tmp;π match_length := i;π end;π if (match_length < F) and (i = match_length) thenπ beginπ c := tmp;π if (c < match_position) thenπ match_position := c;π end;π end;π end; { While True do }π dad^[R] := dad^[p];π lson^[R] := lson^[p];π rson^[R] := rson^[p];π dad^[lson^[p]] := R;π dad^[rson^[p]] := R;π if (rson^[dad^[p]] = p) thenπ rson^[dad^[p]] := Rπ elseπ lson^[dad^[p]] := R;π dad^[p] := NUL; { remove p }π end;πππ Procedure DeleteNode(p : Integer); { Deleting node from the tree }π Varπ q : Integer;π beginπ if (dad^[p] = NUL) thenπ Exit; { unregistered }π if (rson^[p] = NUL) thenπ q := lson^[p]π else if (lson^[p] = NUL) thenπ q := rson^[p]π elseπ beginπ q := lson^[p];π if (rson^[q] <> NUL) thenπ beginπ Repeatπ q := rson^[q];π Until (rson^[q] = NUL);π rson^[dad^[q]] := lson^[q];π dad^[lson^[q]] := dad^[q];π lson^[q] := lson^[p];π dad^[lson^[p]] := q;π end;π rson^[q] := rson^[p];π dad^[rson^[p]] := q;π end;π dad^[q] := dad^[p];π if (rson^[dad^[p]] = p) thenπ rson^[dad^[p]] := qπ elseπ lson^[dad^[p]] := q;π dad^[p] := NUL;π end;ππ { Huffman coding parameters }ππ Function GetBit(GetBytes : GetBytesProc) : Integer; { get one bit }π Varπ i : Byte;π i2 : Integer;π result : Word;π beginπ While (getlen <= 8) doπ beginπ GetBytes(i, 1, result);π if result = 1 thenπ i2 := iπ else i2 := 0;π getbuf := getbuf or (i2 shl (8 - getlen));π inc(getlen, 8);π end;π i2 := getbuf;π getbuf := getbuf shl 1;π dec(getlen);π GetBit := Integer((i2 < 0));π end;πππ Function GetByte(GetBytes : GetBytesProc) : Integer; { get a Byte }π Varπ j : Byte;π i, result : Word;π beginπ While (getlen <= 8) doπ beginπ GetBytes(j, 1, result);π if result = 1 thenπ i := jπ elseπ i := 0;π getbuf := getbuf or (i shl (8 - getlen));π inc(getlen, 8);π end;π i := getbuf;π getbuf := getbuf shl 8;π dec(getlen, 8);π GetByte := Integer(i shr 8);π end;πππ Procedure Putcode(l : Integer; c : Word;π PutBytes : PutBytesProc); { output c bits }π Varπ Temp : Byte;π Got : Word;π beginπ putbuf := putbuf or (c shr putlen);π inc(putlen, l);π if (putlen >= 8) thenπ beginπ Temp := putbuf shr 8;π PutBytes(Temp, 1, Got);π dec(putlen, 8);π if (putlen >= 8) thenπ beginπ Temp := lo(putbuf);π PutBytes(Temp, 1, Got);π inc(codesize, 2);π dec(putlen, 8);π putbuf := c shl (l - putlen);π endπ elseπ beginπ putbuf := putbuf shl 8;π inc(codesize);π end;π end;π end;πππ { initialize freq tree }ππ Procedure StartHuff;π Varπ i, j : Integer;π beginπ For i := 0 to pred(N_Char) doπ beginπ freq^[i] := 1;π son^[i] := i + T;π prnt^[i + T] := i;π end;π i := 0;π j := N_Char;π While (j <= R) doπ beginπ freq^[j] := freq^[i] + freq^[i + 1];π son^[j] := i;π prnt^[i] := j;π prnt^[i + 1] := j;π inc(i, 2);π inc(j);π end;π freq^[T] := $ffff;π prnt^[R] := 0;π end;πππ { reConstruct freq tree }ππ Procedure reConst;π Varπ i, j, k, tmp : Integer;π F, l : Word;π beginπ { halven cumulative freq For leaf nodes }π j := 0;π For i := 0 to pred(T) doπ beginπ if (son^[i] >= T) thenπ beginπ freq^[j] := succ(freq^[i]) div 2; {@@ Bug Fix MOD -> div @@}π son^[j] := son^[i];π inc(j);π end;π end;π { make a tree : first, connect children nodes }π i := 0;π j := N_Char;π While (j < T) doπ beginπ k := succ(i);π F := freq^[i] + freq^[k];π freq^[j] := F;π k := pred(j);π While F < freq^[k] doπ dec(k);π inc(k);π l := (j - k) shl 1;π tmp := succ(k);π move(freq^[k], freq^[tmp], l);π freq^[k] := F;π move(son^[k], son^[tmp], l);π son^[k] := i;π inc(i, 2);π inc(j);π end;π { connect parent nodes }π For i := 0 to pred(T) doπ beginπ k := son^[i];π if (k >= T) thenπ beginπ prnt^[k] := i;π endπ elseπ beginπ prnt^[k] := i;π prnt^[succ(k)] := i;π end;π end;π end;πππ { update freq tree }ππ Procedure update(c : Integer);π Varπ i, j, k, l : Integer;π beginπ if (freq^[R] = MAX_FREQ) thenπ beginπ reConst;π end;π c := prnt^[c + T];π Repeatπ inc(freq^[c]);π k := freq^[c];π { swap nodes to keep the tree freq-ordered }π l := succ(c);π if (k > freq^[l]) thenπ beginπ While (k > freq^[l]) doπ inc(l);π dec(l);π freq^[c] := freq^[l];π freq^[l] := k;π i := son^[c];π prnt^[i] := l;π if (i < T) then prnt^[succ(i)] := l;π j := son^[l];π son^[l] := i;π prnt^[j] := c;π if (j < T) then prnt^[succ(j)] := c;π son^[c] := j;π c := l;π end;π c := prnt^[c];π Until (c = 0); { Repeat it Until reaching the root }π end;πππVarπ code, len : Word;ππ Procedure EncodeChar(c : Word; PutBytes : PutBytesProc);π Varπ i : Word;π j, k : Integer;π beginπ i := 0;π j := 0;π k := prnt^[c + T];π { search connections from leaf node to the root }π Repeatπ i := i shr 1;π {π if node's address is odd, output 1π else output 0π }π if Boolean(k and 1) then inc(i, $8000);π inc(j);π k := prnt^[k];π Until (k = R);π Putcode(j, i, PutBytes);π code := i;π len := j;π update(c);π end;πππ Procedure EncodePosition(c : Word; PutBytes : PutBytesProc);π Varπ i, j : Word;π beginπ { output upper 6 bits With encoding }π i := c shr 6;π j := p_code[i];π Putcode(p_len[i], j shl 8, PutBytes);π { output lower 6 bits directly }π Putcode(6, (c and $3f) shl 10, PutBytes);π end;πππ Procedure Encodeend(PutBytes : PutBytesProc);π Varπ Temp : Byte;π Got : Word;π beginπ if Boolean(putlen) thenπ beginπ Temp := lo(putbuf shr 8);π PutBytes(Temp, 1, Got);π inc(codesize);π end;π end;πππ Function DecodeChar(GetBytes : GetBytesProc) : Integer;π Varπ c : Word;π beginπ c := son^[R];π {π * start searching tree from the root to leaves.π * choose node #(son[]) if input bit = 0π * else choose #(son[]+1) (input bit = 1)π }π While (c < T) doπ beginπ c := c + GetBit(GetBytes);π c := son^[c];π end;π c := c - T;π update(c);π DecodeChar := Integer(c);π end;πππ Function DecodePosition(GetBytes : GetBytesProc) : Word;π Varπ i, j, c : Word;π beginπ { decode upper 6 bits from given table }π i := GetByte(GetBytes);π c := Word(d_code[i] shl 6);π j := d_len[i];π { input lower 6 bits directly }π dec(j, 2);π While j <> 0 doπ beginπ i := (i shl 1) + GetBit(GetBytes);π dec(j);π end;π DecodePosition := c or i and $3f;π end;πππ { Compression }ππ Procedure InitLZH;π beginπ getbuf := 0;π getlen := 0;π putlen := 0;π putbuf := 0;π TextSize := 0;π codesize := 0;π printcount := 0;π match_position := 0;π match_length := 0;π new(lson);π new(dad);π new(rson);π new(Text_buf);π new(freq);π new(prnt);π new(son);π end;πππ Procedure endLZH;π beginπ dispose(son);π dispose(prnt);π dispose(freq);π dispose(Text_buf);π dispose(rson);π dispose(dad);π dispose(lson);π end;πππ Procedure LZHPack(Var Bytes_Written : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);π Varπ ct : Byte;π i, len, R, s, last_match_length : Integer;π Got : Word;π beginπ InitLZH;π TextSize := 0; { rewind and rescan }π StartHuff;π InitTree;π s := 0;π R := N - F;π fillChar(Text_buf^[0], R, ' ');π len := 0;π Got := 1;π While (len < F) and (Got <> 0) doπ beginπ GetBytes(ct, 1, Got);π if Got <> 0 thenπ beginπ Text_buf^[R + len] := ct;π inc(len);π end;π end;π TextSize := len;π For i := 1 to F doπ InsertNode(R - i);π InsertNode(R);π Repeatπ if (match_length > len) thenπ match_length := len;π if (match_length <= THRESHOLD) thenπ beginπ match_length := 1;π EncodeChar(Text_buf^[R], PutBytes);π endπ elseπ beginπ EncodeChar(255 - THRESHOLD + match_length, PutBytes);π EncodePosition(match_position, PutBytes);π end;π last_match_length := match_length;π i := 0;π Got := 1;π While (i < last_match_length) and (Got <> 0) doπ beginπ GetBytes(ct, 1, Got);π if Got <> 0 thenπ beginπ DeleteNode(s);π Text_buf^[s] := ct;π if (s < pred(F)) thenπ Text_buf^[s + N] := ct;π s := succ(s) and pred(N);π R := succ(R) and pred(N);π InsertNode(R);π inc(i);π end;π end;π inc(TextSize, i);π While (i < last_match_length) doπ beginπ inc(i);π DeleteNode(s);π s := succ(s) and pred(N);π R := succ(R) and pred(N);π dec(len);π if Boolean(len) then InsertNode(R);π end;π Until (len <= 0);π Encodeend(PutBytes);π endLZH;π Bytes_Written := TextSize;π end;πππ Procedure LZHUnpack(TextSize : LongInt;π GetBytes : GetBytesProc;π PutBytes : PutBytesProc);π Varπ c, i, j, k, R : Integer;π c2, a : Byte;π count : LongInt;π Put : Word;π beginπ InitLZH;π StartHuff;π R := N - F;π fillChar(Text_buf^[0], R, ' ');π count := 0;π While count < TextSize doπ beginπ c := DecodeChar(GetBytes);π if (c < 256) thenπ beginπ c2 := lo(c);π PutBytes(c2, 1, Put);π Text_buf^[R] := c;π inc(R);π R := R and pred(N);π inc(count);π endπ elseπ beginπ i := (R - succ(DecodePosition(GetBytes))) and pred(N);π j := c - 255 + THRESHOLD;π For k := 0 to pred(j) doπ beginπ c := Text_buf^[(i + k) and pred(N)];π c2 := lo(c);π PutBytes(c2, 1, Put);π Text_buf^[R] := c;π inc(R);π R := R and pred(N);π inc(count);π end;π end;π end;π endLZH;π end;πππend.ππ 5 05-28-9313:33ALL SWAG SUPPORT TEAM Test for LZH Code IMPORT 22 «Q∙∩ πProgram LZHTest;πUsesπ LZH;ππConstπ MaxBuf = 4096; { Must be bigger than the biggest chunk being asked For. }ππTypeπ BufType = Array[1..MaxBuf] of Byte;π BufPtr = ^BufType;ππVarπ InBuf, OutBuf : BufPtr;π inFile, OutFile : File;π s : String;π Bytes_Written : LongInt;π Size : LongInt;π Temp : Word;πππ {$F+}π Procedure GetBlock(Var Target; NoBytes : Word; Var Actual_Bytes : Word);π Constπ Posn : Word = 1;π Buf : Word = 0;π Varπ Temp : Word;π beginπ if (Posn > Buf) or (Posn + NoBytes > succ(Buf)) thenπ beginπ if Posn > Buf thenπ beginπ blockread(inFile, InBuf^, MaxBuf, Buf);π Write('+');π endπ elseπ beginπ move(InBuf^[Posn], InBuf^[1], Buf - Posn);π blockread(inFile, InBuf^[Buf - Posn], MaxBuf - (Buf - Posn), Temp);π Buf := Buf - Posn + Temp;π Write('+');π end;π if Buf = 0 thenπ beginπ Actual_Bytes := 0;π Writeln;π Exit;π end;π Posn := 1;π end;π move(InBuf^[Posn], Target, NoBytes);π inc(Posn, NoBytes);π if Posn > succ(Buf) thenπ Actual_Bytes := NoBytes - (Posn - succ(Buf))π else Actual_Bytes := NoBytes;π end;πππ Procedure PutBlock(Var Source; NoBytes : Word; Var Actual_Bytes : Word);π Constπ Posn : Word = 1;π Varπ Temp : Word;π beginπ if NoBytes = 0 then { Flush condition }π beginπ blockWrite(OutFile, OutBuf^, pred(Posn), Temp);π Exit;π end;π if (Posn > MaxBuf) or (Posn + NoBytes > succ(MaxBuf)) thenπ beginπ blockWrite(OutFile, OutBuf^, pred(Posn), Temp);π Posn := 1;π end;π move(Source, OutBuf^[Posn], NoBytes);π inc(Posn, NoBytes);π Actual_Bytes := NoBytes;π end;ππ {$F-}ππbeginπ if (paramcount <> 3) thenπ beginπ Writeln('Usage:lzhuf e(Compression)|d(unCompression) inFile outFile');π halt(1);π end;π s := paramstr(1);π if not(s[1] in ['D', 'E', 'd', 'e']) thenπ halt(1);π assign(inFile, paramstr(2));π reset(inFile, 1);π assign(OutFile, paramstr(3));π reWrite(OutFile, 1);π new(InBuf);π new(OutBuf);π if (upCase(s[1]) = 'E') thenπ beginπ Size := Filesize(inFile);π blockWrite(OutFile, Size, sizeof(LongInt));π LZHPack(Bytes_Written, GetBlock, PutBlock);π PutBlock(Size, 0, Temp);π endπ elseπ beginπ blockread(inFile, Size, sizeof(LongInt));π LZHUnPack(Size, GetBlock, PutBlock);π PutBlock(Size, 0, Temp);π end;π dispose(OutBuf);π dispose(InBuf);π close(inFile);π close(OutFile);πend.ππ 6 05-28-9313:33ALL SWAG SUPPORT TEAM View LZH File IMPORT 33 «Qû Program lzhview;ππUsesπ Dos, Crt;ππConstπ BSize = 4096; { I/O Buffer Size }ππType LZHHead = Recordπ HSize : Byte;π Fill1 : Byte;π Method : Array[1..5] of Char;π CompSize : LongInt;π UCompSize : LongInt;π Dos_DT : LongInt;π Fill2 : Word;π FileNameLen: Byte;π FileName : Array[1..12] of Char;π end;ππVar LZH1 : LZHHead;π DT : DateTime;π FSize,L,C : LongInt;π F : File;π BUFF : Array[1..BSize] of Byte;π DATE : String[8]; { formatted date as YY/MM/DD }π TIME : String[6]; { " time as HH:MM }π RES : Word;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π LZHString,π SName : String;π QUIT : Boolean;π SW : Pointer;ππFunction upper(st:String):String;πVar i : Integer;πbeginπ For i := 1 to length(st) do st[i] :=upcase(st[i]);π upper := st;πend;ππFunction ord_to_str(i:LongInt;j:Byte):String;πVar c:String;πbeginπ str(i,c);π While length(c)<j do c:=' '+c;π ord_to_str:=c;πend;ππProcedure FDT(LI:LongInt); { Format Date/Time (time With AM PM) fields }πVar t_ext : String;πbeginπ UnPackTime (LI,DT);π DATE := ord_to_str(DT.Month,2)+'/'+ord_to_str(DT.Day,2)+'/'π +ord_to_str(DT.Year mod 100,2);π if DATE[1] = ' ' then DATE[1] := '0';π if DATE[4] = ' ' then DATE[4] := '0';π if DATE[7] = ' ' then DATE[7] := '0';π if DT.Hour in [0..11] then t_ext:='a' else t_ext:='p';π if DT.Hour in [13..24] then Dec(DT.Hour,12);π TIME := ord_to_str(DT.Hour,2)+':'+ord_to_str(DT.Min,2);π if TIME[1] = ' ' then TIME[1] := '0';π if TIME[4] = ' ' then TIME[4] := '0';π TIME:=TIME+t_ext;πend; { FDT }ππProcedure GET_LZH_ENTRY;πbeginπ FillChar(LZH1,SizeOf(LZHHead),#0);π FillChar (DT,SizeOf(DT),#0);π L := SizeOf(LZHHead);π Seek (F,C); BlockRead (F,BUFF,L,RES);π Move (BUFF[1],LZH1,L);π With LZH1 doπ if HSize > 0 thenπ beginπ Move (FileNameLen,SNAME,FileNameLen+1);π UnPackTime (Dos_DT,DT);π FSize := CompSizeπ endπ else QUIT := Trueπend; { GET_LZH_ENTRY }ππProcedure DO_LZH (FN : String);πVar fnstr, LZHMeth : String;π fls,totu,totc : LongInt;πbeginπ totu:=0; totc:=0; fls:=0;π Assign (F,FN);π {$I-} Reset (F,1); {$I+}π if Ioresult<>0 thenπ beginπ Writeln(upper(FN)+' not found');π Exit;π end;π FSize := FileSize(F);π C := 0;π QUIT := False;π Writeln('LZH File : '+upper(FN));π Writeln;π Writeln(' Filename OrigSize CompSize Method Date 'π +' Time');π Writeln('------------ -------- -------- -------- --------'π +' ------');π Repeatπ GET_LZH_ENTRY;π if not QUIT thenπ beginπ FSplit (SNAME,DIR,FNAME,EXT);π fnstr:=FNAME+EXT;π While length(fnstr)<12 do insert(' ',fnstr,length(fnstr)+1);π FDT(LZH1.Dos_DT);π inc(totu,lzh1.ucompsize);π inc(totc,lzh1.compsize);π inc(fls,1);π Case LZH1.Method[4] of {normally only 0,1 or 5}π '0' : LZHMeth:='Stored ';π '1' : LZHMeth:='Frozen 1';π '2' : LZHMeth:='Frozen 2';π '3' : LZHMeth:='Frozen 3';π '4' : LZHMeth:='Frozen 4';π '5' : LZHMeth:='Frozen 5';π else LZHMeth:=' Unknown';π end;π LZHString:=Fnstr+' '+ord_to_str(LZH1.UCompsize,8)+' '+π ord_to_str(LZH1.Compsize,8)+' '+lzhmeth+' 'π +DATE+' '+TIME;π Writeln(LZHString);π end;π Inc (C,FSize+LZH1.HSize+2)π Until QUIT;π Close (F);π Writeln('------------ -------- -------- -------- --------'π +' -----');π Writeln(ord_to_str(fls,5)+' Files '+ord_to_str(totu,8)+' 'π +ord_to_str(totc,8));πend; { DO_LZH }ππbeginπ ClrScr;π do_lzh('whatever.lzh'); { <-- place Filename here }πend.ππ{πNote the changes in the date processing and compression method display.πThanks again For the code.π} 7 05-28-9313:33ALL SWAG SUPPORT TEAM Testing for PKLITE File IMPORT 10 «Q\> {π > Your approach (as all similar ones I have seen so Far) has a majorπ > drawback: you can't use PKLITE, TinYPROG, LZEXE afterwards toπ > squeeze them down in size, as the offsets of the Program change.π > Has anyone come up With a another approach circumventing this?ππYes, you can store it at the end of the .EXE File ( after theπcode ) With the following routine :π}ππFunction CodeLenOnDisk( FName : String ) : LongInt;πVar ImageInfo : Recordπ ExeID : Array[ 0..1 ] of Char;π Remainder : Word;π Size : Wordπ end;π F : File;πbeginπ Assign( F, FName );π Reset( F, 1 );π if Ioresult <> 0 then Exit;π BlockRead( F, ImageInfo, Sizeof( ImageInfo ));π if ImageInfo.ExeID <> 'MZ' then Exit;π CodeLenOnDisk := LongInt( ImageInfo.size-1 )*512 + ImageInfo.Remainder;πend;ππ{πWith this one, you can determine the end of the code in your .EXE File,πand then Write other data there, Drawback : This Dosen't work in networkπenvironments or With shared .EXE Files. I'd recommend an external passWordπFile, and there storing a hash of the passWord.π}π 8 05-28-9313:33ALL SWAG SUPPORT TEAM SHOW ARJ Archive Files IMPORT 15 «Q∙∩ πProgram ReadArj;πUsesπ Crt,π Search;ππConstπ ArjID = #96#234;ππTypeπ Array10 = Array[1..10] of Byte;π Array12 = Array[1..12] of Char;ππ AFileRec = Recordπ FileDate : LongInt;π CompressedSize : LongInt;π originalSize : LongInt;π DudSpace : Array10;π FileName : Array12π end;ππ Array60K = Array[1..61440] of Byte;ππVarπ Buffer : Array60K;ππ ArjFileRec : AFileRec;ππ ArjFileSize,π ArjRecStart,π ArjRecStop,π Index,π Index1 : LongInt;ππ ArjFile : File;ππbeginπ ClrScr;π fillChar(Buffer, sizeof(Buffer), 0);π fillChar(ArjFileRec, sizeof(ArjFileRec), 0);π ArjFileSize := 0;π ArjRecStart := 1;π ArjRecStop := 0;π assign(ArjFile, 'TEST.ARJ');π {$I-}π reset(ArjFile, 1);π {$I+}π if (ioresult <> 0) thenπ beginπ Writeln(' ERRor OPENinG TEST.ARJ');π halt(255)π end;π ArjFileSize := Filesize(ArjFile);π Index := ArjFileSize - 50;π blockread(ArjFile, Buffer, Index);π close(ArjFile);π Index1 := 50;π ArjFileRec.Filename := ' ';π While ((Index1 + 33) < ArjFileSize) doπ beginπ ArjRecStart := StrPos(Buffer[Index1], Index, ArjID) + 11;π ArjRecStop := StrPos(Buffer[Index1 + ArjRecStart + 22], 13, #0);π move(Buffer[ArjRecStart + Index1], ArjFileRec, (ArjRecStop + 21));π With ArjFileRec doπ beginπ Writeln(' ',FileName, ' Compressed size = ', CompressedSize:6,π ' original size = ', originalSize:6);π FileName := ' ';π inc(Index1, CompressedSize + ArjRecStop + ArjRecStart);π dec(Index, CompressedSize + ArjRecStop + ArjRecStart)π endπ endπend.ππ 9 05-28-9313:33ALL SWAG SUPPORT TEAM Test String Compression IMPORT 24 «QΘ 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.π 10 05-28-9313:33ALL STEVE WIERENGA ARJ File Viewer IMPORT 53 «Qá╗ {πAuthor: Steve WierengaπARJ Viewerπ}π{Hello All:πI am releasing these Units to the public domain. They are Units to view Arj,πLzh, and Zip Files. They are by no means professional, and probably have someπbugs. If you use these in your Programs and feel like giving me credit, Iπwon't Object... Here goes: }ππUnit ArjV;ππ(**) Interface (**)ππUsesπ Dos,Crt;ππTypeπ AFHeader = Record { ArjFileHeader }π HeadID,π HdrSize : Word;π HeadSize,π VerNum,π MinVerNum,π HostOS,π ArjFlag,π Method,π FType,π Reserved : Byte;π FileTime,π PackSize,π OrigSize,π FileCRC : LongInt;π FilePosF,π FileAcc,π HostData : Word;π end;ππVarπ ff : Integer;π b : Byte;π f : File;π sl : LongInt;π NR : Word;π FHdr : ^AFHeader;π s,sss : String;π Method : String[8];π l : String[80];π Z,π totalu,π totalc : LongInt;π x,d : LongInt;π Dt1,dt2: DateTime;π i,e : Integer;π registered : Boolean;ππProcedure ArjView(ArjFile : String);πFunction GAN(ArjFile : String): String;ππ(**) Implementation (**)ππProcedure Terminate;πbeginπ Write('ARCHPEEK could not find specified File.π Aborting...');π Halt;πend;ππProcedure ArjView(ArjFile : String);πbeginπ New(FHdr);π Assign(f, arjFile);π {$I-}π Reset(F, 1); { Open File }π {$I+}π If IOResult <> 0 thenπ Terminate; { Specified File exists?}π registered := False; { Unregistered }π if not registered thenπ beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π SL := 0;z := 0;TotalU := 0; TotalC := 0; { Init Variables }π sss := GAN(ArjFile); { Get the Arj Filename }π Writeln('Arj FileName: ',SSS);π Write(' Name Length Size Saved Method Date Time ');π WriteLn('____________________________________________________________________________');π ff := 0;π Repeatπ ff := ff + 1;π Seek(F,SL);π BlockRead(F,FHdr^,SizeOf(AFHeader),NR); { Read the header }π If (NR = SizeOf(AFHeader)) Thenπ beginπ s := '';π Repeatπ BlockRead(F,B,1); { Get Char For Compressed Filename }π If B <> 0 Thenπ s := s + Chr(b); { Put Char in String }π Until B = 0; { Until no more Chars }π Case Length(S) Of { Straighten out String }π 0 : s := s + ' ';π 1 : S := s + ' ';π 2 : s := s + ' ';π 3 : S := S + ' ';π 4 : S := S + ' ';π 5 : S := S + ' ';π 6 : S := S + ' ';π 7 : S := S + ' ';π 8 : S := S + ' ';π 9 : S := S + ' ';π 10 : S := S + ' ';π 11 : S := S + ' ';π 12 : S := S;π end;π z := z + 1;π UnPackTime(FHdr^.FileTime,dt2); { Get the time of compressed File }π Case FHdr^.Method Of { Get compression method }π 0 : Method := 'Stored ';π 1 : Method := 'Most ';π 2 : Method := '2nd Most';π 3 : Method := '2nd Fast';π 4 : Method := 'Fastest ';π end;π Write( ' ',S,FHdr^.OrigSize:9,FHdr^.PackSize:10);π { Write Filesizes }π If ff > 1 thenπ { Don't get first Arj File in Arj File }π Write( (100-FHdr^.PackSize/FHdr^.OrigSize*100):9:0,'%',Method:15)π { Write ratios, method }π Elseπ Write( Method:25);π Case dt2.month of { Show date of compressed File }π 1..9 : Write( '0':4,dt2.month);π 10..12 : Write( dt2.month:4);π end;π Write( '/');π Case dt2.day ofπ 1..9 : Write( '0',dt2.day);π 10..31 : Write( dt2.day);π end;π Write( '/');π Case dt2.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt2.hour of { Show time of compressed File }π 0..9 : Write( '0':2,dt2.hour,':');π 10..23 : Write( dt2.hour:3,':');π end;π Case dt2.min ofπ 0..9 : Write( '0',dt2.min,':');π 10..59 : Write( dt2.min,':');π end;π Case dt2.sec ofπ 0..9 : Writeln( '0',dt2.sec);π 10..59 : Writeln( dt2.sec);π end;π TotalU := TotalU + FHdr^.OrigSize; { Increase total uncompressed size }π TotalC := TotalC + FHdr^.PackSize; { Increase total compressed size }π Repeatπ BlockRead(F,B,1);π Until b = 0;π BlockRead(F,FHdr^.FileCRC,4); { Go past File CRC }π BlockRead(f,NR,2);π Sl := FilePos(F) + FHdr^.PackSize; { Where are we in File? }π end;ππ Until (FHdr^.HdrSize = 0); { No more Files? }π GetFTime(F,x);π UnPackTime(x,dt1);π WriteLn('============================================================================');π Write( (z-1):4,' Files',TotalU:12,TotalC:10,(100-TotalC/TotalU*100):9:0,'%');π Case dt1.month of { Get date and time of Arj File }π 1..9 : Write( '0':19,dt1.month);π 10..12 : Write( dt1.month:20);π end;π Write( '/');π Case dt1.day ofπ 1..9 : Write( '0',dt1.day);π 10..31 : Write( dt1.day);π end;π Write( '/');π Case dt1.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt1.hour ofπ 0..9 : Write( '0':2,dt1.hour,':');π 10..23 : Write( dt1.hour:3,':');π end;π Case dt1.min ofπ 0..9 : Write( '0',dt1.min,':');π 10..59 : Write( dt1.min,':');π end;π Case dt1.sec ofπ 0..9 : Writeln( '0',dt1.sec);π 10..59 : Writeln( dt1.sec);π end;π Close(f);π Dispose(FHdr); { Done }πend;ππFunction GAN(ARJFile:String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(ARJFile,Dir,Name,Exts);π GAN := Name + Exts;πend;ππend.π 11 05-28-9313:33ALL STEVE WIERENGA LZH File Viewer IMPORT 57 «Q[, {πAuthor: Steve WierengaπLZH Viewerπ}ππUnit Lzhv;π(**) Interface (**)πUsesπ Dos,Crt;ππTypeπ FileheaderType = Record { Lzh File header }π Headsize,π Headchk : Byte;π HeadID : packed Array[1..5] of Char;π Packsize,π Origsize,π Filetime : LongInt;π Attr : Word;π Filename : String[12];π f32 : PathStr;π dt : DateTime;π end;ππVarπ Fh : FileheaderType;π Fha : Array[1..sizeof(FileheaderType)] of Byte Absolute fh;π crc : Word; { CRC value }π crcbuf : Array[1..2] of Byte Absolute CRC;π crc_table : Array[0..255] of Word; { Table of CRC's }π inFile : File; { File to be processed }π registered : Boolean; { Is registered? }ππProcedure Make_crc_table; { Create table of CRC's }πFunction Mksum : Byte; { Get CheckSum }πProcedure ViewLzh(LZHFile : String); { View the File }πFunction GAN(LZHFile : String) : String; { Get the LZH Filename }πππ(**) Implementation (**)πProcedure Terminate; { Exit the Program }πbeginπ Write('ARCHPEEK could not find specified File. Aborting...');π Halt;πend;ππProcedure Make_crc_table;πVarπ i,π index,π ax : Word;π carry : Boolean;πbeginπ index := 0;π Repeatπ ax := index;π For i := 1 to 8 doπ beginπ carry := odd(ax);π ax := ax shr 1;π if carry thenπ ax := ax xor $A001;π end;π crc_table[index] := ax;π inc(index);π Until index > 255;πend;ππ{ use this to calculate the CRC value of the original File }π{ call this Function afer reading every Byte from the File }πProcedure calccrc(data : Byte);πVarπ index : Integer;πbeginπ crcbuf[1] := crcbuf[1] xor data;π index := crcbuf[1];π crc := crc shr 8;π crc := crc xor crc_table[index];πend;πππFunction Mksum : Byte; {calculate check sum For File header }πVarπ i : Integer;π b : Byte;πbeginπ b := 0;π For i := 3 to fh.headsize+2 doπ b := b+fha[i];π mksum := b;πend;ππProcedure viewlzh(LZHFile : String); { View the LZH File }πVarπ l1,l2,π oldFilepos,π a,b,a1,b1,π totalorig,π totalpack : LongInt;π count,z : Integer;π numread,π i, year1,π month1,π day1,π hour1,π min1,π sec1 : Word;π s1 : String[50];π s2 : String[20];π l : String[80];π sss : String;πbeginπ registered := False; { Unregistered }π if not registered then { Registered? }π beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π assign(inFile,LZHFile);π {$I-}π reset(inFile,1); { Open LZH File }π {$I+}π If IOResult <> 0 thenπ Terminate; { Specified File exists? }π sss := GAN(LZHFile); { Get Filename of LZH File }π Writeln( 'Lzh FileName: ',sss);π WriteLn( ' Name Length Size Saved Date Time ');π WriteLn('__________________________________________________________');π oldFilepos := 0; { Init Variables }π count := 1;π z := 0;π a1 := 0;π Repeatπ z := z + 1;π seek(inFile,oldFilepos); {π Goto start of File}π blockread(inFile,fha,sizeof(FileheaderType),numread); {π Read Fileheader}π oldFilepos := oldFilepos+fh.headsize+2+fh.packsize; {π Where are we? }π i := Mksum; { Get the checksum }π if fh.headsize <> 0 thenπ beginπ if i <> fh.headchk thenπ beginπ Writeln('Error in File. Unable to read. Aborting...');π Close(inFile);π Exit;π end;π Case Length(Fh.FileName) Of { Straigthen out String }π 1 : Fh.FileName := Fh.FileName + ' ';π 2 : Fh.FileName := Fh.FileName + ' ';π 3 : Fh.FileName := Fh.FileName + ' ';π 4 : Fh.FileName := Fh.FileName + ' ';π 5 : Fh.FileName := Fh.FileName + ' ';π 6 : Fh.FileName := Fh.FileName + ' ';π 7 : Fh.FileName := Fh.FileName + ' ';π 8 : Fh.FileName := Fh.FileName + ' ';π 9 : Fh.FileName := Fh.FileName + ' ';π 10 : Fh.FileName := Fh.FileName + ' ';π 11 : Fh.FileName := Fh.FileName + ' ';π 12 : Fh.FileName := Fh.FileName + '';π end;π UnPackTime(Fh.FileTime,Fh.DT);π a1 := a1 + Fh.OrigSize; { Increase Uncompressed Size }π Write(' ', fh.Filename : 2, fh.origsize : 9, fh.packSize : 10,π (100 - fh.packSize / fh.origSize * 100) : 5 : 0, '%');π { Display info }π Case fh.dt.month of { Get date and time }π 1..9 : Write( '0':4,fh.dt.month);π 10..12 : Write( ' ',fh.dt.month:4);π end;π Write( '/');π Case fh.dt.day ofπ 1..9 : Write( '0',fh.dt.day);π 10..31 : Write( fh.dt.day);π end;π Write( '/');π Case fh.dt.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case fh.dt.hour ofπ 0..9 : Write( '0':3,fh.dt.hour,':');π 10..23 : Write( ' ',fh.dt.hour:3,':');π end;π Case fh.dt.min ofπ 0..9 : Write( '0',fh.dt.min,':');π 10..59 : Write( fh.dt.min,':');π end;π Case fh.dt.sec ofπ 0..9 : Writeln( '0',fh.dt.sec);π 10..59 : Writeln( fh.dt.sec);π end;π end;π Until (fh.headsize=0);π Writeln( '===========================================================');π GetFTime(inFile,l1);π UnPackTime(l1,fh.dt);π Write( ' ', z, ' Files ', a1 : 12, FileSize(inFile) : 10,π (100 - FileSize(inFile) / a1 * 100) : 5 : 0, '%');π Case fh.dt.month ofπ 1..9 : Write( '0':4,fh.dt.month);π 10..12 : Write( ' ',fh.dt.month:4);π end;π Write( '/');π Case fh.dt.day ofπ 1..9 : Write( '0',fh.dt.day);π 10..31 : Write( fh.dt.day);π end;π Write( '/');π Case fh.dt.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case fh.dt.hour ofπ 0..9 : Write( '0':3,fh.dt.hour,':');π 10..23 : Write( ' ',fh.dt.hour:3,':');π end;π Case fh.dt.min ofπ 0..9 : Write( '0',fh.dt.min,':');π 10..59 : Write( fh.dt.min,':');π end;π Case fh.dt.sec ofπ 0..9 : Writeln( '0',fh.dt.sec);π 10..59 : Writeln( fh.dt.sec);π end;πend;ππFunction GAN(LZHFile : String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(LZHFile,Dir,Name,Exts);π GAN := Name + Exts;πend;πππend.ππ 12 05-28-9313:33ALL STEVE WIERENGA Zip File Viewer IMPORT 36 «Qdº {πAuthor: Steve WierengaπZIP Viewerπ}ππUnit ZipV;ππ(**) Interface (**)ππUsesπ Dos,Crt;πProcedure ZipView(ZIPFile:String);πFunction GAN(ZIPFile : String) : String;ππ(**) Implementation (**)ππProcedure Terminate;πbeginπ Write('ARCHPEEK could not find specified File. Aborting...');π Halt;πend;ππProcedure ZipView(ZIPFile : String); { View the ZIP File }πConstπ SIG = $04034B50; { Signature }πTypeπ ZFHeader = Record { Zip File Header }π Signature : LongInt;π Version,π GPBFlag,π Compress,π Date,Time : Word;π CRC32,π CSize,π USize : LongInt;π FNameLen,π ExtraField : Word;π end;ππVarπ z : Integer;π x,π totalu,π totalc : LongInt;π Hdr : ^ZFHeader;π F : File;π S,sss : String;π own : Text;π dt1 : DateTime;π l : String[80];π registered : Boolean; { Is registered? }ππConstπ CompTypes : Array[0..7] of String[9] =π ('Stored ','Shrunk ','Reduced1','Reduced2','Reduced3',π 'Reduced4','Imploded ','Deflated');π { Method used to compress }π r = #196;π q = #205;ππbeginπ z := 0; totalu := 0; totalc := 0; { Init Variables }π registered := False; { Unregistered }π if not registered then { Is registered? }π beginπ Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');π Delay(200);π end;π New(Hdr);π Assign(F,ZIPFile);π {$I-}π Reset(F,1); { Open File }π {$I+}π If IOResult <> 0 then Terminate; { Couldn't open Zip File }π sss := GAN(ZipFile); { Get the Zip Filename }π Writeln('Zip FileName: ',sss);π WriteLn( ' Name Length Size Saved Method');π WriteLn(r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,π r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r);π Repeatπ FillChar(S,SizeOf(S), #0); { Pad With nulls }π BlockRead(F,Hdr^,SizeOf(ZFHeader));π { Read File Header }π BlockRead(F,Mem[Seg(S) : Ofs(S) + 1], Hdr^.FNameLen);π s[0] := Chr(Hdr^.FNameLen);π Case Length(S) Of { Straighten String }π 0 : s := s + ' ';π 1 : S := s + ' ';π 2 : s := s + ' ';π 3 : S := S + ' ';π 4 : S := S + ' ';π 5 : S := S + ' ';π 6 : S := S + ' ';π 7 : S := S + ' ';π 8 : S := S + ' ';π 9 : S := S + ' ';π 10 : S := S + ' ';π 11 : S := S + ' ';π 12 : S := S;π end;π If (Hdr^.Signature = Sig) Then { Is a header }π beginπ z := z + 1;π WriteLn(S,Hdr^.USize:9,Hdr^.CSize:10,(100-Hdr^.CSize/Hdr^.USize*100):5:0,'%',π CompTypes[Hdr^.Compress]:16);π Inc(TotalU,Hdr^.USize); { Increment size uncompressed }π Inc(TotalC,Hdr^.CSize); { Increment size compressed }π end;π Seek(F,FilePos(F) + Hdr^.CSize + Hdr^.ExtraField);π Until Hdr^.Signature <> SIG; { No more Files }π GetFTime(F,x);π UnPackTime(x,DT1);π WriteLn(q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,π q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q);π Write( z:4,' Files ',TotalU:12,TotalC:10,(100-TotalC/TotalU*100):5:0,'%');π Case dt1.month of { Get Zip File date and time }π 1..9 : Write( '0':4,dt1.month);π 10..12 : Write( dt1.month:4);π end;π Write( '/');π Case dt1.day ofπ 1..9 : Write( '0',dt1.day);π 10..31 : Write( dt1.day);π end;π Write( '/');π Case dt1.year ofπ 1980 : Write( '80');π 1981 : Write( '81');π 1982 : Write( '82');π 1983 : Write( '83');π 1984 : Write( '84');π 1985 : Write( '85');π 1986 : Write( '86');π 1987 : Write( '87');π 1988 : Write( '88');π 1989 : Write( '89');π 1990 : Write( '90');π 1991 : Write( '91');π 1992 : Write( '92');π 1993 : Write( '93');π 1994 : Write( '94');π 1995 : Write( '95');π 1996 : Write( '96');π end;π Case dt1.hour ofπ 0..9 : Write( '0':3,dt1.hour,':');π 10..23 : Write( dt1.hour:3,':');π end;π Case dt1.min ofπ 0..9 : Write( '0',dt1.min,':');π 10..59 : Write( dt1.min,':');π end;π Case dt1.sec ofπ 0..9 : Writeln( '0',dt1.sec);π 10..59 : Writeln( dt1.sec);π end;π Close(F);π Dispose(Hdr);πend;πππFunction GAN(ZIPFile:String): String;πVarπ Dir : DirStr;π Name : NameStr;π Exts : ExtStr;πbeginπ FSplit(ZIPFile,Dir,Name,Exts);π GAN := Name + Exts;πend;ππend.π 13 09-26-9310:14ALL IAN HUNTER LZW Compression Unit IMPORT 74 «Qú! (*πFrom: IAN HUNTERπSubj: LZW Compression Unitπ*)ππUnit IHLZW;π {- Unit to handle data compression }πInterfaceπConstπ StackOverFlow = 1;π DeniedWrite = 2;πTypeπ GetCharFunc = Function (Var Ch : Char) : Boolean;π PutCharProc = Procedure (Ch : Char);π LZW = Objectπ GetChar : GetCharFunc;π PutChar : PutCharProc;π LastError : Word;π Constructor Init;π Function Get_Hash_Code (PrevC, FollC : Integer) : Integer;π Procedure Make_Table_Entry (PrevC, FollC: Integer);π Procedure Initialize_String_Table;π Procedure Initialize;π Function Lookup_String (PrevC, FollC : Integer) : Integer;π Procedure Get_Char (Var C : Integer);π Procedure Put_Char (C : Integer);π Procedure Compress;π Procedure Decompress;π End;ππImplementationπConstπ MaxTab = 4095;π No_Prev = $7FFF;π EOF_Char = -2;π End_List = -1;π Empty = -3;ππTypeπ AnyStr = String;π String_Table_Entry = Recordπ Used : Boolean;π PrevChar : Integer;π FollChar : Integer;π Next : Integer;π End;ππVarπ String_Table : Array [0..MaxTab] Of String_Table_Entry;π Table_Used : Integer;π Output_Code : Integer;π Input_Code : Integer;π If_Compressing : Boolean;ππConstructor LZW.Init;πBeginπ LastError := 0;πEnd;ππFunction LZW.Get_Hash_Code (PrevC, FollC : Integer) : Integer;πVarπ Index : Integer;π Index2 : Integer;πBeginπ Index := ((PrevC SHL 5) XOR FollC) AND MaxTab;π If (Not String_Table [Index].Used)π Thenπ Get_Hash_Code := Indexπ Elseπ Beginπ While (String_Table[Index].Next <> End_List) Doπ Index := String_Table[Index].Next;π Index2 := (Index + 101) And MaxTab;π While (String_Table[Index2].Used) Doπ Index2 := Succ (Index2) AND MaxTab;π String_Table[Index].Next := Index2;π Get_Hash_Code := Index2;π End;πEnd;ππProcedure LZW.Make_Table_Entry (PrevC, FollC: Integer);πBeginπ If (Table_Used <= MaxTab )π Thenπ Beginπ With String_Table [Get_Hash_Code (PrevC , FollC)] Doπ Beginπ Used := True;π Next := End_List;π PrevChar := PrevC;π FollChar := FollC;π End;π Inc (Table_Used);π(*π IF ( Table_Used > ( MaxTab + 1 ) ) THENπ BEGINπ WRITELN('Hash table full.');π END;π*)π End;πEnd;ππProcedure LZW.Initialize_String_Table;πVarπ I : Integer;πBeginπ Table_Used := 0;π For I := 0 to MaxTab Doπ With String_Table[I] Doπ Beginπ PrevChar := No_Prev;π FollChar := No_Prev;π Next := -1;π Used := False;π End;π For I := 0 to 255 Doπ Make_Table_Entry (No_Prev, I);πEnd;ππProcedure LZW.Initialize;πBeginπ Output_Code := Empty;π Input_Code := Empty;π Initialize_String_Table;πEnd;ππFunction LZW.Lookup_String (PrevC, FollC: Integer) : Integer;πVarπ Index : Integer;π Index2 : Integer;π Found : Boolean;πBeginπ Index := ((PrevC Shl 5) Xor FollC) And MaxTab;π Lookup_String := End_List;π Repeatπ Found := (String_Table[Index].PrevChar = PrevC) Andπ (String_Table[Index].FollChar = FollC);π If (Not Found)π Thenπ Index := String_Table [Index].Next;π Until Found Or (Index = End_List);π If Foundπ Thenπ Lookup_String := Index;πEnd;ππProcedure LZW.Get_Char (Var C : Integer);πVarπ Ch : Char;πBeginπ If Not GetChar (Ch)π Thenπ C := EOF_Charπ Elseπ C := Ord (Ch);πEnd;ππProcedure LZW.Put_Char (C : Integer);πVarπ Ch : Char;πBeginπ Ch := Chr (C);π PutChar (Ch);πEnd;ππProcedure LZW.Compress;π Procedure Put_Code (Hash_Code : Integer);π Beginπ If (Output_Code = Empty)π Thenπ Beginπ Put_Char ((Hash_Code Shr 4) And $FF);π Output_Code := Hash_Code And $0F;π Endπ Elseπ Beginπ Put_Char (((Output_Code Shl 4) And $FF0) +π ((Hash_Code Shr 8) And $00F));π Put_Char (Hash_Code And $FF);π Output_Code := Empty;π End;π End;πππ Procedure Do_Compression;π Varπ C : Integer;π WC : Integer;π W : Integer;π Beginπ Get_Char (C);π W := Lookup_String (No_Prev, C);π Get_Char (C);π While (C <> EOF_Char) Doπ Beginπ WC := Lookup_String (W, C);π If (WC = End_List)π Thenπ Beginπ Make_Table_Entry (W, C );π Put_Code (W);π W := Lookup_String (No_Prev, C);π Endπ Elseπ W := WC;π Get_Char( C );π End;π Put_Code (W);π End;ππBeginπ If_Compressing := True;π Initialize;π Do_Compression;πEnd;ππProcedure LZW.Decompress;πConstπ MaxStack = 4096;πVarπ Stack : Array [1..MaxStack] Of Integer;π Stack_Pointer : Integer;ππ Procedure Push (C : Integer);π Beginπ Inc (Stack_Pointer);π Stack [Stack_Pointer] := C;π If (Stack_Pointer >= MaxStack)π Thenπ Beginπ LastError := 1;π Exit;π End;π End;ππ Procedure Pop (Var C : Integer);π Begin;π If (Stack_Pointer > 0)π Thenπ Beginπ C := Stack [Stack_Pointer];π Dec (Stack_Pointer);π Endπ Elseπ C := Empty;π End;ππ Procedure Get_Code (Var Hash_Code : Integer);π Varπ Local_Buf : Integer;π Beginπ If (Input_Code = Empty)π Thenπ Beginπ Get_Char (Local_Buf);π If (Local_Buf = EOF_Char)π Thenπ Beginπ Hash_Code := EOF_Char;π Exit;π End;π Get_Char (Input_Code);π If (Input_Code = EOF_Char)π Thenπ Beginπ Hash_Code := EOF_Char;π Exit;π End;π Hash_Code := ((Local_Buf Shl 4) And $FF0) +π ((Input_Code Shr 4) And $00F);π Input_Code := Input_Code And $0F;π Endπ Elseπ Beginπ Get_Char (Local_Buf);π If (Local_Buf = EOF_Char)π Thenπ Beginπ Hash_Code := EOF_Char;π Exit;π End;π Hash_Code := Local_Buf + ((Input_Code Shl 8) And $F00);π Input_Code := Empty;π End;π End;ππ Procedure Do_Decompression;π Varπ C : Integer;π Code : Integer;π Old_Code : Integer;π Fin_Char : Integer;π In_Code : Integer;π Last_Char : Integer;π Unknown : Boolean;π Temp_C : Integer;π Beginπ Stack_Pointer := 0;π Unknown := False;π Get_Code (Old_Code);π Code := Old_Code;π C := String_Table[Code].FollChar;π Put_Char (C);π Fin_Char := C;π Get_Code (In_Code);π While (In_Code <> EOF_Char) Doπ Beginπ Code := In_Code;π If (Not String_Table [Code].Used)π Thenπ Beginπ Last_Char := Fin_Char;π Code := Old_Code;π Unknown := TRUE;π End;π While (String_Table [Code].PrevChar <> No_Prev) Doπ With String_Table[Code] Doπ Beginπ Push (FollChar);π If (LastError <> 0)π Thenπ Exit;π Code := PrevChar;π End;π Fin_Char := String_Table [Code].FollChar;π Put_Char (Fin_Char);π Pop (Temp_C);π While (Temp_C <> Empty) Doπ Beginπ Put_Char (Temp_C);π Pop (Temp_C);π End;π If Unknownπ Thenπ Beginπ Fin_Char := Last_Char;π Put_Char (Fin_Char);π Unknown := FALSE;π End;π Make_Table_Entry (Old_Code, Fin_Char);π Old_Code := In_Code;π Get_Code( In_Code );π End;π End;ππBeginπ If_Compressing := False;π Initialize;π Do_Decompression;πEnd;ππEnd.ππ(* ***************************** TEST PROGRAM ****************** *)ππProgram LZWTest;π{ program to demo/test the LZW object }πUsesπ IHLZW; { Only needs this }πVarπ C : LZW; { The Star of the Show; the Compression Object }ππ{$F+} Function GetTheChar (Var Ch : Char) : Boolean; {$F-}π{ Make your GetChar routine's declaration look exactly like this }ππBeginπ If Not Eof (Input) { End of Input? }π Thenπ Beginπ Read (Input, Ch); { Then read one character into Ch and ... }π GetTheChar := True; { ... Return True }π Endπ Elseπ GetTheChar := False; { Otherwise return False }πEnd;ππ{$F+} Procedure PutTheChar (Ch : Char); {$F-}π{ Make your PutChar routine's declaration look exactly like this }ππBeginπ Write (Output, Ch); { Write Ch to Output file }πEnd;ππBeginπ { Open data files }π Assign (Input, ''); { Standard Input; requires redirection to be useful }π Assign (Output, ''); { Standard Output; requires redirection to be useful }π Reset (Input);π Rewrite (Output);π { Can't fail yet -- maybe a descendant could, though... }π If not C.Initπ Thenπ Halt;π { Assign I/O routines }π C.GetChar := GetTheChar; { Set LZW's GetChar to routine GetTheChar }π C.PutChar := PutTheChar; { Set LZW's PutChar to routine PutTheChar }π { are we compressing or decompressing? }π If (ParamCount = 0)π Thenπ C.Compress { compress }π Elseπ C.Decompress; { decompress }π { All Done! }πEnd.ππ 14 11-02-9310:31ALL ANTHONY GELAT Self Modify PKLITE files IMPORT 42 «QHL {πANTHONY GELATππ>>Is it the size of the EXE File? You can compress it With PKLite orπ>>LZEXE - it'll load into memory With full size, though. This justππ>Nope, it has self modifying data. PKLiting it wouldn't work.ππ I have code For a self modifying EXE that claims to be PKLITEable,π so i believe it can be done...here it isπ}ππUnit PCkSelfM;π{ Programmer: Jim NicholsonππPurpose: Implement a method For creating "self-modifying" .EXE Files fromπTP which will survive the encoding techniques used by LZEXE and PKLite(tm).πFor discussion and examples, see SelfMod.PasπThis Unit contains code placed into the public domain, With the followingπ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^πprovision:πPlease do not distribute modified versions of this code Without indicatingπsuch modification by commenting the File.πif you have questions, comments, modifications, or suggestions, pleaseπfeel free to contact us:ππ PCkS Associatesπ 138 Frances Placeπ Hillside, NJ 07205ππ On CompuServe, EasyPlex to 70152,332π On Delphi CHICKENJNπ On GENie J.NICHOLSON1ππ}ππInterfaceππVarπ ExeFileName : String[128];ππFunction ConfigBlockPresent(Size : Integer) : Boolean;πFunction NewConfigBlock(Var C_B; Size : Integer) : Boolean;πFunction ReadConfigBlock(Var C_B; Size : Integer) : Boolean;πFunction ConfigBlockReWrite(Var C_B; Size : Integer) : Boolean;ππImplementationππUsesπ Dos;ππConstπ SelfModHeader : String[10] = 'PCkS SMODF';π CtrlZ : Char = ^Z;ππVarπ ExeFile : File;π Buffer : String[10];ππFunction ConfigBlockPresent(Size : Integer) : Boolean;πbeginπ assign(ExeFile, ExeFileName);π reset(ExeFile, 1);π seek(ExeFile, FileSize(ExeFile) - (SizeOf(SelfModHeader) + Size + 1));π BlockRead(ExeFile, Buffer, SizeOf(SelfModHeader));π if Buffer = SelfModHeader thenπ ConfigBlockPresent := Trueπ elseπ ConfigBlockPresent := False;π close(ExeFile);πend;ππFunction NewConfigBlock(Var C_B; Size : Integer) : Boolean;πbeginπ NewConfigBlock := False;π if not ConfigBlockPresent(Size) thenπ beginπ assign(ExeFile, ExeFileName);π reset(ExeFile, 1);π Seek(ExeFile, FileSize(ExeFile));π BlockWrite(ExeFile, SelfModHeader, SizeOf(SelfModHeader));π BlockWrite(ExeFile, C_B, Size);π BlockWrite(ExeFile, CtrlZ, 1);π close(ExeFile);π NewConfigBlock := True;π end;πend;ππFunction ReadConfigBlock(Var C_B; Size : Integer) : Boolean;πbeginπ ReadConfigBlock := False;π if ConfigBlockPresent(Size) thenπ beginπ assign(ExeFile, ExeFileName);π reset(ExeFile, 1);π seek(ExeFile, FileSize(ExeFile) - (Size + 1));π BlockRead(ExeFile, C_B, Size);π close(ExeFile);π ReadConfigBlock := True;π end;πend;ππFunction ConfigBlockReWrite(Var C_B; Size : Integer) : Boolean;πVarπ Temp : String;πbeginπ ConfigBlockReWrite := False;π if ConfigBlockPresent(Size) thenπ beginπ assign(ExeFile, ExeFileName);π reset(ExeFile, 1);π seek(ExeFile, FileSize(ExeFile) - (SizeOf(SelfModHeader) + Size + 1));π BlockWrite(ExeFile, SelfModHeader, SizeOf(SelfModHeader));π BlockWrite(ExeFile, C_B, Size);π BlockWrite(ExeFile, CtrlZ, 1);π close(ExeFile);π ConfigBlockReWrite := True;π end;πend;ππbeginπ ExeFileName := ParamStr(0);πend.πππ{--------------------------And SELFMOD.PAS, referenced above: }πProgram SelfMod;ππ{π This demonstrates a technique For creating self-modifying .EXE Files. Itπ has an advantage over techniques which use Typed Constants, in that it willπ survive LZEXEC and PkLite(tm).ππ Note that if the Program is run before LZEXEC is used to compress it, theπ compressed Program will not have been initialized. This is because LZEXECπ strips off the config block (and everything else) at the end of the .EXEπ File. This problem does not occur With PKLite(tm).ππ To run the demo, compile the Program and execute it twice. Whateverπ String you enter is written to the end of the .EXE File.ππ To further demonstrate it's ablities, compress the File With PKLite(tm) orπ LZEXEC after compiling.ππ Address all questions and comments to:ππ PCkS Associatesπ 138 Frances Placeπ Hillside, NJ 07205ππ On CompuServe, EasyPlex to 70152,332π On Delphi CHICKENJNπ On GENie J.NICHOLSON1πππ}ππππUsesπ PCkSelfM;ππTypeπ ConfigBlock = String[40];ππVarπ MyConfig : ConfigBlock;ππbeginπ if ConfigBlockPresent(SizeOf(ConfigBlock)) thenπ if ReadConfigBlock(MyConfig, SizeOf(ConfigBlock)) thenπ beginπ Writeln('Old value of MyConfig: ',MyConfig);π Write('Enter new value: ');π readln(MyConfig);π if ConfigBlockReWrite(MyConfig,SizeOf(ConfigBlock)) thenπ Writeln('Rewrote the block.')π elseπ Writeln('ConfigBlockReWrite failed.');π endπ elseπ Writeln('ReadConfigBlock failed')π elseπ beginπ Write('Enter inital value For MyConfig: ');π readln(MyConfig);π if NewConfigBlock(MyConfig, SizeOf(ConfigBlock)) thenπ Writeln('Created new config block')π elseπ Writeln('NewConfigBlock failed.');π end;πend.ππ 15 02-03-9416:19ALL GAYLE DAVIS Checking for SFX headers IMPORT 16 «Qi π{ Detection of ZIP and ARJ SFX files }ππ{$S-,V-,D+,I-}πUSES DOS;πππTYPEπ ArchiveTypes = (NONE,ARJ,PKZIP);π Header = RECORDπ HeadId : WORD; { 60000 }π SIG1 : WORD; { Basic Header Size }π END;ππVARππ ArchiveName : PathStr;π ArchiveSize : LongInt; { actual size of archive }π ArchiveOffset : LongInt; { bytes to skip in header if SFX }π ArchiveKind : ArchiveTypes;ππ FUNCTION CheckSfx(SfxName : PathStr) : BOOLEAN;ππ {-check for self-extracting archive}π {-if Sfx Exe: set ArchiveName and ArchiveOffset}π Var ImageInfo : Recordπ ExeId : Array[0..1] Of Char;π Remainder,π size : Wordπ End;π SfxExe : File;π H : Header;π rd : Word;π Err : Boolean;π AOffset : LongInt;π ExeId : Array[0..1] Of Char;ππ Beginππ CheckSFX := FALSE;π Assign(SfxExe, SfxName); Reset(SfxExe, 1);π If IoResult > 0 Then Exit;ππ ArchiveName := SfxName;π ArchiveOffset := 0;π ArchiveSize := Filesize(SfxExe);π BlockRead(SfxExe, ImageInfo, SizeOf(ImageInfo));π If ImageInfo.ExeId <> 'MZ' Then Exit;π AOffset := LongInt(ImageInfo.size-1)*512+ImageInfo.Remainder;π Seek(SfxExe, AOffset);π If IoResult > 0 Then Exit;π BlockRead(SfxExe, H, SizeOf(H), rd);π Err := (IoResult > 0) Or (rd < SizeOf(Header));π Close(SfxExe);π If Err Then Exit;π ArchiveName := SfxName;π ArchiveOffset := AOffset + (ORD(BOOLEAN(H.Sig1 = $EA60)) * 2); { add 2 bytes for ARJ241}π ArchiveKind := ArchiveTypes(ORD(ArchiveOffset > 0) + ORD(BOOLEAN(H.Sig1 <> $EA60)));π CheckSfx := (ArchiveOffset > 0);π End;ππ πBEGINπArchiveName := ParamStr(1);πCheckSfx(archivename);πEND. 16 05-25-9407:59ALL GARETH LEWIN archive detection SWAG9405 11 «Q/ {ππ RS> Can anyone tell me where to find some source dealing with archiveπ RS> detection? I need to be able to determine what archival method was usedπ RS> on a file regardless of the extension..ππYep.ππBTW: I cut it out of a source I made it for. I should compile as is. you mightπhave to "USES" dos and/or CRT.ππ----------------------------= CUT HERE =-------------------------------------π}ππTypeπ ArchiveType = (ARJ,ZIP,UC2,LZH,UNKNOWN);ππFunction GetArchiveType (Name : String) : Archivetype;πVar F : File;π Buf: Word;π StrBuf : String [3];πBeginπ GetArchiveType := UNKNOWN;π Assign (F,Name);π FileMode := 0;π Reset (F,1);π If IoResult <> 0 Thenπ Beginπ Write ('Unable to access file - ');π WriteLn (Name);π Exit;π End;π BlockRead (F,Buf,2);π If Buf = $EA60 Thenπ Beginπ GetArchiveType := ARJ;π Close (f);π Exit;π End;π If Buf = $4b50 Thenπ Beginπ GetArchiveType := ZIP;π Close (f);π Exit;π End;π If Buf = $4355 Thenπ Beginπ GetArchiveType := UC2;π Close (f);π Exit;π End;π BlockRead (F,StrBuf[1],3);π StrBuf[0] := #3;π If StrBuf = '-lh' Thenπ Beginπ GetArchiveType := LZH;π Close (f);π Exit;π End;πEnd;ππ 17 05-25-9407:59ALL MIKE COPELAND arj files SWAG9405 42 «QÅ ππconstπ BSize = 4096; { I/O Buffer Size }π HMax = 512; { Header Maximum Size }π DLM = #32#179;π HexDigits: array[0..15] of char = '0123456789ABCDEF';πtypeπ MEDBUF = array[1..4096] of char;πvarπ DISKNUM : Word; { Disk # - offset to Disk Info }π WVN : Word; { Working Volume # }π DIDX : Word; { Files Display Index }π VIDX : Word; { Volumes Display Index }π AIDX : Word; { Archives Display Index }π CIDX : Word; { Compressed Files Display Index }π ADX : Word; { comPressed file Index }π RES : Word; { Buffer Residue }π N,P,Q : Longint;π ASZ,USZ,FSZ : LongInt; { Disk Available, Used, Free sizes }π SEQNUM : LongInt; { File Sequence # }π C : LongInt; { Buffer Offset }π FSize : LongInt; { File Size }π CH, CH1 : char;π DEVICE : char; { Disk Device }π BIN,BOUT,π BWORK : ^MEDBUF;π F : File;π SNAME : String;π DATE : string[8]; { formatted date as YY/MM/DD }π TIME : string[5]; { " time as HH:MM }π X1,X2,X3,X4,π X5,X6,X7,X8,π X9,X10,X11,π X12 : string;π DISKNAME : string[15];π CMD : string; { DOS Command string }π INDENT : string; { Report Indention string }π GARB : string[6]; { extraneous device id }π PRIORAN : STR12; { Prior Archive Name }π DirInfo : SearchRec; { File name search type }π SR : SearchRec;π DT : DateTime;π PATH : PathStr;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π Regs : Registers;π Temp : String[1];π BUFF : array[1..BSize] of Byte;π IB : InfoBuffer;π S : string[11];π SNAME : string[12];ππVar I,J,K : LongInt;π(**************************** ARJ Files Processing ***************************)πType AHMain = record { ARJ Headers }π HeadId : Word; { 60000 }π BHdrSz : Word; { Basic Header Size }π FHdrSz : Byte; { File Header Size }π AVNo : Byte;π MAVX : Byte;π HostOS : Byte;π Flags : Byte;π SVer : Byte;π FType : Byte; { must be 2 for basic header }π Res1 : Byte;π DOS_DT : LongInt;π CSize : LongInt; { Compressed Size }π OSize : LongInt; { Original Size }π SEFP : LongInt;π FSFPos : Word;π SEDLgn : Word;π Res2 : Word;π NameDat : array[1..120] of char; { start of Name, etc. }π Res3 : array[1..10] of char;π end;πVar ARJ1 : AHMain;πprocedure GET_ARJ_ENTRY;πbeginπ FillChar(ARJ1,SizeOf(AHMain),#0); FillChar(BUFF,BSize,#0);π Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES); { read header into buffer }π Move (BUFF[1],ARJ1,SizeOf(AHMain)); FSize := 0;π with ARJ1 doπ beginπ if BHdrSz > 0 thenπ beginπ I := 1; SNAME := B40;π while NameDat[I] > #0 do Inc (I); { scan for end of file name }π Move (NameDat[1],SNAME[1],I-1); SNAME[0] := Chr(I-1);π FSize := BHdrSz+CSize;π if FType = 2 then FSize := BHdrSz;π if BHdrSz = 0 then FSize := 0;π end; { if }π end; { with }πend; { GET_ARJ_ENTRY }ππprocedure DO_ARJ (FN : string);πbeginπ Assign (F,FN); Reset (F,1); C := 1;π GET_ARJ_ENTRY; { Process file Header }π while FSize > 0 doπ beginπ Inc(C,FSize+10); GET_ARJ_ENTRY; { get file info }π if FSize > 0 thenπ beginπ with ARJ1 doπ beginπ FSplit (SNAME,DIR,FNAME,EXT);π if Length(EXT) <= 0 then EXT := ' ';π while Pos(#00,FNAME) > 0 do FNAME[Pos(#00,FNAME)] := ' ';π F := Copy(FNAME+B40,1,8); E := Copy(EXT+' ',1,4);π SIZE := OSize; RTYPE := 4; D_T := DOS_DT;π ANUM := ADX; VNUM := VDX;π end;π end; { if }π end; { while }π Close (F);πend; { DO_ARJ }ππ 18 05-25-9408:25ALL JOHN SHIPLEY Zip Viewer SWAG9405 119 «Qö¡ {------8<-------------Snip---------------8<------------Snip------------8<-------}π{$I-}πUNIT zipviewu;ππ(*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)π(* Unit : Zip View Date : March 23, 1994 *)π(* By : John Shipley Ver : 1.0 *)π(* *)π(* Credits : Steve Wierenga - ZIPV.PAS found in SWAG - Got me started on the *)π(* zipviewu code since ZIPV.PAS was fairly easy to read unlike *)π(* some other code I had seen. *)π(* *)π(* Tom Guinther - ZIPPER.PAS found in ZIPPER.ZIP (1989) available *)π(* on my BBS "The Brook Forest Inn 714-951-5282" This code helped *)π(* clarify many things. The zipper code is probably better than *)π(* this code and well documented. *)π(* *)π(* PkWare's APPNOTE.TXT found in PKZ110.EXE *)π(* *)π(* This unit is offered to the Public Domain so long as credit is given *)π(* where credit is due. I accept NO liablity for what this code does to your *)π(* system or your friends or anyone elses. You have the code, so you can fix *)π(* it. If this code formats your hard drive and you loose your lifes work, *)π(* then all I can say is "Why didn't you back it up?" *)π(* *)π(* Purpose: To mimic "PKUNZIP -v <filename>" output. (v2.04g) *)π(* The code is pretty close to the purpose, but not perfect. *)π(* *)π(* Demo : *)π(* *)π(* PROGRAM zip_viewit; *)π(* USES DOS,CRT,zipviewu; *)π(* BEGIN *)π(* IF PARAMCOUNT<>0 THEN *)π(* BEGIN *)π(* zipview(PARAMSTR(1)); *)π(* END; *)π(* END. *)π(*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)ππINTERFACEππUSES DOS,CRT;ππPROCEDURE zipview(zipfile: STRING);ππIMPLEMENTATIONππCONST hexdigit : ARRAY[0..15] OF CHAR = '0123456789abcdef';ππFUNCTION hexbyte(b: byte): STRING; (* Byte to Hexbyte *)π BEGINπ hexbyte := hexdigit[b SHR 4]+hexdigit[b AND $f];π END;ππFUNCTION hexlong(l: LONGINT): STRING; (* Longint to Hexlong *)π VAR n : ARRAY[1..4] OF BYTE ABSOLUTE l;π BEGINπ hexlong := hexbyte(n[4])+hexbyte(n[3])+hexbyte(n[2])+hexbyte(n[1]);π END;ππFUNCTION lenn(s: STRING): INTEGER; (* Like LENGTH, but skips color codes *)π VAR i,len : INTEGER;π BEGINπ len := LENGTH(s);π i := 1;π WHILE (i<=LENGTH(s)) DOπ BEGINπ IF (s[i] IN [#3,'^']) THENπ IF (i<LENGTH(s)) THENπ BEGINπ DEC(len,2);π INC(i);π END;π INC(i);π END;π lenn := len;π END;ππFUNCTION mln(s: STRING; l: INTEGER): STRING; (* Left Justify *)π BEGINπ WHILE (lenn(s)<l) DO s := s+' ';π IF (lenn(s)>l) THENπ REPEATπ s := COPY(s,1,LENGTH(s)-1)π UNTIL (lenn(s)=l) OR (LENGTH(s)=0);π mln := s;π END;ππFUNCTION mrn(s: STRING; l: INTEGER): STRING; (* Right Justify *)π BEGINπ WHILE lenn(s)<l DO s := ' '+s;π IF lenn(s)>l THEN s := COPY(s,1,l);π mrn := s;π END;ππFUNCTION cstr(i: LONGINT): STRING; (* convert integer type to string *)π VAR c : STRING[16];π BEGINπ STR(i,c);π cstr := c;π END;ππFUNCTION tch(s: STRING): STRING; (* Ensure 2 Digits *)π BEGINπ IF (LENGTH(s)>2) THEN s := COPY(s,LENGTH(s)-1,2)π ELSE IF (LENGTH(s)=1) THEN s := '0'+s;π tch := s;π END;ππFUNCTION b2attr(a,g: BYTE): STRING; (* Byte to Attribute *)π VAR attr : STRING[5];π BEGINπ attr := '--w- ';π IF (g AND 1)=1 THEN attr[5]:='*'; (* Encrypted? *)π IF (a AND 1)=1 THEN attr[3]:='r'; (* Read Only? *)π IF (a AND 2)=2 THEN attr[2]:='h'; (* Hidden? *)π IF (a AND 4)=4 THEN attr[1]:='s'; (* System? *)π IF (a AND 8)=8 THEN attr[4]:='?'; (* Unknown at this time *)π b2attr := attr;π END;ππFUNCTION w2date(d: WORD): STRING; (* Word to Date *)π VAR s : STRING;π BEGINπ s := tch(cstr((d SHR 5) AND 15 ))+'-'+ (* Month *)π tch(cstr((d ) AND 31 ))+'-'+ (* Day *)π tch(cstr(((d SHR 9) AND 127)+80)); (* Year *)π w2date := s;π END;ππFUNCTION w2time(t: WORD): STRING; (* Word to Time *)π VAR s : STRING;π BEGINπ s := tch(cstr((t SHR 11) AND 31))+':'+ (* Hour *)π tch(cstr((t SHR 5) AND 63)); (* Minute *)π w2time := s;π END;ππPROCEDURE zipview(zipfile: STRING); (* View the ZIP File *)π CONST lsig = $04034B50; (* Local Signature *)π csig = $02014b50; (* Central Signature *)π TYPE lheader = RECORD (* Local Header *)π signature : LONGINT; (* local file header signature *)π version, (* version mad by *)π gpflag, (* general purpose flags *)π compress, (* compression method *)π time,date : WORD; (* last mod file time and date *)π crc32, (* crc-32 *)π csize, (* compressed size *)π usize : LONGINT; (* uncompressed size *)π fnamelen, (* filename length *)π extrafield : WORD; (* extra field length *)π END;π cheader = RECORD (* Central Header *)π signature : LONGINT; (* central file header signature *)π version : WORD; (* version made by *)π vneeded : WORD; (* version needed to extract *)π gpflag : ARRAY[1..2] OF BYTE;(* general purpose flags *)π compress : WORD; (* compression method *)π time : WORD; (* last mod file time *)π date : WORD; (* last mod file date *)π crc32 : LONGINT; (* crc-32 *)π csize : LONGINT; (* compressed size *)π usize : LONGINT; (* uncompressed size *)π fnamelen : WORD; (* filename length *)π extrafield : WORD; (* extra field length *)π fcl : WORD; (* file comment length *)π dns : WORD; (* disk number start *)π ifa : WORD; (* internal file attributes *)π efa : ARRAY[1..4] OF BYTE; (* external file attr *)π roolh : LONGINT; (* relative offset of local header *)π END;ππVAR z : INTEGER; (* Number of files processed counter *)π totalu, (* Total bytes that were compressed *)π totalc : LONGINT; (* result of total bytes being compressed *)π hdr : ^cheader; (* temporary cental header file record *)π f : FILE; (* file var *)π s : STRING; (* archive filename string *)π percent : BYTE; (* Temporary var holding percent compressed *)π numfiles : WORD; (* Number of files in archive *)ππCONST comptypes : ARRAY[0..8] OF STRING[7] = (* Compression Types *)π ('Stored ', (* Not Compressed *)π 'Shrunk ', (* Shrunk *)π 'Reduce1', (* Reduced 1 *)π 'Reduce2', (* Reduced 2 *)π 'Reduce3', (* Reduced 3 *)π 'Reduce4', (* Reduced 4 *)π 'Implode', (* Imploded *)π 'NotSure', (* Unknown at this time *)π 'DeflatN'); (* Deflated *)ππFUNCTION seekc(VAR f: FILE): BOOLEAN;π VAR curpos : LONGINT; (* current file position *)π buf : lheader; (* Temporary local header record *)π ioerror : INTEGER; (* Temporary IOResult holder *)π result : WORD; (* Blockread Result *)π BEGINπ seekc := FALSE; (* init seekc *)π curpos := 0; (* init current file position *)π SEEK(f,0); (* goto start of file *)π BLOCKREAD(f,buf,SIZEOF(lheader),result); (* Grab first local header *)π ioerror := IORESULT; (* Test for error *)π WHILE (ioerror = 0) AND (buf.signature=lsig) DO (* Test if OK..continue *)π BEGINπ INC(numfiles); (* Increment number of files *)π WITH buf DO (* Find end of local header *)π curpos := FILEPOS(f)+fnamelen+extrafield+csize;π SEEK(f,curpos); (* Goto end of local header *)π BLOCKREAD(f,buf,SIZEOF(lheader),result); (* Grab next local header *)π ioerror := IORESULT; (* Test for error *)π END;π IF ioerror<>0 THEN EXIT; (* If error then exit function *)π IF (buf.signature=csig) THEN (* Did we find the first central header? *)π BEGINπ seekc := TRUE; (* Found first central header *)π SEEK(f,curpos); (* Ensure we are at central headers file position *)π END;π END;ππ VAR curpos : LONGINT;ππ BEGINπ numfiles := 0; (* Counter of Number of Files to Determine When Done *)π z := 0; (* Counter of Number of Files Processed *)π totalu := 0; (* Total Bytes of Uncompressed Files *)π totalc := 0; (* Total Size after being Compressed *)π NEW(hdr); (* Dynamically Allocate Memory for a Temp Header Record *)π ASSIGN(f,zipfile); (* Assign Filename to File Var *)π {$I-}π RESET(f,1); (* Open Untyped File *)π {$I+}π IF IORESULT<>0 THEN (* If we get an error, exit program *)π BEGINπ WRITELN('Error - File not found.');π HALT(253);π END;π IF NOT seekc(f) THEN (* Skip Local Headers and goto first Central Header *)π BEGIN (* If we could not locate a Central Header *)π CLOSE(f); (* Close Untyped File *)π WRITELN('Error - Corrupted or Not a ZIP File.');π HALT(254); (* Exit Program *)π END;ππ WRITELN(' Length Method Size Ratio Date Time CRC-32 '+π ' Attr Name');π WRITELN(' ------ ------ ----- ----- ---- ---- --------'+π ' ---- ----');π REPEATπ FILLCHAR(s,SIZEOF(s),#0); (* Clear Name String *)π BLOCKREAD(f,hdr^,SIZEOF(cheader)); (* Read File Header *)π BLOCKREAD(f,MEM[SEG(s):OFS(s)+1],hdr^.fnamelen); (* Read Archive Name *)π s[0] := CHR(hdr^.fnamelen); (* Get Archive Name Length *)π IF (hdr^.signature=csig) THEN (* Is a header *)π BEGINπ INC(z); (* Increment File Counter *)π WRITE(mrn(cstr(hdr^.usize),7)); (* Display Uncompressed Size *)π WRITE(' '+mrn(comptypes[hdr^.compress],7)); (* Compression Method *)π WRITE(mrn(cstr(hdr^.csize),8)); (* Display Compressed Size *)π percent := ROUND(100.0-(hdr^.csize/hdr^.usize*100.0));π WRITE(mrn(cstr(percent),4)+'% '); (* Display Compression Percent *)π WRITE(' '+w2date(hdr^.date)+' '); (* Display Date Last Modified *)π WRITE(' '+w2time(hdr^.time)+' '); (* Display Time Last Modified *)π WRITE(' '+hexlong(hdr^.crc32)+' '); (* Display CRC-32 in Hex *)π WRITE(b2attr(hdr^.efa[1],hdr^.gpflag[1])); (* Display Attributes *)π WRITELN(' '+mln(s,13)); (* Display Archive Filename *)π INC(totalu,hdr^.usize); (* Increment size uncompressed *)π INC(totalc,hdr^.csize); (* Increment size compressed *)π END;π SEEK(f,FILEPOS(f)+hdr^.extrafield+hdr^.fcl);π UNTIL (hdr^.signature<>csig) OR EOF(f) OR (z=numfiles); (* No more Files *)π WRITELN(' ------ ------ --- '+π ' -------');π WRITE(mrn(cstr(totalu),7)+' '); (* Display Total Uncompressed *)π WRITE(mrn(cstr(totalc),7)+' '); (* Display Total Compressed *)π WRITE((100-TotalC/TotalU*100):3:0,'%'+mrn(' ',34)); (* Display Percent *)π WRITELN(mrn(cstr(z),7)); (* Display Number of Files *)π CLOSE(f); (* Close Untyped File *)π DISPOSE(hdr); (* Deallocate Header Var Memory *)π END;ππEND.π 19 05-26-9407:31ALL SCOTT BAKER Zip File Viewer IMPORT 42 «Q`Ω unit ZipView;ππinterfaceπuses dos;ππtypeπ barray= array[1..8192] of byte;π ZipPtr=^ZipRec;π ZipRec= Recordπ version_made: word;π version_extr: word;π flags: word;π comp_method: word;π last_mod_time: word;π last_mod_date: word;π crc_32: longint;π compressed_size: longint;π uncompressed_size: longint;π fname_length: word;π extra_length: word;π comment_length: word;π disk_num_start: word;π internal_attr: word;π external_attr: longint;π rel_ofs: longint;π name: string[12];π Next: ZipPtr;π end;π bptr = ^barray;πconstπ ZipMethod: array[0..9] of string[15] =π ('stored ', 'shrunk ', 'reduced-1',π 'reduced-2', 'reduced-3', 'reduced-4',π 'imploded ', 'unknown ', 'unknown ',π 'unknown ');ππvarπ totallength,totalsize,numfiles: longint;π firstzip: zipptr;π lineout: string;π outPtr: pointer;ππprocedure LoadZip(filename: string);πprocedure DisplayZip;πprocedure DisposeZip;ππimplementationππvarπ f: file of barray;π buffer: barray;π addr: longint;π bufptr: word;ππ{$F+}πProcedure CallProc;πinline($FF/$1E/OutPtr);π{$F-}ππFunction NextByte: byte;πvar i: integer;πbegin;π inc(addr);π inc(bufptr);π if bufptr=8193 then begin;π {$I-}π read(f,buffer);π {$I+}π i:=ioresult;π bufptr:=1;π end;π nextbyte:=buffer[bufptr];πend;ππprocedure LoadZip(filename: string);πvarπ b: byte;π f2: file of byte;π fs: longint;π LastZip,Zip: ZipPtr;π Bytes: Bptr absolute zip;π a: integer;π sr: searchrec;πbegin;π firstzip:=nil;π{ assign(f2,filename);π reset(F2);π fs:=filesize(f2);π close(f2);}π findfirst(filename,anyfile,sr);π fs:=sr.size;π assign(f,filename);π reset(f);π addr:=0;π if fs>65535 then begin;π seek(f,(fs div 8192)-4);π addr:=addr+((fs div 8192)-4)*8192;π end;π {$I-}π read(f,buffer);π {$I+}π a:=ioresult;π bufptr:=0;π b:=nextbyte;π repeat;π if b=$50 then begin;π b:=nextbyte;π if b=$4b then begin;π b:=nextbyte;π if b=$01 then begin;π b:=nextbyte;π if b=$02 then begin;π new(zip);π zip^.next:=nil;π if firstzip=nil then firstzip:=zip else lastzip^.next:=zip;π lastzip:=zip;π for a:=1 to 42 do bytes^[a]:=nextbyte;π zip^.name:='';π for a:=1 to zip^.fname_length do zip^.name:=zip^.name+chr(nextbyte);π b:=nextbyte;π end;π end;π end;π end else b:=nextbyte;π until addr>=fs;πend;ππprocedure OutLine(s: string);πbegin;π lineout:=s;π if OutPtr=NIL then writeln(s) else CallProc;πend;ππfunction format_date(date: word): string;πvarπ s,s2: string;π y,m,d: word;πbeginπ m:=(date shr 5) and 15;π d:=( (date ) and 31);π y:=(((date shr 9) and 127)+80);π str(m,s);π while length(s)<2 do s:='0'+s;π s:=s+'-';π str(d,s2);π while length(s2)<2 do s2:='0'+s2;π s:=s+s2+'-';π str(y,s2);π while length(s2)<2 do s2:='0'+s2;π s:=s+s2;π format_date:=s;πend;ππfunction format_time(time: word): string;πvarπ s,s2: string;π h,m,se: word;πbeginπ h:=(time shr 11) and 31;π m:=(time shr 5) and 63;π se:=(time shl 1) and 63;π str(h,s);π while length(S)<2 do s:='0'+s;π s:=s+':';π str(m,s2);π while length(s2)<2 do s2:='0'+s2;π s:=s+s2;π format_time:=s;πend;ππprocedure DisplayHeader;πbegin;π OutLine('Filename Length Size Method Date Time Ratio');π OutLine('------------ ------- ------- --------- -------- ----- -----');πend;ππprocedure DisplayFooter;πvarπ s,s2: string;π average: real;πbegin;π OutLine('------------ ------- ------- -----');π average:=100-totalsize/totallength*100;π str(numfiles:12,s);π str(totallength:7,s2);π s:=s+' '+s2+' ';π str(totalsize:7,s2);π s:=s+s2+' ';π str(average:4:0,s2);π s:=s+s2+'%';π outline(s);πend;ππprocedure DisplayZip;πvarπ curzip: zipptr;π s,s2: string;πbegin;π numfiles:=0;π totallength:=0;π totalsize:=0;π DisplayHeader;π curzip:=firstzip;π while curzip<>nil do begin;π s:=curzip^.name;π while length(s)<14 do s:=s+' ';π str(curzip^.uncompressed_size,s2);π while length(s2)<7 do s2:=' '+s2;π s:=s+s2+' ';π str(curzip^.compressed_size,s2);π while length(s2)<7 do s2:=' '+s2;π s:=s+s2+' ';π s:=s+ZipMethod[curzip^.comp_method]+' ';π s:=s+format_date(curzip^.last_mod_date)+' '+format_time(curzip^.last_mod_time)+' ';π str(100-curzip^.compressed_size/curzip^.uncompressed_size*100:1:1,s2);π s2:=s2+'%';π while length(s2)<5 do s2:=' '+s2;π s:=s+s2;π Outline(s);π totallength:=totallength+curzip^.uncompressed_size;π totalsize:=totalsize+curzip^.compressed_size;π inc(numfiles);π curzip:=curzip^.next;π end;π if (numfiles=0) or (totallength=0) or (totalsize=0) then begin;π outline('No valid file entries detected.');π end else begin;π displayfooter;π end;πend;ππprocedure DisposeZip;πvarπ curzip,savezip: zipptr;πbegin;π curzip:=firstzip;π while curzip<>nil do begin;π savezip:=curzip^.next;π dispose(curzip);π curzip:=savezip;π end;πend;ππbegin;π OutPtr:=Nil;πend.ππ{ -------------------------- CUT HERE -----------------------------}π{ TEST PROGRAM }ππuses zipview;ππvarπ s: string;πbegin;π write('File to Zip-View ? ');π readln(s);π LoadZip(s);π DisplayZip;π DisposeZip;πend. 20 08-24-9413:19ALL EDWIN GROOTHUIS Identify Archive Formats SWAG9408 ╝ ·╬ 12 «Q π{$define ARJ}π{$define ZIP}π{$define ARC}π{$define LZH}π{$define ZOO}ππfunction IdentifyArchive(const Name:string):char;π{π returns:π '?': unknown archiveπ 'A': Arj-archive;π 'Z': Zip-archiveπ 'L': Lzh-archiveπ 'C': Arc-archiveπ 'O': Zoo-archiveπ}πvar f:PBufStream;π a:array[0..10] of char;π bc:word;π s:string;πbeginπ IdentifyArchive:='?';π if Name='' thenπ exit;ππ f:=New(PBufStream,Init(Name,stOpenRead,1024));π if f^.Status<>stOk thenπ beginπ Dispose(f,Done);π exit;π end;ππ f^.Read(a,sizeof(a));π if f^.Status<>stOk thenπ beginπ Dispose(f,Done);π exit;π end;π Dispose(f,Done);ππ{$ifdef arj}π if (a[0]=#$60) and (a[1]=#$EA) thenπ beginπ IdentifyArchive:='A'; { ARJ }π exit;π end;π{$endif}ππ{$ifdef zip}π if (a[0]='P') and (a[1]='K') thenπ beginπ IdentifyArchive:='Z'; { ZIP }π exit;π end;π{$endif}ππ{$ifdef arc}π if a[0]=#$1A thenπ beginπ IdentifyArchive:='C'; { ARC }π exit;π end;π{$endif}ππ{$ifdef zoo}π if (a[0]='Z') and (a[1]='O') and (a[2]='O') thenπ beginπ IdentifyArchive:='O'; { ZOO }π exit;π end;π{$endif}ππ{$ifdef lzh}π s:=Name;π for bc:=1 to length(s) doπ s[bc]:=upcase(s[bc]);π if copy(s,pos('.',s),4)='.LZH' thenπ beginπ IdentifyArchive:='L'; { LZH }π exit;π end;π{$endif}ππ IdentifyArchive:='?';πend;π 21 08-24-9413:21ALL KAI ROHRBACHER Arithmetic compression SWAG9408 3k╗╬ 29 «Q {πHello Thomas,ππOn 26.06.94 you wrote in area PASCAL to subject "Arithmetic compression":πTW> But where can we get a discription of this compression method ??π Michael Barnsley, Lyman Hurd, "Fractal Image Compression", AK Peters,π 1993π Mark Nelson, "The Data Compression Book", M&T Books, 1991π Ian Witten, Radford Neal, John Cleary, "Arithmetic Coding for Dataπ Compression", CACM, Vol. 30, No.6, 1987ππ Below is a small source from the 1st book, translated into Pascal andπ adopted to work on the uppercase alphabet to demonstrate the basicπ principles.π For a simple explanation, the program uses the letters of the inputπ string to "drive" the starting point through the real interval 0.0 ..π 1.0π By this process, every possible input string stops at a unique point,π that is: a point (better: a small interval section) represents theπ whole string. To _decode_ it, you have to reverse the process: youπ start at the given end point and apply the reverse transformation,π noting which intervals you are touching at your voyage throughout theπ computation.π Due to the restricted arithmetic resolution of any computer language,π the max. length of a string will be restricted, too (try it out withπ TYPE REAL=EXTENDED, for example); this happens when the valueπ "underflows" the computers precision. }ππ{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P+,Q-,R+,S+,T-,V+,X+,Y+}π{$M 16384,0,655360}πPROGRAM arithmeticCompression;πUSES CRT;πCONST charSet:STRING='ABCDEFGHIJKLMNOPQRSTUVWXYZ ';π size=27; {=Length(charSet)}π p:ARRAY[1..size] OF REAL= (* found empirically *)π (π 6.1858296469E-02,π 1.1055412402E-02,π 2.6991022453E-02,π 2.6030374520E-02,π 9.2418577127E-02,π 2.1864028512E-02,π 1.4977615842E-02,π 2.8410764564E-02,π 5.5247871050E-02,π 1.3985123226E-03,π 3.8001321554E-03,π 3.2593032914E-02,π 2.1919756707E-02,π 5.2434924064E-02,π 5.7837905257E-02,π 2.0364674693E-02,π 1.0031075103E-03,π 4.9730779744E-02,π 4.8056280170E-02,π 7.2072478498E-02,π 2.0948493879E-02,π 8.2477728625E-03,π 1.0299101184E-02,π 4.7873173243E-03,π 1.3613601926E-02,π 2.7067980437E-03,π 2.3933136781E-01π );πVAR psum:ARRAY[1..size] OF REAL;ππ FUNCTION Encode(CONST s:STRING):REAL;π VAR i,po:INTEGER;π offset,len:REAL;π BEGINπ offset:=0.0;π len:=1.0;π FOR i:=1 TO Length(s) DOπ BEGINπ po:=POS(s[i],charSet);π IF po<>0π THEN BEGINπ offset:=offset+len*psum[po];π len:=len*p[po]π ENDπ ELSE BEGINπ WRITELN('only input chars ',charSet,' allowed!');π Halt(1)π END;π END;π Encode:=offset+len/2;π END;ππ FUNCTION Decode(x:REAL; n:BYTE):STRING;π VAR i,j:INTEGER;π s:STRING;π BEGINπ IF (x<0.0) OR (x>1.0)π THEN BEGINπ WRITELN('must lie in the range [0..1]');π Halt(1)π END;π FOR i:=1 TO n DOπ BEGINπ j:=size;π WHILE x<psum[j] DO DEC(j);π s[i]:=charSet[j];π x:=x-psum[j];π x:=x/p[j];π END;π s[0]:=CHR(n);π Decode:=sπ END;ππCONSTπ inp='ARITHMETIC';πVARπ r:REAL;π i,j:INTEGER;ππBEGINππ FOR i:=1 TO size DOπ BEGINπ psum[i]:=0.0;π FOR j:=1 TO i-1 DOπ psum[i]:=psum[i]+p[j];π END;ππ ClrScr;π WRITELN('encoding string : ',inp);π r:=Encode(inp);π WRITELN('string is encoded by ',r);π WRITELN('decoding of r gives: ',Decode(r,Length(inp)));ππEND.ππ 22 08-24-9417:57ALL PHIL KATZ Zip File Format SWAG9408 R'}P 62 «Q πSystem of Origin : IBMππOriginal author : Phil KatzππFILE FORMATπ-----------ππFiles stored in arbitrary order. Large zipfiles can span multipleπdiskette media. π π Local File Header 1 π file 1 extra field π file 1 comment π file data 1 π Local File Header 2 π file 2 extra field π file 2 commentπ file data 2π . π . π . π Local File Header n π file n extra field π file n comment π file data n π Central Directory π central extra fieldπ central commentπ End of Central Directoryπ end commentπEOFπππLOCAL FILE HEADERπ-----------------ππOFFSET LABEL TYP VALUE DESCRIPTIONπ------ ----------- ---- ----------- ---------------------------------- π00 ZIPLOCSIG HEX 04034B50 ;Local File Header Signature π04 ZIPVER DW 0000 ;Version needed to extract π06 ZIPGENFLG DW 0000 ;General purpose bit flag π08 ZIPMTHD DW 0000 ;Compression method π0A ZIPTIME DW 0000 ;Last mod file time (MS-DOS) π0C ZIPDATE DW 0000 ;Last mod file date (MS-DOS) π0E ZIPCRC HEX 00000000 ;CRC-32π12 ZIPSIZE HEX 00000000 ;Compressed size π16 ZIPUNCMP HEX 00000000 ;Uncompressed sizeπ1A ZIPFNLN DW 0000 ;Filename lengthπ1C ZIPXTRALN DW 0000 ;Extra field length π1E ZIPNAME DS ZIPFNLN ;filename π-- ZIPXTRA DS ZIPXTRALN ;extra field π πCENTRAL DIRECTORY STRUCTUREπ--------------------------- π πOFFSET LABEL TYP VALUE DESCRIPTIONπ------ ----------- ---- ----------- ----------------------------------π00 ZIPCENSIG HEX 02014B50 ;Central file header signature π04 ZIPCVER DB 00 ;Version made by π05 ZIPCOS DB 00 ;Host operating system π06 ZIPCVXT DB 00 ;Version needed to extract π07 ZIPCEXOS DB 00 ;O/S of version needed for extraction π08 ZIPCFLG DW 0000 ;General purpose bit flag π0A ZIPCMTHD DW 0000 ;Compression method π0C ZIPCTIM DW 0000 ;Last mod file time (MS-DOS)π0E ZIPCDAT DW 0000 ;Last mod file date (MS-DOS) π10 ZIPCCRC HEX 00000000 ;CRC-32π14 ZIPCSIZ HEX 00000000 ;Compressed sizeπ18 ZIPCUNC HEX 00000000 ;Uncompressed size π1C ZIPCFNL DW 0000 ;Filename length π1E ZIPCXTL DW 0000 ;Extra field length π20 ZIPCCML DW 0000 ;File comment length π22 ZIPDSK DW 0000 ;Disk number startπ24 ZIPINT DW 0000 ;Internal file attributes π π LABEL BIT DESCRIPTIONπ ----------- --------- -----------------------------------------π ZIPINT 0 if = 1, file is apparently an ASCII or π text file π 0 if = 0, file apparently contains binary π data ππ 1-7 unused in version 1.0.π π26 ZIPEXT HEX 00000000 ;External file attributes, host π ;system dependentπ2A ZIPOFST HEX 00000000 ;Relative offset of local header π ;from the start of the first disk π ;on which this file appearsπ2E ZIPCFN DS ZIPCFNL ;Filename or path - should not π ;contain a drive or device letter, π ;or a leading slash. All slashes π ;should be forward slashes '/' π-- ZIPCXTR DS ZIPCXTL ;extra fieldπ-- ZIPCOM DS ZIPCCML ;file commentπππEND OF CENTRAL DIR STRUCTUREπ---------------------------- π πOFFSET LABEL TYP VALUE DESCRIPTION π------ ----------- ---- ----------- ---------------------------------- π00 ZIPESIG HEX 06064B50 ;End of central dir signatureπ04 ZIPEDSK DW 0000 ;Number of this disk π06 ZIPECEN DW 0000 ;Number of disk with start central dir π08 ZIPENUM DW 0000 ;Total number of entries in central dir π ;on this disk π0A ZIPECENN DW 0000 ;total number entries in central dir π0C ZIPECSZ HEX 00000000 ;Size of the central directoryπ10 ZIPEOFST HEX 00000000 ;Offset of start of central directory π ;with respect to the starting diskπ ;number π14 ZIPECOML DW 0000 ;zipfile comment length π16 ZIPECOM DS ZIPECOML ;zipfile commentπ π πZIP VALUES LEGENDπ-----------------π π HOST O/S π π VALUE DESCRIPTION VALUE DESCRIPTION π ----- -------------------------- ----- ------------------------π 0 MS-DOS and OS/2 (FAT) 5 Atari ST π 1 Amiga 6 OS/2 1.2 extended file sys π 2 VMS 7 Macintosh π 3 *nix 8 thru π 4 VM/CMS 255 unused ππ π GENERAL PURPOSE BIT FLAG π π LABEL BIT DESCRIPTION π ----------- --------- -----------------------------------------π ZIPGENFLG 0 If set, file is encrypted π or 1 If file Imploded and this bit is set, 8K π ZIPCFLG sliding dictionary was used. If clear, 4Kπ sliding dictionary was used.π 2 If file Imploded and this bit is set, 3 π Shannon-Fano trees were used. If clear, 2 π Shannon-Fano trees were used. π 3-4 unused π 5-7 used internaly by ZIPπ π Note: Bits 1 and 2 are undefined if the compression method is π other than type 6 (Imploding). π ππ COMPRESSION METHODπ π NAME METHOD DESCRIPTION π ----------- ------ -------------------------------------------- π Stored 0 No compression used π Shrunk 1 LZW, 8K buffer, 9-13 bits with partial clearing π Reduced-1 2 Probalistic compression, L(X) = lower 7 bits π Reduced-2 3 Probalistic compression, L(X) = lower 6 bits π Reduced-3 4 Probalistic compression, L(X) = lower 5 bits π Reduced-4 5 Probalistic compression, L(X) = lower 4 bitsπ Imploded 6 2 Shanno-Fano trees, 4K sliding dictionaryπ Imploded 7 3 Shanno-Fano trees, 4K sliding dictionary π Imploded 8 2 Shanno-Fano trees, 8K sliding dictionaryπ Imploded 9 3 Shanno-Fano trees, 8K sliding dictionary ππ π EXTRA FIELD ππ OFFSET LABEL TYP VALUE DESCRIPTIONπ ------ ----------- ---- ---------- ----------------------------π 00 EX1ID DW 0000 ;0-31 reserved by PKWAREπ 02 EX1LN DW 0000π 04 EX1DAT DS EX1LN ;Specific data for individualπ . ;files. Data field should beginπ . ;with a s/w specific unique IDπ EX1LN+4π EXnID DW 0000π EXnLN DW 0000ππ EXnDAT DS EXnLN ;entire header may not exceed 64kπππ
