{ OOAVTEST.PAS cut out each of the units below and compile to test the use of this package} uses OOAV,Dos; var a:PArchive; sr:SearchRec; DT:DateTime; begin writeln('avail: ',memavail); { It's not necessary that you call IdentifyArchive, but it's easy for checking when you've add new archive-types } case IdentifyArchive(paramstr(1)) of '?': writeln('Cannot open/identify current archive'); 'Z': writeln('It''s a ZIP-archive'); 'A': writeln('It''s an ARJ-archive'); 'L': writeln('It''s an LZH-archive'); 'C': writeln('It''s an ARC-archive'); 'O': writeln('It''s a ZOO-archive'); end; a:=New(PArchive,Init); if not a^.Name(paramstr(1)) then begin writeln('Cannot open file'); exit; end; writeln('Name':15,'Size':10,'Date':10,'Time':12); a^.FindFirst(sr); while sr.Name<>'' do begin write (sr.Name:15,sr.Size:10); UnpackTime(sr.Time,DT); writeln(dt.day:10,dt.month:3,dt.year:5,dt.hour:4,dt.min:3,dt.sec:3); a^.FindNext(sr); end; Dispose(A,Done); writeln('End'); writeln('avail: ',memavail); end. { the rest of the units follow } { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer, version 3 ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ This Object-Oriented Archive-viewer (OOAV) is copyright (c) by Edwin Groothuis, MavEtJu software. You are free to use it if you agree with these three rules: 1. You tell me you're using this unit. 2. You give me proper credit in the documentation. (Like: "This program uses the Object-Oriented Archive-viewer (c) Edwin Groothuis, MavEtJu software". 3. If you make Archive-objects for other archive-types, don't hesitate to inform me so I can add them to the unit and redistribute it! That's all! How to use this unit: ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ (see also the file ArchTest.pas) - Declare a variable Arch of the var Arch:TArchive; type TArchive begin - Call it's constructor Arch.Init; - Tell the unit which file you if not Arch.Name('TEST.ZIP') want to view. This function then begin returns a boolean. If this writeln('TEST.ZIP is not boolean is false, then the a valid archive'); file couldn't be identified exit; as a valid archive. end; - Just like the dos-functions Arch.FindFirst(sr); FindFirst and FindNext, you while sr.Name<>'' do can search through the archive. begin The parameter you give with it writeln(sr.Name); is one of the SearchRec-type. Arch.FindNext(sr); If there are no more files in end; this archive, sr.Name will be empty. Valid fields are sr.Name, sr.Size and sr.Time - Call the destructor Arch.Done; end; - You can call the function IdentifyArchive() to see what kind of archive you're dealing with. What if you want to add more archive-types ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ - Add the unit name in the second Uses-statement. - Find out how to identify it and add that algoritm to the IdentifyArchive()-function. Please choose a unique and no-nonsens character to return. - Add it to the IdentifyArchive()-case in TArchive.Name. - Create a FindFirst-method and FindNext-method for this object. - That's it! Simple, isn't it? (If it isn't, please see the files ZipView, ArjView and others for examples ;-) Author: ÄÄÄÄÄÄÄ Edwin Groothuis email: Johann Strausslaan 1 edwing@stack.urc.tue.nl (valid until 10-94) 5583ZA Aalst-Waalre Edwin_Groothuis@p1.f205.n284.z2.gds.nl The Netherlands 2:284/205.1@fidonet 115:3145/102.1@pascal-net } unit OOAV; interface uses Dos; { General Archive, which is the father of all the specific archives. See OOAVZip, OOAVArj and others for examples. } type PGeneralArchive=^TGeneralArchive; TGeneralArchive=object _FArchive:file; constructor Init; destructor Done;virtual; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; end; { TArchive is the object you're working with. See the documentation at the begin of this file for more information } type PArchive=^TArchive; TArchive=object constructor Init; destructor Done; function Name(const n:string):boolean; procedure FindFirst(var sr:SearchRec); procedure FindNext(var sr:SearchRec); private _Name:string; _Archive:PGeneralArchive; end; function IdentifyArchive(const Name:string):char; implementation uses Objects,Strings, OOAVZip,OOAVArj,OOAVLzh,OOAVArc,OOAVZoo; 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:file; a:array[0..10] of char; bc:word; s:string; OldFileMode:byte; begin if Name='' then begin IdentifyArchive:='?'; exit; end; OldFileMode:=FileMode; FileMode:=0; assign(f,Name); {$I-}reset(f,1);{$I+} FileMode:=OldFileMode; if IOresult<>0 then begin IdentifyArchive:='?'; exit; end; blockread(f,a,sizeof(a),bc); close(f); if bc=0 then begin IdentifyArchive:='?'; exit; end; if (a[0]=#$60) and (a[1]=#$EA) then begin IdentifyArchive:='A'; { ARJ } exit; end; if (a[0]='P') and (a[1]='K') then begin IdentifyArchive:='Z'; { ZIP } exit; end; if a[0]=#$1A then begin IdentifyArchive:='C'; { ARC } exit; end; if (a[0]='Z') and (a[1]='O') and (a[2]='O') then begin IdentifyArchive:='O'; { ZOO } exit; end; 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; IdentifyArchive:='?'; end; constructor TGeneralArchive.Init; begin Abstract; end; destructor TGeneralArchive.Done; begin end; procedure TGeneralArchive.FindFirst(var sr:SearchRec); begin Abstract; end; procedure TGeneralArchive.FindNext(var sr:SearchRec); begin Abstract; end; constructor TArchive.Init; begin _Name:=''; _Archive:=nil; end; destructor TArchive.Done; begin if _Archive<>nil then begin close(_Archive^._FArchive); Dispose(_Archive,Done); end; end; function TArchive.Name(const n:string):boolean; var sr:SearchRec; OldFileMode:byte; begin if _Archive<>nil then begin close(_Archive^._FArchive); Dispose(_Archive,Done); _Archive:=nil; end; Name:=false; _Name:=n; Dos.FindFirst(_Name,anyfile,sr); if DosError<>0 then exit; case IdentifyArchive(_Name) of '?': exit; 'A': _Archive:=New(PArjArchive,Init); 'Z': _Archive:=New(PZipArchive,Init); 'L': _Archive:=New(PLzhArchive,Init); 'C': _Archive:=New(PArcArchive,Init); 'O': _Archive:=New(PZooArchive,Init); end; OldFileMode:=FileMode; FileMode:=0; Assign(_Archive^._FArchive,n); {$I-}reset(_Archive^._FArchive,1);{$I+} FileMode:=OldFileMode; if IOresult<>0 then begin Dispose(_Archive); exit; end; Name:=true; end; procedure TArchive.FindFirst(var sr:SearchRec); begin FillChar(sr,sizeof(sr),0); if _Archive=nil then exit; _Archive^.FindFirst(sr); end; procedure TArchive.FindNext(var sr:SearchRec); begin FillChar(sr,sizeof(sr),0); if _Archive=nil then exit; _Archive^.FindNext(sr); end; end. { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer: ARC-part } unit OOAVArc; interface uses Dos,OOAV; Type AFHeader = Record HeadId : byte; DataType : byte; { 0 = no more data } Name : array[0..12] of char; CompSize : longint; FileDate : word; FileTime : word; Crc : word; OrigSize : longint; end; type PArcArchive=^TArcArchive; TArcArchive=object(TGeneralArchive) constructor Init; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; private _FHdr:AFHeader; _SL:longint; procedure GetHeader(var sr:SearchRec); end; implementation const BSize=4096; var BUFF:array[1..BSize] of Byte; constructor TArcArchive.Init; begin FillChar(_FHdr,sizeof(_FHdr),0); end; procedure TArcArchive.GetHeader(var sr:SearchRec); var bc:word; b:byte; begin FillChar(_FHdr,SizeOf(_FHdr),#0); FillChar(BUFF,BSize,#0); Seek(_FArchive,_SL); BlockRead(_FArchive,BUFF,BSIZE,bc); Move(BUFF[1],_FHdr,SizeOf(_FHdr)); with _FHdr do begin if DataType<>0 then begin b:=0;sr.Name:=''; while Name[b]<>#0 do begin if Name[b]='/' then sr.Name:='' else sr.Name:=sr.Name+Name[b]; inc(b); end; sr.Size:=OrigSize; if DataType=0 then sr.Size:=0; sr.Time:=FileDate*longint(256*256)+FileTime; inc(_SL,CompSize); inc(_SL,sizeof(_FHDR)); end; end; end; Procedure TArcArchive.FindFirst(var sr:SearchRec); begin _SL:=0; GetHeader(sr); end; procedure TArcArchive.FindNext(var sr:SearchRec); begin GetHeader(sr); end; end. { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer: ARJ-part } unit OOAVArj; interface uses Dos,OOAV; Type AFHeader = Record 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; type PArjArchive=^TArjArchive; TArjArchive=object(TGeneralArchive) constructor Init; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; private _FHdr:AFHeader; _SL:longint; procedure GetHeader(var sr:SearchRec); end; implementation const BSize=4096; var BUFF:array[1..BSize] of Byte; constructor TArjArchive.Init; begin FillChar(_FHdr,sizeof(_FHdr),0); end; procedure TArjArchive.GetHeader(var sr:SearchRec); var bc:word; b:byte; begin FillChar(_FHdr,SizeOf(_FHdr),#0); FillChar(BUFF,BSize,#0); Seek(_FArchive,_SL); BlockRead(_FArchive,BUFF,BSIZE,bc); Move(BUFF[1],_FHdr,SizeOf(_FHdr)); with _FHdr do begin if BHdrSz>0 then begin b:=1;sr.Name:=''; while NameDat[b]<>#0 do begin if NameDat[b]='/' then sr.Name:='' else sr.Name:=sr.Name+NameDat[b]; inc(b); end; sr.Size:=BHdrSz+CSize; if FType=2 then sr.Size:=BHdrSz; if BHdrSz=0 then sr.Size:=0; inc(_SL,sr.Size+10); sr.Time:=DOS_DT; end; end; end; Procedure TArjArchive.FindFirst(var sr:SearchRec); begin _SL:=0; GetHeader(sr); GetHeader(sr); { Why a call to GetHeader() twice? Because ARJ stores the name of the archive in the first field } end; procedure TArjArchive.FindNext(var sr:SearchRec); begin GetHeader(sr); end; end. { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer: LZH-part } Unit OOAVLzh; Interface Uses Dos,OOAV; Type LFHeader=Record Headsize,Headchk :byte; HeadID :packed Array[1..5] of char; Packsize,Origsize,Filetime:longint; Attr :word; Filename :string[12]; f32 :pathstr; dt :DateTime; end; type PLzhArchive=^TLzhArchive; TLzhArchive=object(TGeneralArchive) constructor Init; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; private _FHdr:LFHeader; _SL:longint; procedure GetHeader(var sr:SearchRec); end; Implementation constructor TLzhArchive.Init; begin _SL:=0; FillChar(_FHdr,sizeof(_FHdr),0); end; procedure TLzhArchive.GetHeader(var sr:SearchRec); var nr:word; begin fillchar(sr,sizeof(sr),0); seek(_FArchive,_SL); if eof(_FArchive) then exit; blockread(_FArchive,_FHdr,sizeof(LFHeader),nr); if _FHdr.headsize=0 then exit; inc(_SL,_FHdr.headsize); inc(_SL,2); inc(_SL,_FHdr.packsize); if _FHdr.headsize<>0 then UnPackTime(_FHdr.FileTime,_FHdr.DT); sr.Name:=_FHdr.FileName; sr.Size:=_FHdr.OrigSize; sr.Time:=_FHdr.FileTime; end; procedure TLzhArchive.FindFirst(var sr:SearchRec); begin _SL:=0; GetHeader(sr); end; procedure TLzhArchive.FindNext(var sr:SearchRec); begin GetHeader(sr); end; end. { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer: ZIP-part } Unit OOAVZip; Interface Uses Dos,OOAV; Type ZFHeader=Record Signature :longint; Version,GPBFlag,Compress,Date,Time:word; CRC32,CSize,USize :longint; FNameLen,ExtraField :word; end; type PZipArchive=^TZipArchive; TZipArchive=object(TGeneralArchive) constructor Init; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; private Hdr:ZFHeader; procedure GetHeader(var sr:SearchRec); end; implementation Const SIG = $04034B50; { Signature } constructor TZipArchive.Init; begin FillChar(Hdr,sizeof(Hdr),0); end; procedure TZipArchive.GetHeader(var sr:SearchRec); var b:byte; bc:word; begin fillchar(sr,sizeof(sr),0); if eof(_FArchive) then exit; BlockRead(_FArchive,Hdr,SizeOf(Hdr),bc); if bc<>Sizeof(Hdr) then exit; { Why checking for Hdr.FNamelen=0? Because the comments inserted in a ZIP-file are at the last field } if Hdr.FNameLen=0 then exit; sr.Name:=''; Repeat BlockRead(_FArchive,b,1); If b<>0 Then sr.Name:=sr.Name+Chr(b); Until (length(sr.Name)=Hdr.FNameLen) or (b=0); if b=0 then exit; Seek(_FArchive,FilePos(_FArchive)+Hdr.CSize+Hdr.ExtraField); sr.Size:=Hdr.USize; sr.Time:=Hdr.Date+Hdr.Time*longint(256*256); end; Procedure TZipArchive.FindFirst(var sr:SearchRec); begin GetHeader(sr); end; Procedure TZipArchive.FindNext(var sr:SearchRec); begin GetHeader(sr); end; end. { CUT ----------------------------------------------------------- } { Object-Oriented Archive-viewer: ZOO-part } unit OOAVZoo; interface uses Dos,OOAV; const SIZ_TEXT=20; const FNAMESIZE=13; const MAX_PACK=1; const LO_TAG=$a7dc; const HI_TAG=$fdc4; type ZFHeader=record lo_tag:word; hi_tag:word; _type:byte; packing_method:byte; next:longint; { pos'n of next directory entry } offset:longint; date:word; { DOS format date } time:word; { DOS format time } file_crc:word; { CRC of this file } org_size:longint; size_now:longint; major_ver:byte; minor_ver:byte; deleted:boolean; comment:longint; { points to comment; zero if none } cmt_size:word; { length of comment, 0 if none } unknown:byte; fname:array[0..FNAMESIZE-1] of char; end; type PZooArchive=^TZooArchive; TZooArchive=object(TGeneralArchive) constructor Init; procedure FindFirst(var sr:SearchRec);virtual; procedure FindNext(var sr:SearchRec);virtual; private _FHdr:ZFHeader; procedure GetHeader; procedure GetEntry(var sr:SearchRec); end; implementation type zooHeader=record text:array[0..SIZ_TEXT-1] of char; lo_tag:word; hi_tag:word; start:longint; minus:longint; major_ver:char; minor_ver:char; end; constructor TZooArchive.Init; begin FillChar(_FHdr,sizeof(_FHdr),0); end; procedure TZooArchive.GetHeader; var hdr:zooHeader; bc:word; begin seek(_FArchive,0); BlockRead(_FArchive,hdr,sizeof(hdr),bc); seek(_FArchive,hdr.start); end; procedure TZooArchive.GetEntry(var sr:SearchRec); var bc:word; b:byte; begin FillChar(_FHdr,SizeOf(_FHdr),#0); BlockRead(_FArchive,_FHdr,sizeof(_FHdr),bc); with _FHdr do begin if _Type<>0 then begin b:=0;sr.Name:=''; while FName[b]<>#0 do begin if FName[b]='/' then sr.Name:='' else sr.Name:=sr.Name+FName[b]; inc(b); end; sr.Size:=Org_Size; if _Type=0 then sr.Size:=0; sr.Time:=Date*longint(256*256)+Time; Seek(_FArchive,_FHdr.next); end; end; end; procedure TZooArchive.FindFirst(var sr:SearchRec); begin GetHeader; GetEntry(sr); end; procedure TZooArchive.FindNext(var sr:SearchRec); begin GetEntry(sr); end; end.