home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Bila Vrana
/
BILA_VRANA.iso
/
005A
/
4UTILS85.ZIP
/
SCANZIPF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-05-07
|
9KB
|
271 lines
UNIT ScanZIPFiles;
{$V-}
(* ----------------------------------------------------------------------
Part of 4DESC - A Simple 4DOS File Description Editor
and 4FF - 4DOS File Finder
(c) 1992, 1993 Copyright by David Frey,
Urdorferstrasse 30
8952 Schlieren ZH
Switzerland
DISCLAIMER: This unit is freeware: you are allowed to use, copy
and change it free of charge, but you may not sell or hire
this part of 4DESC. The copyright remains in our hands.
If you make any (considerable) changes to the source code,
please let us know. (send a copy or a listing).
We would like to see what you have done.
We, David Frey and Tom Bowden, the authors, provide absolutely
no warranty of any kind. The user of this software takes the
entire risk of damages, failures, data losses or other
incidents.
Code created using Turbo Pascal 6.0 (c) Borland International 1990
This unit provides the extraction of file names in .ZIP files.
----------------------------------------------------------------------- *)
INTERFACE USES Dos, Globals;
PROCEDURE SearchInZIPFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
VAR Dir: PathStr; VAR zipsearch: SearchRec);
PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
csize: LONGINT);
(* PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
csize: LONGINT;desc: DescStr); *)
VAR OldZIPFileName: PathStr;
IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
PROCEDURE SearchInZIPFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
VAR Dir: PathStr; VAR zipsearch: SearchRec);
CONST StartOfCentralDir = $02014b50;
StartOfLocalHeader= $04034b50;
EndOfCentralDir = $06054b50;
VAR i,l,cl,el : WORD;
k,Dummy : BYTE;
ZIPFileName: NameExtStr;
sig : LONGINT;
Desc : DescStr;
BEGIN (* SearchInZIPFile *)
Assign(f,zipsearch.Name); Reset(f,1);
BlockRead(f,Buffer^,BufSize,BytesRead);
BufPtr := 0; FilePtr := 0;
(* REPEAT
sig := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16+
LONGINT(ReadByte) SHL 8 + ReadByte;
IF BufPtr > BufSize THEN
BEGIN
BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
END;
UNTIL (sig = StartOfCentralDir) OR
(sig = EndOfCentralDir) OR (BufPtr > BytesRead); *)
REPEAT
REPEAT
sig := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16+
LONGINT(ReadByte) SHL 8 + ReadByte;
IF BufPtr > BufSize THEN
BEGIN
BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
END;
UNTIL (sig = StartOfLocalHeader (* StartOfCentralDir *) ) OR
(sig = StartOfCentralDir (* EndOfCentralDir *) ) OR
(BufPtr > BytesRead);
IF BufPtr > BytesRead THEN
BEGIN
WriteLn(output,'ZIP file error: local file header signature missing!');
WriteLn(output);
END;
IF sig = StartOfLocalHeader (* StartCentralDir *) THEN
BEGIN
FOR i := 1 TO 6 DO dummy := ReadByte;
(* version needed to extract 2 bytes
version made by 2 bytes // not on local file header
general purpose bit flag 2 bytes
compression method 2 bytes *)
Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
(* last mod file time 2 bytes,
last mod file date 2 bytes *)
FOR i := 1 TO 4 DO dummy := ReadByte;
(* crc-32 4 bytes *)
csize := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
(* compressed size 4 bytes *)
Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
(* uncompressed size 4 bytes *)
l := ReadByte SHL 8+ReadByte;
(* filename length 2 bytes *)
el:= ReadByte SHL 8+ReadByte;
(* extra field length 2 bytes *)
(* cl:= ReadByte SHL 8+ReadByte; *)
(* file comment length 2 bytes *)
(* FOR i := 1 TO 4 DO dummy := ReadByte; *)
(* disk number start 2 bytes
interrnal file attributes 2 bytes *)
(* Search.Attr := ReadByte; *)
(* external file attributes 4 bytes , first byte *)
(* FOR i := 1 TO 7 DO dummy := ReadByte; *)
(* relative offset of local header 4 bytes *)
WITH Search DO
BEGIN
name := '';
FOR i := 1 TO l DO
IF i <= 12 THEN name := name+DownCase(Chr(ReadByte))
ELSE dummy:= ReadByte;
END;
(* filename (variable size) *)
FOR i := 1 TO el DO dummy := ReadByte;
(* extra field (variable size) *)
(* Desc := '';
FOR i := 1 TO cl DO Desc := Desc + Chr(ReadByte); *)
(* file comment (variable size) *)
FOR k := 1 TO FileSpecs DO
BEGIN
FSplit(FileSpec[k],Path,name,ext);
WHILE Length(name) < 8 DO name := name+' ';
IF Ext = '' THEN Ext := '. '
ELSE
WHILE Length(ext) < 4 DO ext := ext+' ';
i := Pos('*',name);
IF i > 0 THEN
WHILE i <= 8 DO
BEGIN
name[i] := '?'; INC(i);
END;
i := Pos('*',ext);
IF i > 0 THEN
WHILE i <= 4 DO
BEGIN
ext[i] := '?'; INC(i);
END;
FileSpec[k] := Path+name+ext;
FSplit(Search.Name,Path,name,ext);
WHILE Length(name) < 8 DO name := name +' ';
IF Ext = '' THEN Ext := '. '
ELSE
WHILE Length(ext) < 4 DO ext := ext+' ';
ZIPFileName:= Path+name+ext;
i := 1;
WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = ZIPFileName[i])) AND
(i<12) DO
INC(i);
IF ((searchdesc = '') AND
(ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
(FileSpec[k][i] = '?') OR (FileSpec[k][i] = ZIPFileName[i]) THEN
ShowCompZIPFileData(search,zipsearch,Dir,csize);
(* ShowCompZIPFileData(search,zipsearch,Dir,csize,Desc); *)
END;
INC(BufPtr,csize); INC(FilePtr,csize);
Seek(f,FilePtr);
IF BufPtr > BufSize THEN
BEGIN
BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
END;
END;
UNTIL (BufPtr > BytesRead) OR (sig = StartOfCentralDir);
Close(f);
END; (* SearchInZIPFile *)
(* PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
csize: LONGINT;desc: DescStr); *)
PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
csize: LONGINT);
VAR i : INTEGER;
BEGIN
IF NOT BareOutput THEN
BEGIN
IF FileCount = 0 THEN
BEGIN
WriteLn(Output); IF DoPage THEN TestForMoreMsg;
WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
END;
IF zipsearch.Name <> OldZIPFileName THEN
BEGIN
DownString(zipsearch.Name); OldZIPFileName := zipsearch.Name;
InfoArray[0] := @zipsearch.Name;
SizeStr := FormattedLongIntStr(zipsearch.Size,8);
InfoArray[1] := @SizeStr;
UnpackTime(zipsearch.Time,DateRec);
Date := FormDate(DateRec); Time := FormTime(DateRec);
InfoArray[2] := @Date;
InfoArray[3] := @Time;
AttrStr := '....';
IF zipsearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
IF zipsearch.Attr AND Hidden = Hidden THEN AttrStr[2] := 'h';
IF zipsearch.Attr AND SysFile = SysFile THEN AttrStr[3] := 's';
IF zipsearch.Attr AND Archive = Archive THEN AttrStr[4] := 'a';
InfoArray[4] := @AttrStr;
FormatStr(s,'(%-12s %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
END;
InfoArray[0] := @search.Name;
SizeStr := FormattedLongIntStr(search.