Contributor: EDWIN GROOTHUIS
{ 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 IOresult0 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]=#1ドルA 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 _Archivenil then
begin
close(_Archive^._FArchive);
Dispose(_Archive,Done);
end;
end;
function TArchive.Name(const n:string):boolean;
var sr:SearchRec;
OldFileMode:byte;
begin
if _Archivenil then
begin
close(_Archive^._FArchive);
Dispose(_Archive,Done);
_Archive:=nil;
end;
Name:=false;
_Name:=n;
Dos.FindFirst(_Name,anyfile,sr);
if DosError0 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 IOresult0 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 DataType0 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.headsize0 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 = 04034ドルB50; { 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 bcSizeof(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 b0 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 _Type0 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.