Category : Utilities for DOS and Windows Machines
Archive   : ZIPDEL.ZIP
Filename : ZIPDEL.PAS

 
Output of file : ZIPDEL.PAS contained in archive : ZIPDEL.ZIP

PROGRAM ZIPDel (InFileSpec, Options);

{$B-,D+,R-,S-,V-}

USES TpCrt,TPDos,TPString,TPSpl,Dos;

CONST
No = False;
Yes = True;
Bell = #7;
ArrayLimit = 1024;
NL = #13#10;

TYPE
Line = STRING[65];

List = RECORD
Name : STRING[12];
Place : LONGINT;
ASize : LONGINT;
OSize : LONGINT;
Date : WORD;
Time : WORD;
Group : BYTE;
END;

BigArray = ARRAY [1..ArrayLimit] OF List;

NPtr = ^Dir_Rec;
Dir_Rec = RECORD
Name : string[12];
Next : NPtr;
Prev : NPtr;
END;

Time_Date = ARRAY [1..2] OF WORD;

VAR
InFile : FILE;
OutFile : FILE;
InFileSpec : Line;
InFileName : Line;
InPath : Line;
DirToClean : Line;
Version : Line;
HeapPtr : MarkRec; { Pointer to heap for mark/release }
ListArray : BigArray;
ZIPCount : WORD;
NamePtr : NPtr;
Verify : BOOLEAN;
Test : BOOLEAN;
ForceDel : BOOLEAN;
DelFromZIP : BOOLEAN;
Match : WORD;
Output : TEXT;
FileNdx : WORD;

(*----------------------------------------------------------------------*)
(* Display_ZIP_Contents --- Display contents of ZIP file *)
(*----------------------------------------------------------------------*)

PROCEDURE Display_ZIP_Contents( ZIPFileName : String ; Var ZipFile : File );

(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Display_ZIP_Contents *)
(* *)
(* Purpose: Displays contents of a ZIP file *)
(* *)
(* Calling sequence: *)
(* *)
(* Display_ZIP_Contents( ZIPFileName : String ; Var Zipfile : File); *)
(* *)
(* ZIPFileName --- name of ZIP file whose contents are to be *)
(* listed. *)
(* *)
(* ZipFile - Handle of Zipfile to be read *)
(* *)
(* *)
(* *)
(*----------------------------------------------------------------------*)

(*----------------------------------------------------------------------*)
(* Map of ZIP file entry headers *)
(*----------------------------------------------------------------------*)

CONST
ZIP_Central_Header_Signature = $02014B50;
ZIP_Local_Header_Signature = $04034B50;
ZIP_End_Central_Dir_Signature = $06054B50;

Open_Error = 1 (* Error when opening file *);
Format_Error = 2 (* Library format bad *);
End_Of_File = 3 (* End of library directory *);
Too_Many_Subs = 4 (* Too many nested subdirs *);
Central_Dir_Found = 5 (* Central directory sign found *);

TYPE
(* Structure of a local file header *)
ZIP_Local_Header_Type =
RECORD
Signature : LONGINT (* Header signature *);
Version : WORD (* Vers. needed to extract *);
BitFlag : WORD (* General flags *);
CompressionMethod : WORD (* Compression type used *);
FileTime : WORD (* File creation time *);
FileDate : WORD (* File creation date *);
CRC32 : LONGINT (* 32-bit CRC of file *);
CompressedSize : LONGINT (* Compressed size of file *);
UnCompressedSize : LONGINT (* Original size of file *);
FileNameLength : WORD (* Length of file name *);
ExtraFieldLength : WORD (* Length of extra stuff *);
END;

(* Structure of the central *)
(* directory record *)
ZIP_Central_Header_Type =
RECORD
Signature : LONGINT (* Header signature *);
VersionMadeBy : WORD (* System id/program vers. *);
VersionNeeded : WORD (* Vers. needed to extract *);
BitFlag : WORD (* General flags *);
CompressionMethod : WORD (* Compression type used *);
FileTime : WORD (* File creation time *);
FileDate : WORD (* File creation date *);
CRC32 : LONGINT (* 32-bit CRC of file *);
CompressedSize : LONGINT (* Compressed size of file *);
UnCompressedSize : LONGINT (* Original size of file *);
FileNameLength : WORD (* Length of file name *);
ExtraFieldLength : WORD (* Length of extra stuff *);
CommentFieldLength : WORD (* Length of comments *);
DiskStartNumber : WORD (* Disk # file starts on *);
InternalAttributes : WORD (* Text/non-text flags *);
ExternalAttributes : LONGINT (* File system attributes *);
LocalHeaderOffset : LONGINT (* Where local hdr starts *);
END;

VAR

ZIP_Entry : ZIP_Central_Header_Type (* Central header *);
ZIP_Pos : LONGINT (* Current byte offset in ZIP file *);
Bytes_Read : INTEGER (* # bytes read from ZIP file file *);
Ierr : INTEGER (* Error flag *);
Do_Blank_Line : BOOLEAN (* TRUE to print blank line *);
File_Name : String (* File name of entry in ZIP file *);
Long_Name : String (* Long file name *);

(*----------------------------------------------------------------------*)
(* Get_Next_ZIP_Local_Header --- Get next local header in ZIP file *)
(*----------------------------------------------------------------------*)

FUNCTION Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header :
ZIP_Local_Header_Type;
VAR Error : INTEGER ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(* *)
(* Function: Get_Next_ZIP_Local_Header *)
(* *)
(* Purpose: Gets next local header record in ZIP file *)
(* *)
(* Calling sequence: *)
(* *)
(* OK := Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header: *)
(* ZIP_Local_Header_Type; *)
(* VAR Error : INTEGER ) : *)
(* BOOLEAN; *)
(* *)
(* ZIP_Local_Header --- Local header data *)
(* Error --- Error flag *)
(* OK --- TRUE if header successfully found *)
(* *)
(*----------------------------------------------------------------------*)

VAR
ZIP_Local_Hdr : ZIP_Local_Header_Type (* Local header *);

BEGIN (* Get_Next_ZIP_Local_Header *)

(* Assume no error to start *)
Error := 0;
(* Position file *)
Seek( ZIPFile , ZIP_Pos );
(* Read in the file header entry. *)

IF ( IOResult <> 0 ) THEN
Error := Format_Error

ELSE
BEGIN

BlockRead( ZIPFile, ZIP_Local_Header, SIZEOF( ZIP_Local_Header ),
Bytes_Read );

(* If wrong size read, or header marker *)
(* byte is incorrect, report ZIP file *)
(* format error. *)

IF (ZIP_Pos = 0) AND
( ZIP_Local_Header.Signature <> ZIP_Local_Header_Signature) THEN
Bytes_Read :=0;
(* Check to see if this is a ZIP file *)

IF ( ( IOResult <> 0 ) OR
( Bytes_Read < SIZEOF( ZIP_Local_Header_Type ) ) ) THEN
Error := Format_Error
ELSE
(* Check for a legitimate header type *)

IF ( ZIP_Local_Header.Signature = ZIP_Local_Header_Signature ) THEN
BEGIN (* Local header -- skip it and associated data *)

ZIP_Pos := ZIP_Pos + ZIP_Local_Header.FileNameLength +
ZIP_Local_Header.ExtraFieldLength +
ZIP_Local_Header.CompressedSize +
SIZEOF( Zip_Local_Header_Type );
END

ELSE IF ( ZIP_Local_Header.Signature = ZIP_Central_Header_Signature ) THEN
BEGIN (* Central header -- we want this *)

Error := Central_Dir_Found;

END

ELSE IF ( ZIP_Local_Header.Signature = ZIP_End_Central_Dir_Signature ) THEN
Error := End_Of_File;

END;
(* Report success/failure to calling *)
(* routine. *)

Get_Next_ZIP_Local_Header := ( Error = 0 );

END (* Get_Next_ZIP_Local_Header *);

(*----------------------------------------------------------------------*)
(* Get_Next_ZIP_Entry --- Get next header entry in ZIP file *)
(*----------------------------------------------------------------------*)

FUNCTION Get_Next_ZIP_Entry( VAR ZIP_Entry : ZIP_Central_Header_Type;
VAR FileName : String;
VAR Error : INTEGER ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(* *)
(* Function: Get_Next_ZIP_Entry *)
(* *)
(* Purpose: Gets header information for next file in ZIP file *)
(* *)
(* Calling sequence: *)
(* *)
(* OK := Get_Next_ZIP_Entry( VAR ZIP_Entry : *)
(* ZIP_Central_Header_Type; *)
(* VAR FileName : String; *)
(* VAR Error : INTEGER ) : BOOLEAN; *)
(* *)
(* ZIP_Entry --- Header data for next file in ZIP file *)
(* FileName --- File name for this entry *)
(* Error --- Error flag *)
(* OK --- TRUE if header successfully found, else FALSE *)
(* *)
(*----------------------------------------------------------------------*)

VAR
L : INTEGER;
L_Get : INTEGER;
L_Got : INTEGER;

BEGIN (* Get_Next_ZIP_Entry *)
(* Assume no error to start *)
Error := 0;
(* Position file *)
Seek( ZIPFile , ZIP_Pos );
(* Read in the file header entry. *)

IF ( IOResult <> 0 ) THEN
Error := Format_Error

ELSE
BEGIN

BlockRead( ZIPFile, ZIP_Entry, SIZEOF( ZIP_Central_Header_Type ),
Bytes_Read );

(* If wrong size read, or header marker *)
(* byte is incorrect, report ZIP file *)
(* format error. *)

IF ( ( IOResult <> 0 ) OR
( Bytes_Read < SIZEOF( ZIP_Central_Header_Type ) ) ) THEN
Error := Format_Error
ELSE
(* Check for a legitimate header type *)

IF ( ZIP_Entry.Signature = ZIP_Central_Header_Signature ) THEN
BEGIN (* Central header -- we want this *)

(* Pick up file name length. *)
(* Only first 255 chars retrieved. *)

L := ZIP_Entry.FileNameLength;

IF ( L > 255 ) THEN
L_Get := 255
ELSE
L_Get := L;

(* Read file name characters. *)

BlockRead( ZIPFile, FileName[ 1 ], L_Get, L_Got );

(* Check for I/O error *)

IF ( ( IOResult <> 0 ) OR ( L_Get<> L_Got ) ) THEN
Error := Format_Error
ELSE
BEGIN
(* Position to next header *)

ZIP_Pos := ZIP_Pos + ZIP_Entry.ExtraFieldLength +
ZIP_Entry.CommentFieldLength +
ZIP_Entry.FileNameLength +
SIZEOF( Zip_Central_Header_Type );

(* Set length of file name *)

FileName[ 0 ] := CHR( L_Got );

END;

END
(* Check for end of directory *)

ELSE IF ( ZIP_Entry.Signature = ZIP_End_Central_Dir_Signature ) THEN
Error := End_Of_File

(* Anything else is bogus *)
ELSE
Error := Format_Error;

END;

Get_Next_ZIP_Entry := ( Error = 0 );

END (* Get_Next_ZIP_Entry *);

(*----------------------------------------------------------------------*)
(* Find_ZIP_Central_Directory --- Find central ZIP file directory *)
(*----------------------------------------------------------------------*)

FUNCTION Find_ZIP_Central_Directory( VAR Error : INTEGER ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(* *)
(* Function: Find_ZIP_Central_Directory *)
(* *)
(* Purpose: Finds central ZIP file directory *)
(* *)
(* Calling sequence: *)
(* *)
(* OK := Find_ZIP_Central_Directory( VAR Error : INTEGER ) : *)
(* BOOLEAN; *)
(* *)
(* Error --- Error flag *)
(* OK --- TRUE if header successfully found, else FALSE *)
(* *)
(*----------------------------------------------------------------------*)

VAR
I : INTEGER;
J : INTEGER;
L : LONGINT;
ZIP_Local_Hdr : ZIP_Local_Header_Type (* Local header *);

BEGIN (* Find_ZIP_Central_Directory *)

(* Assume no error to start *)
Error := 0;
(* Start at beginning of file. *)
ZIP_Pos := 0;
(* Begin loop over local headers. *)

(* Report success/failure to calling *)
(* routine. *)

WHILE ( Get_Next_ZIP_Local_Header( ZIP_Local_Hdr , Error ) ) DO;

Find_ZIP_Central_Directory := ( Error = Central_Dir_Found );

END (* Find_ZIP_Central_Directory *);

(*----------------------------------------------------------------------*)
(* Display_ZIP_Entry --- Display ZIP file file entry info *)
(*----------------------------------------------------------------------*)

PROCEDURE Display_ZIP_Entry( ZIP_Entry : ZIP_Central_Header_Type ;
File_Name : String );

VAR
I : INTEGER;
L : INTEGER;
FName : String;
TimeDate : LONGINT;
TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;

BEGIN (* Display_ZIP_Entry *)

WITH ZIP_Entry DO
BEGIN
(* Pick up short file name. Look *)
(* for trailing '/', and extract *)
(* stuff beyond as file name. *)
FName := File_Name;

I := POS( '/' , FName );

IF ( I > 0 ) THEN
BEGIN

L := LENGTH( FName );

WHILE( FName[ L ] <> '/' ) DO
DEC( L );

DELETE( FName, 1, L );

END;

(* Get date and time of creation *)

TimeDateW[ 1 ] := FileTime;
TimeDateW[ 2 ] := FileDate;

(* Display this entry's information *)
INC (FileNdx);
ListArray[FileNdx].Name := FName;
ListArray[FileNdx].ASize := CompressedSize;
ListArray[FileNdx].Place := 0;
ListArray[FileNdx].OSize := UnCompressedSize;
ListArray[FileNdx].Date := FileDate;
ListArray[FileNdx].Time := FileTime;
ListArray[FileNdx].Group := 0;
END;

END (* Display_ZIP_Entry *);

(*----------------------------------------------------------------------*)

BEGIN (* Display_ZIP_Contents *)
(* Open ZIP file and initialize *)
(* contents display. *)

(* Skip to central directory in ZIP file *)

IF Find_ZIP_Central_Directory( Ierr ) THEN

(* Loop over entries *)

WHILE ( Get_Next_ZIP_Entry( ZIP_Entry , File_Name , Ierr ) ) DO
Display_ZIP_Entry( ZIP_Entry , File_Name )

ELSE
WRITELN( 'Failed to find central ZIP directory for ', ZIPFileName );

(* Close ZIP file file *)

END (* Display_ZIP_Contents *);

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Usage ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
PROCEDURE Usage;

BEGIN
CLRSCR;
WRITELN (Output,
'ZIPDEL 1.0 (C) 1989 by Ted Stephens ',NL,NL,
'ZIPDEL is used to clean up a directory by deleting the files that came',NL,
'out of archive (.ZIP) files, OR (2) clean up an ZIP file by deleting files',NL,
'in the ZIP file that exist in a directory.',NL,
'',NL,
'USAGE: ZIPDEL [zip_file_template]{.ZIP} {/options}',NL,
'',NL,
'Options must be listed singly, each one prefixed by the slash ("/")',NL,
'character AND spaced apart. The options can be used in any combination.',NL,
'',NL,
'V : Verify deletion by asking (yes/no) before deleting each file.',NL,
'F : Force delete on matching filename even if there is a mismatch in',NL,
' creation date, time, or file size.',NL,
'T : Test -- no deletions at all, just report what would be deleted. ',NL,
'D : Deletes FROM THE ZIP FILE, NOT THE DIRECTORY.',NL);
Halt;
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Beep ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Beep (message : STRING);

BEGIN
WRITELN (Output, NL, message, NL);
SOUND (560);
DELAY (50);
NOSOUND;
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Error_Message ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Error_Message (message : STRING);

BEGIN
WRITELN (Output, Bell, NL, message, NL);
HALT; { ding bell & write message }
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE GET_FILENAME_LIST ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Get_FileName_List (InFileSpecV : Line; VAR NamePtrV : NPtr);

VAR { make list of ZIP files matching }
FileRecord : SearchRec; { InFileSpecV }
P1, P2, P3 : Nptr;
FirstDir : BOOLEAN;
Placed : BOOLEAN;

BEGIN
FirstDir := True;
NamePtrV := nil;
P1 := nil; { P1 is always "newest" pointer }
P2 := nil; { P2 points to immediate past item }
P3 := nil; { P3 is temp. ptr. for sort routine }

FindFirst (InFileSpecV, AnyFile, FileRecord);
IF DosError <> 0 THEN
Error_Message ('No file found matching file specification')
ELSE
BEGIN
WHILE DosError = 0 DO
BEGIN
IF FileRecord.Attr <> Directory THEN
BEGIN
NEW (P1);
P1^.Name := FileRecord.Name;
IF FirstDir = True THEN
BEGIN
P1^.Next := nil;
P1^.Prev := nil;
P2 := P1;
FirstDir := False;
END
ELSE
IF (P1^.Name < P2^.Name) THEN { Sort dir. names }
BEGIN
P1^.Next := P2;
P1^.Prev := nil;
P2^.Prev := P1;
P2 := P1;
END
ELSE
BEGIN
P3 := P2;
Placed := False;
WHILE ((P3^.Next <> nil) AND (Placed = False)) DO
BEGIN
IF (P1^.Name >= P3^.Next^.Name) THEN
P3 := P3^.Next
ELSE
Placed := True;
END;
P1^.Next := P3^.Next;
P1^.Prev := P3;
P3^.Next^.Prev := P1;
P3^.Next := P1;
END;
END;

FindNext (FileRecord);
END;

NamePtrV := P2;
END;
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE OPEN_INFILE ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Open_InFile (InFileNameV : Line; VAR InFile : FILE);

VAR
FileAttr : word;

BEGIN
{$I-}
ASSIGN (InFile,InFileNameV);
IF IOresult <> 0 THEN Error_Message ('Error -- cannot assign filename ' +
InFileNameV);

GetFAttr (InFile, FileAttr);

IF (FileAttr AND Directory) <> 0 THEN
Error_Message ('Error -- input file ' + InFileNameV +
' does not exist in current directory');

RESET (InFile, 1);
IF IOresult <> 0 THEN Error_Message ('Error -- cannot open input file ' +
InFileNameV);
{$I+}
END;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE DelFile ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE DelFile (NameV : Line; message : Line);

VAR
DelFile : File;

BEGIN
ASSIGN (DelFile, NameV);
ERASE (DelFile);
WRITELN (Output, message);
END;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Test_for_Del ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Test_for_Del (VAR ListArray : BigArray;
DirToCleanV : Line; ZIPCountV : Word;
VerifyV, TestV, ForceDelV, DelFromZIPV : BOOLEAN;
VAR MatchV : WORD);

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ SUB FUNCTION EQUAL ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

FUNCTION Equal (VAR first, second; Size : WORD) : BOOLEAN;
TYPE
Bytes = ARRAY [0..4] OF BYTE;
VAR
n : INTEGER;
BEGIN
n := 0;
WHILE (n < Size) AND (Bytes(first)[n] = Bytes(second)[n]) DO
INC (n);
Equal := n = size;
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ SUB PROCEDURE MARK_ZIP ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
PROCEDURE Mark_ZIP (VAR GroupV : BYTE; message : Line);
BEGIN
GroupV := 1;
INC (Match);
WRITELN (Output, message );
END;

VAR
i : INTEGER;
FileV : SearchRec;
OK : BOOLEAN;
TmDte : Time_Date;
Ch : CHAR;
CurFile : Line;

BEGIN
Match := 0;
IF FileNdx > 0 THEN
BEGIN
IF DirToCleanV = '.\' THEN
WRITELN (Output, 'Comparing ',InFileName,' to files in current directory',NL)
ELSE
WRITELN (Output, 'Comparing ',InFileName,' to files in ',DirToCleanV,NL);
END;
FOR i := 1 TO FileNdx DO
BEGIN
WRITE (Output, ListArray[i].name,'':12-LENGTH(ListArray[i].name));
CurFile := DirToCleanV + ListArray[i].name;
FindFirst (CurFile, AnyFile, FileV);
IF DosError <> 0 THEN
WRITELN (Output, ' -- Matching file not found')
ELSE
BEGIN
OK := False;
MOVE (FileV.Time, TmDte, SizeOf(FileV.Time));
IF NOT EQUAL (ListArray[i].OSize, FileV.size, 4) THEN
WRITE (Output, ' -- File size differs')
ELSE
IF NOT EQUAL (ListArray[i].date, TmDte[2], 2) THEN
WRITE (Output, ' -- File date differs')
ELSE
IF NOT EQUAL (ListArray[i].time, TmDte[1], 2) THEN
WRITE (Output, ' -- File time differs')
ELSE
OK := True;

IF TestV THEN
IF DelFromZIPV THEN
WRITELN (Output, ' -- File found, but NOT deleted from ZIP file')
ELSE
WRITELN (Output, ' -- File found, but NOT deleted from directory')
ELSE
IF VerifyV THEN
BEGIN
WRITE (Output, ' -- Delete file? (Y or N) ');
Ch := ReadKey;
IF (Ch = 'y') OR (Ch = 'Y') THEN
IF DelFromZIPV THEN
Mark_ZIP (ListArray[i].Group,' -- marked')
ELSE
DelFile (CurFile,' -- File deleted')
ELSE
WRITELN (Output);
END
ELSE
IF ForceDelV THEN
IF DelFromZIPV THEN
Mark_ZIP (ListArray[i].Group,' -- File marked for deletion')
ELSE
DelFile (CurFile,' -- File deleted')
ELSE
IF OK THEN
IF DelFromZIPV THEN
Mark_ZIP (ListArray[i].Group,' -- File marked for deletion')
ELSE
DelFile (CurFile,' -- File deleted')
ELSE
WRITELN (Output,' -- file NOT deleted');
END;
END;

IF TestV AND NOT DelFromZIPV THEN
WRITELN (Output,NL,'Test specified -- directory files not deleted');
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Read_Params ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Read_Params (VAR InFileSpecV : Line;
VAR InPathV : Line;
VAR DirToCleanV : Line;
VAR VerifyV : BOOLEAN;
VAR ForceDelV : BOOLEAN;
VAR TestV : BOOLEAN;
VAR DelFromZIPV : BOOLEAN);


VAR
Param2 : Line;
i : INTEGER;

BEGIN

VerifyV := No;
ForceDelV := No;
TestV := No;
DelFromZIPV := No;
DirToClean := '.\';
i := 0;

IF (ParamCount = 0) OR (ParamStr(1) = '?') OR (ParamStr(1) = '/?') THEN
Usage
ELSE
BEGIN
InFileSpecV := StUpCase(ParamStr(1));
InFileSpecV := DefaultExtension(InFileSpecV,'ZIP');
InPathV := JustPathName(InFileSpecV);
IF InPathV = '' then
InPathV := DirToClean
ELSE
InPathV := InPathV + '\';
FOR i := 2 TO ParamCount DO
BEGIN
Param2 := StUpCase(ParamStr(i));
IF Param2[1] = '/' THEN
CASE Param2[2] OF
'V' : VerifyV := Yes;
'F' : ForceDelV := Yes;
'T' : TestV := Yes;
'D' : DelFromZIPV := Yes;
END
ELSE
DirToCleanV := Param2 + '\';
END;
DirToCleanV := InPathV ;
END;
END;

Procedure BuildNewZip;

Const

ZipCommand : String[12] = 'Pkzip -d ';
ZipResp : String[12] = 'ZipFile.Rsp';

Var
Response : TEXT;
ZipShell : String;
i : Integer;
DosOk,
ZipOk,
MakeZip : Boolean;
ZipTD : Longint;

begin
DosOk :=No;
MakeZip:=No;
ZipOk :=No;
GetFTime(InFile,ZipTD); (* Get time and date of old ZIP *)
Close(Infile); (* Close file before shell *)
IF Match = 0 THEN
BEGIN
WRITELN (Output);
IF TEST THEN
WRITELN (Output, 'Test specified -- ZIP file not changed')
ELSE
WRITELN (Output, 'No matching files in ZIP to delete');
EXIT;
END;
IF Match = FileNdx THEN
BEGIN
WRITELN (Output);
DelFile (InPath + InFileName,
'All files in ZIP file match -- ZIP file is deleted');
EXIT;
END;
Assign(Response,InPath + ZipResp);
Rewrite(Response);
for i := 1 to FileNdx Do
Begin
If ListArray[i].Group = 1 then
Begin
Writeln(Response,ListArray[i].Name);
MakeZip:=Yes;
End;
End;
Close(Response);
If MakeZip then
Begin
WRITE(Output,NL,InFileName,'':12-LENGTH(InFileName));
WRITE(Output,' -- ZIPing ');
ZipShell := ZipCommand + Inpath + InFileName + ' @'+ InPath + ZipResp + ' >NUL';
DosOk := 0 = ExecDos(ZipShell,True,nil) ;
ZipOk := 0 = DosExitCode;
End;
If DosOk and ZipOk and MakeZip
then Write(Output,' done.');
Reset(Infile); (* Reopen to set time and date *)
SetFTime(InFile,ZipTD); (* Set time and date same old Zip *)
Close(InFile); (* Close for next Zip file *)
DelFile(InPath + ZipResp,''); (* Delete response file for Pkzip *)
end; { procedure BuildNewZip }

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ MAIN PROGRAM ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

BEGIN

Version := 'Version 1.0, 3-15-89 -- Public Domain by Ted Stephens';
MarkFL(HeapPtr); { Save the current heap ptr }

ASSIGN (Output,'');
REWRITE (Output);

Read_Params (InFileSpec, InPath, DirToClean,
Verify, ForceDel, Test, DelFromZIP);

Get_FileName_List (InFileSpec, NamePtr);

ClrScr;

WHILE NamePtr <> nil DO
BEGIN
WRITELN (Output);

FileNdx:=0;

InFileName := NamePtr^.Name;

Open_InFile (InPath + InFileName, InFile);

Display_ZIP_Contents(Inpath + InfileName,InFile);

Test_for_Del (ListArray, DirToClean, ZIPCount,
Verify, Test, ForceDel, DelFromZIP, Match);

If DelFromZIP Then
BuildNewZip;

IF NOT DelFromZip Then CLOSE (InFile);

WRITELN (Output);

NamePtr := NamePtr^.Next; { get next filename }

END; {while}

ReleaseFL(HeapPtr); { Restore all mem allocated }

Beep ('Processing done.');

CLOSE (Output);

END.