Simtel MSDOS 1992 September/Simtel20_Sept92.cdr/msdos/arc_lbr/update.arc/UPDATE.PAS

Pascal/Delphi Source File | 1988-09-24 | 19KB | 648 lines

{Turbo Pascal 4.0}
{$I+,R+,S+,T+,D+,F-,B-,V+}
{$M 16384,0,16384}
program Update;

{-------------------------------------------------------------------------

     Update converts archives from PKpak to Zoo and from Zoo to PKpak.
It also will re-archive a PKpak archive to try and make it smaller.  If
the new archive is larger than the old archive, it will not replace the
old one.  Update will keep the date and time of the archive's the same
through conversion and re-archiving.  Update is configurable through
enviroment strings.  It needs to know the full path name and file name
of PKpak, PKunpak, and Zoo.  These are entered in the enviroment under
"ARCPATH=", "UNARCPATH=", and "ZOOPATH=" respectively.  Update also needs
to know what name to use for it's temporary directory.  This directory
is made and removed each time Update is run.  This is stored in the
enviroment string "WORKDIR=".  Update will not work across drives (i.e.
Both the working and the Input directory must be on the same drive.).
The command line options are "update [Input Directory] (/r || /pz || /zp)".
The Input Directory is optional.  If no directory is given, the current
directory will be used.  One of the three "/r","/pz","/zp" may be given.
The first tells Update to Re-archive the files, the second says to convert
from PKpak to Zoo, and the third says to convert from Zoo to PKpak.
     This program is donated to the Public Domain.  You may do what you
wish with it.  If you modify it and redistribute it, include a "signature"
below mine, the date, and a short discription of the modifications done.

Derrick Hamner, 8/24/88 -- Wrote the original program.

-------------------------------------------------------------------------}

Uses
  Crt,
  Graph,
  Dos;

const
  ArcName : String[8] = 'ARCPATH=';
  UnArcName : String[10] = 'UNARCPATH=';
  ZooName : String[8] = 'ZOOPATH=';
  WorkDirName : String[8] = 'WORKDIR=';
  DefaultArc : String[20] = '\ARCHIVE\PKPAK.EXE';
  DefaultUnArc : String[22] = '\ARCHIVE\PKUNPAK.EXE';
  DefaultZoo : String[18] = '\ARCHIVE\ZOO.EXE';
  DefaultWorkDir : String[8] = '\T_M_P';
  ValidSwitches : string[12] = ' /r /pz /zp ';

type
  StoreFilePtr = ^StoreFile;      {Used to store the file data for the}
  StoreFile = record              {final report}
                Name : string[13];
                OrgSize, NewSize : LongInt;
                Next : StoreFilePtr;
              end;

var
  InDir, HomeDir : string;
  Switch : String[3];
  OldDiskSpace : LongInt;
  Head, Current, Previous : StoreFilePtr;
  Arc, UnArc, Zoo, WorkDir : String;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure Error (ErrorNumber : Byte);

begin
  write(#7);
  case ErrorNumber of
    1 : writeln('Error in procedure DeleteFile.');
    2 : writeln('Error in procedure MoveFile.');
    3 : writeln('Illegal switch.');
    4 : writeln('The working directory does not exist.');
    5 : writeln('Sub-program (PkPak/unpak or Zoo) error.');
    6 : writeln('Input directory does not exist.');
    7 : writeln('Working directory has files in it.');
    8 : writeln('There are no *.ARC or *.ZOO files in the Input directory.');
    9 : writeln('Wrong number of parameters.');
    10: writeln('Directory "',WorkDir,'" left over from previous error.');
  end;
  ChDir(HomeDir);
{$I-}
  RmDir(WorkDir);
{$I+}
  Halt(1);
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure Setup;

var
  I, J, TempPos : Byte;
  EnviromentSegment : Word;
  Enviroment : string;
  TempPtr1 : ^Word;
  TempPtr2 : ^Char;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure GetEnviroment;

begin
  TempPtr1 := Ptr(PreFixSeg, $2C);
  EnviromentSegment := TempPtr1^;
end;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
begin
  Arc := DefaultArc;
  UnArc := DefaultUnArc;
  Zoo := DefaultZoo;
  WorkDir := DefaultWorkDir;
  GetEnviroment;

  J := 0;
  repeat
    Enviroment[0] := #255;        {Read the first 255 characters of the}
    for I := 1 to 255 do          {enviroment.}
      begin
        TempPtr2 := Ptr(EnviromentSegment,I - 1 + J * 255);
        Enviroment[I] := TempPtr2^;
      end;
                                  {Search for ArcName in the enviroment}
    TempPos := Pos(ArcName, Enviroment);
    if TempPos <> 0
      then begin                  {If found, set Arc equal to the}
             I := 1;              {enviroment string}
             repeat
               Arc[I] := Enviroment[TempPos + 7 + I];
               Inc(I);
             until Enviroment[TempPos + 7 + I] = #0;
             Arc[0] := Chr(I - 1);
           end;

    TempPos := Pos(UnArcName, Enviroment);
    if TempPos <> 0
      then begin
             I := 1;
             repeat
               UnArc[I] := Enviroment[TempPos + 9 + I];
               Inc(I);
             until Enviroment[TempPos + 7 + I] = #0;
             UnArc[0] := Chr(I - 1);
           end;

    TempPos := Pos(ZooName, Enviroment);
    if TempPos <> 0
      then begin
             I := 1;
             repeat
               Zoo[I] := Enviroment[TempPos + 7 + I];
               Inc(I);
             until Enviroment[TempPos + 7 + I] = #0;
             Zoo[0] := Chr(I - 1);
           end;

    TempPos := Pos(WorkDirName, Enviroment);
    if TempPos <> 0
      then begin
             I := 1;
             repeat
               WorkDir[I] := Enviroment[TempPos + 7 + I];
               Inc(I);
             until Enviroment[TempPos + 7 + I] = #0;
             WorkDir[0] := Chr(I - 1);
           end;
    Inc(J);
  until Pos(#0 + #0,Enviroment) <> 0;
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure DeleteFile(FileName : string);

                   {Requires DOS 2.0 or later}

var
  Regs : Registers;
  TempFileName : array[1..255] of char;
  I : Byte;

begin
                                  {Convert filename to an ASCIIZ string}
  for I := 1 to Ord(FileName[0]) do TempFileName[I] := FileName[I];
  TempFileName[Ord(FileName[0]) + 1] := Chr(0);

  FillChar(Regs,SizeOf(Regs),0);
  with Regs do
    begin
      AH := $41;             {DOS Delete File}
      DS := Seg(TempFileName);
      DX := Ofs(TempFileName);
    end;
  MSDos(Regs);
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure MoveFile(OrgFileName, NewFileName : string);

                   {Requires DOS 2.0 or later}

var
  Regs : Registers;
  TempOrgFileName, TempNewFileName : array[1..255] of char;
  I : Byte;

begin
                                  {Convert filenames to ASCIIZ strings}
  for I := 1 to ord(OrgFileName[0]) do
    TempOrgFileName[I] := OrgFileName[I];
  TempOrgFileName[Ord(OrgFileName[0]) + 1] := Chr(0);
  for I := 1 to ord(OrgFileName[0]) do
    TempNewFileName[I] := NewFileName[I];
  TempNewFileName[Ord(NewFileName[0]) + 1] := Chr(0);

  FillChar(Regs,SizeOf(Regs),0);
  with Regs do
    begin
      AH := $56;             {DOS Rename File}
      DS := Seg(TempOrgFileName);
      DX := Ofs(TempOrgFileName);
      ES := Seg(TempNewFileName);
      DI := Ofs(TempNewFileName);
    end;
  MSDos(Regs);
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
function GetFileSize (FileName : String) : LongInt;

var
  FileHandle : File of Byte;

begin
  Assign(FileHandle,FileName);
  Reset(FileHandle);
  GetFileSize := FileSize(FileHandle);
  Close(FileHandle);
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure SetFileDateTime (FileName : String; DateTime : LongInt);

var
  FileHandle : File;

begin
  Assign(FileHandle,FileName);
  Reset(FileHandle);
  SetFTime(FileHandle, DateTime);
  Close(FileHandle);
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure Parse;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure Interpret1;

var
  I : Byte;

begin
  InDir := HomeDir;
  Switch := ParamStr(1);
  if (Pos(Switch, ValidSwitches) = 0)
    then Error(3);
{$I-}
  ChDir(WorkDir);
  if IOResult <> 0
    then Error(4);
{$I+}
end;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure Interpret2;

begin
  InDir := ParamStr(1);
  Switch := ParamStr(2);
  if (Pos(Switch, ValidSwitches) = 0)
    then Error(3);
{$I-}
  ChDir(InDir);
  if IOResult <> 0
    then Error(6);
  ChDir(WorkDir);
  if IOResult <> 0
    then Error(4);
{$I+}
end;

begin
  case ParamCount of
    1 : Interpret1;
    2 : Interpret2;
    else Error(9);
  end;
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure OutPutFileChanges;

var
  I : Integer;
  BytesSaved : LongInt;
  Dummy : Char;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure ScreenBreak;

begin
  write('Press any key to continue: ');
  Dummy := ReadKey;
  GotoXY(1,WhereY);
  ClrEol;
end;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{/\/\/\/\/\/\/\/\/\/\/\/\/\/}

begin
  write(#7);
  Current := Head;
  ClrScr;
  writeln('╔══════════════╤═══════════╤═══════════╤═════════════╗');
  writeln('║   File Name  │ Org. Size │ New  Size │ Bytes Saved ║');
  writeln('╟──────────────┼───────────┼───────────┼─────────────╢');
  I := 3;
  BytesSaved := 0;
  while Current <> Nil do
    begin
      Inc(I);
      write('║ ',Current^.Name);
      GotoXY(16,WhereY);
      write('│ ',Current^.OrgSize);
      GotoXY(28,WhereY);
      write('│ ',Current^.NewSize);
      GotoXY(40,WhereY);
      write('│ ',Current^.OrgSize - Current^.NewSize);
      BytesSaved := BytesSaved + (Current^.OrgSize - Current^.NewSize);
      GotoXY(54,WhereY);
      writeln('║');
      if (I mod 24 = 0)
        then ScreenBreak;
      Current := Current^.Next;
    end;
    writeln('╚══════════════╧═══════════╧═══════════╧═════════════╝');
    if (I > 16)
      then ScreenBreak;
    writeln;
    writeln;
    writeln('                      ╔════════╗');
    writeln('                      ║ Totals ║');
    writeln('       ╔══════════════╩═══╦════╩═════════════╗');
    writeln('       ║ File Bytes Saved ║ Disk Space Saved ║');
    writeln('       ╟──────────────────╫──────────────────╢');
    write('       ║  ',BytesSaved);
    GotoXY(27,WhereY);
    write('║  ',(DiskFree(0) - OldDiskSpace) div 1024,'K');
    GotoXY(46,WhereY);
    writeln('║');
    writeln('       ╚══════════════════╩══════════════════╝');
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure ReArc;        {This will not replace the file if doing
                         so will make it larger.}

var
  FileRecord : SearchRec;
  FileName : String;
  OriginalDateTime : LongInt;
  Finished : Boolean;

begin
  ChDir(InDir);                   {Make sure that there are some *.ARC}
  FindFirst('*.ARC',Archive,FileRecord); {files.}
  If DosError <> 0
    then Error(8);

  FileName := FileRecord.Name;    {Store file info}
  OriginalDateTime := FileRecord.Time;
  New(Head);
  Current := Head;
  Current^.Name := Copy(FileRecord.Name, Length(FileRecord.Name) - 13, 13);
  Current^.OrgSize := FileRecord.Size;
  Current^.Next := Nil;

  ClrScr;                         {UnArc file}
  Exec(UnArc,FileName + ' ' + WorkDir);
  if Lo(DosExitCode) <> 0
    then Error(5);

  ChDir(WorkDir);                 {Arc file}
  ClrScr;
  Exec(Arc,'-m ' + FileName);
  if Lo(DosExitCode) <> 0
    then Error(5);

  Current^.NewSize := GetFileSize(FileName); {Check filesize}
  if Current^.NewSize < Current^.OrgSize
    then begin                    {Smaller, replace old with new file}
           DeleteFile(InDir + '\' + FileName);
           MoveFile(WorkDir + '\' + FileName, InDir + '\' + FileName);
           SetFileDateTime(InDir + '\' + FileName, OriginalDateTime);
         end
    else begin                    {Larger, delete new file}
           DeleteFile(WorkDir + '\' + FileName);
           Current^.NewSize := Current^.OrgSize;
         end;

  repeat                          {Repeat for rest of files}
    Finished := False;
    FindNext(FileRecord);
    if DosError = 0
      then begin
             FileName := FileRecord.Name;
             OriginalDateTime := FileRecord.Time;
             Previous := Current;
             New(Current);
             Previous^.Next := Current;
             Current^.Name := Copy(FileRecord.Name,
                              Length(FileRecord.Name) - 13, 13);
             Current^.OrgSize := FileRecord.Size;
             Current^.Next := Nil;

             ChDir(InDir);
             ClrScr;
             Exec(UnArc,FileName + ' ' + WorkDir);
             if Lo(DosExitCode) <> 0
               then Error(5);

             ChDir(WorkDir);
             ClrScr;
             Exec(Arc,'-m ' + FileName);
             if Lo(DosExitCode) <> 0
               then Error(5);

             Current^.NewSize := GetFileSize(FileName);
             if Current^.NewSize < Current^.OrgSize
               then begin
                      DeleteFile(InDir + '\' + FileName);
                      MoveFile(WorkDir + '\' + FileName, InDir + '\' + FileName);
                      SetFileDateTime(InDir + '\' + FileName, OriginalDateTime);
                    end
               else begin
                      DeleteFile(WorkDir + '\' + FileName);
                      Current^.NewSize := Current^.OrgSize;
                    end;
           end
     else Finished := True;
  until Finished;
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure PKpakToZoo;   {This will replace the file even if it
                         does make it larger.}

var
  FileRecord : SearchRec;
  FileName : String;
  OriginalDateTime : LongInt;
  Finished : Boolean;

begin
  ChDir(InDir);
  FindFirst('*.ARC',Archive,FileRecord);
  If DosError <> 0
    then Error(8);

  FileName := FileRecord.Name;
  FileName[0] := chr(ord(FileName[0]) - 4);
  OriginalDateTime := FileRecord.Time;
  New(Head);
  Current := Head;
  Current^.Name := Copy(FileName, Length(FileName) - 13, 13) + '.ZOO';
  Current^.OrgSize := FileRecord.Size;
  Current^.Next := Nil;

  ClrScr;
  Exec(UnArc,FileName + ' ' + WorkDir);
  if Lo(DosExitCode) <> 0
    then Error(5);

  ChDir(WorkDir);
  ClrScr;
  Exec(Zoo,'aM: ' + FileName + ' *');
  if Lo(DosExitCode) <> 0
    then Error(5);

  DeleteFile(InDir + '\' + FileName + '.ARC');
  MoveFile(WorkDir + '\' + FileName + '.ZOO', InDir + '\' + FileName + '.ZOO');
  SetFileDateTime(InDir + '\' + FileName + '.ZOO', OriginalDateTime);
  Current^.NewSize := GetFileSize(InDir + '\' + FileName + '.ZOO');

  repeat
    Finished := False;
    FindNext(FileRecord);
    if DosError <> 18
      then begin
             FileName := FileRecord.Name;
             FileName[0] := chr(ord(FileName[0]) - 4);
             OriginalDateTime := FileRecord.Time;
             Previous := Current;
             New(Current);
             Previous^.Next := Current;
             Current^.Name := Copy(FileName,
                              Length(FileName) - 13, 13) + '.ZOO';
             Current^.OrgSize:= FileRecord.Size;
             Current^.Next := Nil;

             ChDir(InDir);
             ClrScr;
             Exec(UnArc,FileName + ' ' + WorkDir);
             if Lo(DosExitCode) <> 0
               then Error(5);

             ChDir(WorkDir);
             ClrScr;
             Exec(Zoo,'aM: ' + FileName + ' *');
             if Lo(DosExitCode) <> 0
               then Error(5);

             DeleteFile(InDir + '\' + FileName + '.ARC');
             MoveFile(WorkDir + '\' + FileName + '.ZOO',
                      InDir + '\' + FileName + '.ZOO');
             SetFileDateTime(InDir + '\' + FileName + '.ZOO',
                              OriginalDateTime);
             Current^.NewSize := GetFileSize(InDir + '\' + FileName + '.ZOO');
           end
     else Finished := True;
  until Finished;
end;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
procedure ZooToPKpak;

var
  FileRecord : SearchRec;
  FileName : String;
  OriginalDateTime : LongInt;
  Finished : Boolean;

begin
  ChDir(InDir);
  FindFirst('*.ZOO',Archive,FileRecord);
  If DosError <> 0
    then Error(8);

  FileName := FileRecord.Name;
  FileName[0] := chr(ord(FileName[0]) - 4);
  OriginalDateTime := FileRecord.Time;
  New(Head);
  Current := Head;
  Current^.Name := Copy(FileName, Length(FileName) - 13, 13) + '.ARC';
  Current^.OrgSize := FileRecord.Size;
  Current^.Next := Nil;

  ClrScr;
  ChDir(WorkDir);
  Exec(Zoo,'x ' + InDir + '\' + FileName);
  if Lo(DosExitCode) <> 0
    then Error(5);

  ClrScr;
  Exec(Arc,'-m ' + FileName);
  if Lo(DosExitCode) <> 0
    then Error(5);

  DeleteFile(InDir + '\' + FileName + '.ZOO');
  MoveFile(WorkDir + '\' + FileName + '.ARC', InDir + '\' + FileName + '.ARC');
  SetFileDateTime(InDir + '\' + FileName + '.ARC', OriginalDateTime);
  Current^.NewSize := GetFileSize(InDir + '\' + FileName + '.ARC');

  repeat
    Finished := False;
    FindNext(FileRecord);
    if DosError <> 18
      then begin
             FileName := FileRecord.Name;
             FileName[0] := chr(ord(FileName[0]) - 4);
             Previous := Current;
             New(Current);
             Previous^.Next := Current;
             Current^.Name := Copy(FileName,
                              Length(FileName) - 13, 13) + '.ARC';
             Current^.OrgSize := FileRecord.Size;
             OriginalDateTime := FileRecord.Time;
             Current^.Next := Nil;

             ChDir(InDir);
             ClrScr;
             ChDir(WorkDir);
             Exec(Zoo,'x ' + InDir + '\' + FileName);
             if Lo(DosExitCode) <> 0
               then Error(5);

             ClrScr;
             Exec(Arc,'-m ' + FileName);
             if Lo(DosExitCode) <> 0
               then Error(5);

             DeleteFile(InDir + '\' + FileName + '.ZOO');
             MoveFile(WorkDir + '\' + FileName + '.ARC',
                      InDir + '\' + FileName + '.ARC');
             SetFileDateTime(InDir + '\' + FileName + '.ARC',
                              OriginalDateTime);
             Current^.NewSize := GetFileSize(InDir + '\' + FileName + '.ARC');
           end
     else Finished := True;
  until Finished;
end;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
begin
  DirectVideo := False;
  CheckBreak := False;
  SetUp;
  GetDir(0,HomeDir);
  OldDiskSpace := DiskFree(0);
{$I-}
  MkDir(WorkDir);
{$I+}
  if IOResult <> 0
    then Error(10);
  Parse;
  if Switch = '/r'
    then Rearc
    else if Switch = '/pz'
           then PKpakToZoo
           else ZooToPKpak;
  ChDir(HomeDir);
  RmDir(WorkDir);
  ClrScr;
  OutputFileChanges;
end.