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.


  3 Responses to “Category : Utilities for DOS and Windows Machines
Archive   : ZIPDEL.ZIP
Filename : ZIPDEL.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/