{ ╞═══════════════════════════════════════════════════════════╡ }
{ │ ZiPPAS 4.1 -- PKZIP 2.x Unpacking Objects for TP/BP 7.0 │ }
{ ╞═══════════════════════════════════════════════════════════╡ }
{ │ Copyright (c) 1993-95 by Solar Designer \ BPC │ }
{ ╞═══════════════════════════════════════════════════════════╡ }
{$IfNDef VER70}
!!! WARNING !!!
!!! ' This unit should be compiled with TP/BP version 7.0 ' !!!
!!! ' or 7.01. It is incompatible with older versions, and ' !!!
!!! ' may not be compatible with some future ones. ' !!!
{$EndIf}
unit Unpack;
interface
uses
DOS, Objects, Memory;
{$L unzipmz.obj} { Modified PKUNZJR.COM }
{$L unzipmi.obj} { INT 21h handler }
type
{ This record is returned by TUnpack.GetInfo }
TPackedInfo =
record
ZipId :LongInt;
Unknown1 :Array [1..4] of Byte;
Files :Word;
Unknown2 :Array [1..12] of Byte;
Ok :Boolean;
end;
{ TUnpack -- abstract object }
PUnpack = ^TUnpack;
TUnpack =
object(TObject)
FileName :PString; { The assigned file name }
Status :Byte; { One of the uzXXXX constants -- check after unpacking }
{ These fields can be modified directly }
Messages :Boolean; { Enable PKUNZJR messages }
NeededName:PString; { Unpack only this file }
Start :LongInt; { Start unpacking from this offset in ZIP file }
ZipId :LongInt; { ZIP signature (default is 'PK'#5#6) }
constructor Init(const AFileName:FNameStr);
destructor Done; virtual;
{ Initialize the unpacker for loading ZIP from the overlay of the EXE file }
procedure InitOverlay;
{ Unpack all files in archive }
procedure Unpack;
{ Unpack only the specified file }
procedure Unpack1(const Name:String);
{ Get some archive information }
procedure GetInfo(var Info :TPackedInfo);
{ Abstract method to store unpacked data -- should be overriden }
procedure Write(var Buf;
Count :Word); virtual;
{ Virtual method called when starting to unpack a new file }
{ The default method does nothing }
procedure New (var Name :String); virtual;
{ Virtual method to check if a given file should be unpacked or skipped }
{ The default method checks the NeededName field }
function Query(var Name :String) :Boolean; virtual;
private
procedure WriteFn;
procedure NewFn;
procedure QueryFn;
end;
{ TUnpackStream -- used for unpacking to any Turbo Vision stream }
PUnpackStream = ^TUnpackStream;
TUnpackStream =
object(TUnpack)
Stream :PStream;
constructor Init(const AFileName:FNameStr;
var AStream :TStream);
{ Overriden abstract method -- writes unpacked data to the stream }
procedure Write(var Buf;
Count :Word); virtual;
end;
{ This record is used internally }
PUItem= ^TUItem;
TUItem=
record
Next :PUItem;
Pos :LongInt;
Name :NameStr;
end;
{ TUnpackList -- provides a convenient way to access packed files by name }
PUnpackList =^TUnpackList;
TUnpackList =
object(TUnpackStream)
List :PUItem;
Pos :NameStr; { Current stream position (file name) }
{ Seek the assigned stream to the start of packed file 'Name' }
{ The name must be in upper case! }
procedure Seek (const Name :NameStr);
{ Overriden virtual method -- stores the name to list }
procedure New (var Name :String); virtual;
destructor Done; virtual;
end;
const
{ Error codes for TUnpack.Status }
uzOK= $00;
uzIOError= $02;
uzInvFormat= $03;
uzCRCError= $04;
uzNoMem= $80;
uzCritError= $81;
const
{ Amount of memory allocated for PKUNZJR's stack }
UnpackMemSize :Word = $C400 + $50;
implementation
type
TPSPRec=
record
Terminate,
MemSize :Word;
Extra1,
FarCall :Byte;
Dispatcher,
ExitAddr,
CtrlBreak,
CritError :Pointer;
Extra2 :Array [1..22] of Byte;
EnvironSeg :Word;
Extra3 :Array [1..46] of Byte;
FCB :Array [1..2, 1..16] of Byte;
Extra4 :Array [1..4] of Byte;
ComLine :String[127];
end;
var
WriteUnpacked, WriteNew,
QueryUnpack, SelfPtr :Pointer;
ZipMessages :Boolean;
ReadStart :LongInt;
procedure UnZipMemProc; far; External;
procedure UnZipIntProc; far; External;
procedure ProgramDS; External;
const
UZIntNum= $81;
UZProcSize= 2750;
UZSignOfs1= $966;
UZSignOfs2= $D7;
MaxWord= $FFFF;
pUZMemProc :Pointer= @UnZipMemProc;
procedure ExitUnZip; far; assembler;
asm
mov ax,4C00h + uzCritError
int UZIntNum
end;
procedure SaveAddr; assembler;
asm
dd 0 { proc addr }
dd 0 { ss/sp }
dw 0 { bp }
end;
{ TUnpack }
procedure TUnpack.WriteFn;
assembler;
asm
push si
push dx
push cx
les di,Self
push es
push di
mov di,es:[di]
call dword ptr [di+(vmtHeaderSize+4)] { Write }
end;
procedure MakeString;
assembler;
asm
push ds
mov ds,si
mov si,dx
push ss
pop es
cld
push di
inc di
xor cx,cx
@@1:
lodsb
or al,al
jz @@2
stosb
inc cx
jmp @@1
@@2:
pop di
mov es:[di],cl
pop ds
end;
procedure RemoveExt(var Name :String);
var
i :Integer;
begin
i:=1;
while (i<=Byte(Name[0])) and (Name[i]<>'.') do Inc(i);
if Name[i]='.' then Name[0]:=Char(i-1);
end;
procedure TUnpack.NewFn;
assembler;
var
NamePas :FNameStr;
asm
mov di,bp
sub di,80
call MakeString
push ss
mov di,bp
sub di,80
push di
les di,Self
push es
push di
mov di,es:[di]
call dword ptr [di+(vmtHeaderSize+8)] { New }
end;
procedure TUnpack.QueryFn;
assembler;
var
NamePas :FNameStr;
asm
mov di,bp
sub di,80
call MakeString
push ss
mov di,bp
sub di,80
push di
les di,Self
push es
push di
mov di,es:[di]
call dword ptr [di+(vmtHeaderSize+12)] { Query }
end;
constructor TUnpack.Init;
begin
Inherited Init;
FileName:=NewStr(AFileName);
asm
les di,Self
mov word ptr es:[di].TUnpack.ZipId,'KP'
mov word ptr es:[di].TUnpack.ZipId+2,0605h
end;
end;
procedure TUnpack.InitOverlay;
var
Header :record
ExeId :Array [0..1] of Char;
PartPage,
PageCnt :Word;
end;
S :TDosStream;
begin
DisposeStr(FileName);
FileName:=NewStr(ParamStr(0));
S.Init(FileName^, stOpenRead);
S.Read(Header, SizeOf(Header));
S.Done;
Start:=LongMul(Header.PageCnt, 512);
if Header.PartPage<>0 then Dec(Start, 512 - Header.PartPage);
end;
destructor TUnpack.Done;
begin
DisposeStr(FileName);
end;
procedure TUnpack.Write;
begin
Abstract;
end;
procedure TUnpack.New;
begin
end;
function TUnpack.Query;
begin
if NeededName=nil then Query:=True else
begin
RemoveExt(Name);
Query:=(Name=NeededName^);
end;
end;
procedure TUnpack.Unpack;
var
SaveUZInt :Pointer;
pUnZip :Pointer;
UZProcPTR :^TPSPRec;
ZipExitCode :Byte;
begin
UZProcPtr:=MemAllocSeg(UnpackMemSize);
if UZProcPtr=nil then
begin
Status:=uzNoMem; Exit;
end;
FillChar(UZProcPtr^, UnpackMemSize, 0);
pUnZip:=PTR(PtrRec(UZProcPtr).Seg, SizeOf(TPSPRec));
Move(pUZMemProc^, pUnZip^, UZProcSize);
asm
les di,Self
mov ax,word ptr es:[di].TUnpack.ZipId
mov dx,word ptr es:[di].TUnpack.ZipId+2
les di,pUnZip
mov word ptr es:[di+UZSignOfs1],ax
mov word ptr es:[di+UZSignOfs2],dx
end;
GetIntVec(UZIntNum, SaveUZInt);
SetIntVec(UZIntNum, Addr(UnZipIntProc));
asm
mov ah,62h
int 21h
les di,UZProcPtr
push ds
mov ds,bx
xor si,si
mov cx,40h
cld
rep movsw
pop ds
end;
with UZProcPtr^ do
begin
ExitAddr:=@ExitUnZip; CtrlBreak:=@ExitUnZip; CritError:=@ExitUnZip;
ComLine:=FileName^+#13#10; Dec(ComLine[0], 2);
end;
asm
mov word ptr ProgramDS,ds
les di,Self
mov word ptr SelfPtr,di
mov word ptr SelfPtr+2,es
end;
ZipMessages:=Messages;
WriteUnpacked:=@TUnpack.WriteFn; WriteNew:=@TUnpack.NewFn;
QueryUnpack:=@TUnpack.QueryFn;
ReadStart:=Start;
asm
push ds
mov ax,word ptr pUnZip
mov word ptr SaveAddr,ax
mov ax,word ptr pUnZip+2
mov word ptr SaveAddr+2,ax
mov word ptr SaveAddr+4,ss
mov word ptr SaveAddr+6,sp
mov word ptr SaveAddr+8,bp
mov ax,word ptr UZProcPtr+2
cli
mov ss,ax
mov dx,UnpackMemSize
dec dx
mov sp,dx
sti
mov es,ax
mov ds,ax
call dword ptr cs:SaveAddr
cli
mov ss,word ptr SaveAddr+4
mov sp,word ptr SaveAddr+6
sti
mov bp,word ptr SaveAddr+8
pop ds
mov ZipExitCode, al
end;
if ZipExitCode=1 then ZipExitCode:=0; { Ignore the "Not all files" error }
Status:=ZipExitCode;
SetIntVec(UZIntNum, SaveUZInt);
FreeMem(UZProcPTR, UnpackMemSize);
end;
procedure TUnpack.Unpack1;
begin
NeededName:=@Name;
Unpack;
NeededName:=nil;
end;
procedure TUnpack.GetInfo;
var
S :TDosStream;
begin
S.Init(FileName^, stOpenRead);
S.Seek(S.GetSize - (SizeOf(TPackedInfo)-1));
S.Read(Info, SizeOf(TPackedInfo)-1);
S.Done;
Info.Ok:=(S.Status=stOk) and (Info.ZipId=Self.ZipId);
end;
{ TUnpackStream }
constructor TUnpackStream.Init;
begin
Inherited Init(AFileName);
Stream:=@AStream;
end;
procedure TUnpackStream.Write;
begin
Stream^.Write(Buf, Count);
end;
{ TUnpackList }
procedure TUnpackList.New;
var
Last :PUItem;
begin
RemoveExt(Name);
Last:=List;
System.New(List);
List^.Next:=Last;
List^.Pos:=Stream^.GetPos;
List^.Name:=Name;
end;
destructor TUnpackList.Done;
var
Last :PUItem;
begin
while List<>nil do
begin
Last:=List; List:=Last^.Next; Dispose(Last);
end;
Inherited Done;
end;
procedure TUnpackList.Seek;
var
Current :PUItem;
begin
Current:=List;
while (Current<>nil) and (Current^.Name<>Name) do
Current:=Current^.Next;
if Current<>nil then
begin
Stream^.Seek(Current^.Pos);
Pos:=Name;
end
else Stream^.Seek(0);
end;
end.
