[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]
{ 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.
[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]