[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]

    UNIT PKZExec;

    INTERFACE

    USES DOS;

    { Purpose :  Execute PKZIP/PKUNZIP on archive files                         }
    { Uses specialized EXEC procedure so main program can use ALL of the memory }
    { Also shows how to take over INT29 to NOT display anything on the CRT      }

    CONST
        PKZIP             : PathStr = 'PKZIP.EXE';
        PKUNZIP           : PathStr = 'PKUNZIP.EXE';

    VAR ZIPError          : INTEGER;

    PROCEDURE CleanUpDir (WorkDir, FileMask : STRING);
                       {Erases files based on a mask }

    PROCEDURE DisplayZIPError;
                       { PKZip interface }

    PROCEDURE DefaultCleanup (WorkDir : STRING);
                       {Erases files *.BAK, *.MAP, temp*.*}

    PROCEDURE ShowEraseStats;
                       {shows count & bytes recovered}

    FUNCTION  UnZIPFile (ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;
                       {Uses PKUnZip to de-archive files }

    FUNCTION  ZIPFile (ZIPOpts, ZIPName, fspec  : STRING; qt : BOOLEAN) : BOOLEAN;
                       {Uses PKZip to archive files }

    IMPLEMENTATION

    VAR  ZIPDefaultZIPOpts : STRING [16];
    VAR  ZIPFileName       : STRING [50];
    VAR  ZIPDPath          : STRING [50];

    VAR  EraseCount        : WORD;        { files erased }
         EraseSizeK        : LONGINT;     { kilobytes released by erasing files }
         ShowOnWrite       : BOOLEAN;
         I29H              : POINTER;

    { EXECUTE STUFF - SHRINK HEAP AND EXECUTE LIKE EXECDOS }

    {$F+}
    PROCEDURE Int29Handler (AX, BX, CX, DX, SI, DI, DS, ES, BP : WORD); INTERRUPT;
    VAR
      Dummy : BYTE;
    BEGIN
      Asm
        Sti
      END;
      IF ShowOnWrite THEN WRITE (CHAR (LO (Ax) ) );
      Asm
        Cli
      END;
    END;

    PROCEDURE ReallocateMemory (P : POINTER); ASSEMBLER;
    ASM
      MOV  AX, PrefixSeg
      MOV  ES, AX
      MOV  BX, WORD PTR P + 2
      CMP  WORD PTR P, 0
      JE   @OK
      INC  BX

     @OK :
      SUB  BX, AX
      MOV  AH, 4Ah
      INT  21h
      JC   @X
      LES  DI, P
      MOV  WORD PTR HeapEnd, DI
      MOV  WORD PTR HeapEnd + 2, ES
     @X :
    END;

    { ZAP this DEFINE if NOT 386,486}
    {..$DEFINE CPU386}

    FUNCTION EXECUTE (Name : PathStr ; Tail : STRING) : WORD; ASSEMBLER;
    ASM
      {$IFDEF CPU386}
      DB      66h
      PUSH    WORD PTR HeapEnd
      DB      66h
      PUSH    WORD PTR Name
      DB      66h
      PUSH    WORD PTR Tail
      DB      66h
      PUSH    WORD PTR HeapPtr
      {$ELSE}
      PUSH    WORD PTR HeapEnd + 2
      PUSH    WORD PTR HeapEnd
      PUSH    WORD PTR Name + 2
      PUSH    WORD PTR Name
      PUSH    WORD PTR Tail + 2
      PUSH    WORD PTR Tail
      PUSH    WORD PTR HeapPtr + 2
      PUSH    WORD PTR HeapPtr
      {$ENDIF}

      CALL ReallocateMemory
      CALL SwapVectors
      CALL DOS.EXEC
      CALL SwapVectors
      CALL ReallocateMemory
      MOV  AX, DosError
      OR   AX, AX
      JNZ  @OUT
      MOV  AH, 4Dh
      INT  21h
     @OUT :
    END;
    {$F-}

    FUNCTION ExecuteCommand(p,s : STRING; quiet : BOOLEAN) : INTEGER;
    BEGIN
    ShowOnWrite := NOT quiet;  { turn off INT 29 }
    GETINTVEC ($29, I29H);
    SETINTVEC ($29, @Int29Handler);         { Install interrupt handler }
    Execute(p,s);
    SETINTVEC ($29, I29h);
    IF DosError = 0 THEN ExecuteCommand := DosExitCode   ELSE ExecuteCommand := DosError;
    END;

    FUNCTION AddBackSlash (dName : STRING) : STRING;
    BEGIN
      IF dName [LENGTH (dName) ] IN ['\', ':', #0] THEN
        AddBackSlash := dName
      ELSE
        AddBackSlash := dName + '\';
    END;

    FUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;

    VAR F : FILE;

    BEGIN

    EraseFile := FALSE;

    ASSIGN (F, S);
    RESET (F);

    IF IORESULT <> 0 THEN EXIT;

      CLOSE (F);
      ERASE (F);
      EraseFile := (IORESULT = 0);

    END;

    FUNCTION FileExists ( S : PathStr ) : BOOLEAN ;

    VAR F : FILE;

    BEGIN

    FileExists := FALSE;

    ASSIGN (F, S);
    RESET (F);

    IF IORESULT <> 0 THEN EXIT;

      CLOSE (F);
      FileExists := (IORESULT = 0);

    END;

    PROCEDURE CleanUpFile (WorkDir : STRING; SR : searchRec);
    VAR l    : LONGINT;
        BEGIN
        WITH SR DO
            BEGIN
            l := size DIV 512;
            IF (attr AND 31) = 0 THEN
                BEGIN
                IF l = 0 THEN l := 1;
                EraseSizeK := EraseSizeK + l;
                WRITELN ('         Removing: ', (AddBackSlash (WorkDir) + name),
                        '   ', l DIV 2, 'k');
                EraseFile (AddBackSlash (WorkDir) + name);
                INC (EraseCount);
                END
            ELSE WRITELN (' ??  ', (AddBackSlash (WorkDir) + name), '   ', l DIV 2, 'k',
                         '  attr: ', attr);
            END;
        END;

    PROCEDURE CleanUpDir (WorkDir, FileMask : STRING);
    VAR Frec : SearchRec;
        s    : STRING [64];
        BEGIN
        s := '';
        FINDFIRST (AddBackSlash (WorkDir) + FileMask, anyfile, Frec);
        WHILE doserror = 0 DO
            BEGIN
            CleanUpFile (WorkDir, Frec);
            FINDNEXT (Frec);
            END;
        END;

    PROCEDURE DefaultCleanup (WorkDir : STRING);
        BEGIN
        CleanUpDir (WorkDir, '*.BAK');
        CleanUpDir (WorkDir, '*.MAP');
        CleanUpDir (WorkDir, 'TEMP*.*');
        END;

    PROCEDURE DisplayZIPError;
        BEGIN
        CASE ziperror OF
            0       : WRITELN ('no error');
            2,3     : WRITELN (ziperror : 3, ' Error in ZIP file ');
            4..8    : WRITELN (ziperror : 3, ' Insufficient Memory');
            11,12   : WRITELN (ziperror : 3, ' No MORE files ');
            9,13    : WRITELN (ziperror : 3, ' File NOT found ');
            14,50   : WRITELN (ziperror : 3, ' Disk FULL !! ');
            51      : WRITELN (ziperror : 3, ' Unexpected EOF in ZIP file ');
            15      : WRITELN (ziperror : 3, ' Zip file is Read ONLY! ');
            10,16   : WRITELN (ziperror : 3, ' Bad or illegal parameters ');
            17      : WRITELN (ziperror : 3, ' Too many files ');
            18      : WRITELN (ziperror : 3, ' Could NOT open file ');
            1..90   : WRITELN (ziperror : 3, ' Exec DOS error ');
            98      : WRITELN (ziperror : 3, ' requested file not produced ');
            99      : WRITELN (ziperror : 3, ' archive file not found');
            END;
        END;

    PROCEDURE PKZIPInit;
         BEGIN
         PKZIP   := FSearch('PKZIP.EXE',GetEnv('PATH'));
         PKUNZIP := FSearch('PKUNZIP.EXE',GetEnv('PATH'));
         ZIPError          := 0;
         ZIPDefaultZIPOpts := '-n';
         ZIPFileName       := '';
         ZIPDPath          := '';
         EraseCount        := 0;
         EraseSizeK        := 0;
         END;

    PROCEDURE ShowEraseStats;
        {-Show statistics at the end of run}
        BEGIN
        WRITELN ('Files Erased: ', EraseCount,
                '  bytes used: ', EraseSizeK DIV 2, 'k');
        END;

    FUNCTION  UnZIPFile ( ZIPOpts, ZIPName, DPath, fspec : STRING; qt : BOOLEAN) : BOOLEAN;
    VAR s, zname     : STRING;
        i, j         : INTEGER;
        BEGIN
        ZIPError       := 0;
        UnZIPFile := TRUE;
        s := '';
        IF ZIPOpts <> '' THEN  s := s + ZIPOpts
        ELSE                   s := s + ZIPDefaultZIPOpts;

        IF ZIPName <> '' THEN  zname := ZIPName
        ELSE                   zname := ZIPFileName;
        IF NOT FileExists (zname) THEN
            BEGIN
            WRITELN ('zname: [', zname, ']');
            UnZIPFile := FALSE;
            ZIPError := 99;
            EXIT;
            END;

        s := s + ' ' + zname;

        IF DPath <> '' THEN s := s + ' ' + DPath
        ELSE                   s := s + ' ' + ZIPDPath;
        s := s + ' ' + fspec;
        ZIPError := ExecuteCommand (PKUNZIP,s,qt);
        IF ZIPError > 0 THEN
             BEGIN
             WRITELN ('PKUNZIP start failed ', ZIPError, ' [', s, ']');
             UnZIPFile := FALSE;
             END
        ELSE BEGIN
             i := POS ('*', fspec);
             j := POS ('?', fspec);
             IF (i = 0) AND (j = 0) THEN
                 BEGIN
                 IF NOT FileExists (DPath + fspec) THEN
                      BEGIN
                      UnZIPFile := FALSE;
                      ZIPError := 98;
                      END;
                 END;
             END;
        END;

    FUNCTION  ZIPFile ( ZIPOpts, ZIPName, fspec  : STRING; qt : BOOLEAN) : BOOLEAN;
    VAR s, zname     : STRING;
        i, j         : INTEGER;
        BEGIN
        ZIPError       := 0;
        ZIPFile := TRUE;
        s  := '';
        IF ZIPOpts <> '' THEN  s := s + ZIPOpts
        ELSE                   s := s + ZIPDefaultZIPOpts;

        IF ZIPName <> '' THEN  zname := ZIPName
        ELSE                   zname := ZIPFileName;
        s := s + ' ' + zname;
        s := s + ' ' + fspec;
        ZIPError := ExecuteCommand (PKZIP,s,qt);
        IF ZIPError > 0 THEN
             BEGIN
             WRITELN ('PKZIP start failed ', ZIPError, ' [', s, ']');
             ZIPFile := FALSE;
             END
        ELSE BEGIN
             IF NOT FileExists (ZIPname + '.ZIP') THEN
                  BEGIN
                  ZIPFile := FALSE;
                  ZIPError := 98;
                  END;
             END;
        END;

         BEGIN
         PKZIPInit;
         END.

[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]