home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / UTILITIE / AZ2I6.ZIP / A2Z.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-09  |  43KB  |  1,331 lines
  1. {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
  2. {$M 32767,32767,32767}
  3. program A2Z;
  4.  
  5. {
  6.   Version 1.6
  7.  
  8.   This version represents minor changes in code structure.  It will also be
  9.   the last version released, unless some fatal flaw is uncovered.  Enjoy.
  10.  
  11.               Ian McLean                   404 428 7829 (voice)
  12.               3365 Timber Lake Road
  13.               Kennesaw, GA
  14.               30144
  15. }
  16.  
  17. uses DOS, CRT;
  18.  
  19. const
  20.   MaxDirEnteries=       20;    { Maximum number of directories that can be specified to search }
  21.                                { This doesn't include those searched "below" ones specified.   }
  22.  
  23.   DataNext:             string[10]=    'CONFIGNEXT';
  24.   PKZIP:                PathStr=       'U:\PKZIP.EXE';   {  80 bytes }
  25.   PKUNZIP:              PathStr=       'U:\PKUNZIP.EXE'; {  80 bytes }
  26.   PKUNPAK:              PathStr=       'U:\PKXARC.EXE';  {  80 bytes }
  27.   PAK:                  PathStr=       'U:\PAK.EXE';     {  80 bytes }
  28.   ASCIILevel:           char=          '4';              {  1  byte  }
  29.   BinaryLevel:          char=          '2';              {  1  byte  }
  30.                                                          { --------- }
  31.                                                          { 322 bytes }
  32.  
  33. type
  34.   FullNameStr=          string[12];                 { Type for storing name+dot+extention                                 }
  35.   DirSearchEntry=       record                      { This data type is used to store all the paths that will be searched }
  36.                           Dir:         DirStr;      {   <-- Path to search                                                }
  37.                           Name:        FullNameStr; {   <-- File spec to search                                           }
  38.                           Below:       boolean;     {   <-- TRUE=search directories below the specified one               }
  39.                         end;
  40.  
  41. var
  42.   Dir:                  array[1..MaxDirEnteries] of DirSearchEntry;  { This holds all the directories specified to convert }
  43.   NumDirs:              byte;                                        { The number of directories used in above array       }
  44.   SearchZips:           boolean;                                     { Search ZIP files for inclosed ARCs or PAKs          }
  45.   AppendLog:            boolean;                                     { TRUE=Append to log  FALSE=rewrite log file          }
  46.   BatchMode:            boolean;                                     { TRUE=Don't wait for a keypress at beginning         }
  47.   SuppressLog:          boolean;                                     { TRUE=Don't make a log file                          }
  48.   LogFile:              text;                                        { Log file handle, A2Z.LOG                            }
  49.   OldExitProc1:         pointer;                                     { Pointer to previous exit procedure routine.         }
  50.   OldSeg,OldOfs:        word;        { Old segment and offset for interrupt 29h handler }
  51.   OldExitProc2:         pointer;     { Holder for old exit proc }
  52.   Reg:                  Registers;   { Register storage for DOS calls }
  53.   CmdY:                 byte;        { Line the cursor's on in the bottom window }
  54.   BufData:              longint;     { Pointer to the text buffer }
  55.   BufferSeg:            word;        { Segment of the text buffer }
  56.   BufferOfs:            word;        { Offset  "  "   "    "      }
  57.   BufferPtr:            pointer;     { Pointer to the text buffer, in pointer format }
  58.   BufferLen:            word;        { Current length of text buffer }
  59.  
  60.   NumFiles:             word;         { Number of files to convert }
  61.   NumBytes:             longint;      { Number of bytes to convert }
  62.   FileNum:              word;         { Current file number        }
  63.   ConvertingInside:     boolean;      { TRUE=Converting internal arc files }
  64.   Saved:                longint;      { Total bytes saved so far }
  65.   TrickleUpError:       boolean;      { Error converting an internal file }
  66.   InternalCount:        byte;
  67.   InterruptRequested:   boolean;
  68.   WorkDir:              string;
  69.   StatusFile:           text;
  70.   StatusFileName:       string;
  71.  
  72.  
  73. function FileFound(F: ComStr): boolean;
  74. {
  75.   This returns TRUE if the file F exists, FALSE otherwise.  F can contain
  76.   wildcard characters.
  77. }
  78. var
  79.   SRec:                 SearchRec;
  80. begin
  81.   SRec.Name := '*';
  82.   FindFirst(F,0,SRec);
  83.   if SRec.Name='*' then FileFound := false else FileFound := true;
  84. end;
  85.  
  86. function ValidDir(D: string): boolean;
  87. var
  88.   T:  file;
  89. begin
  90.   Assign(T, D+'VALID!!!.A2Z');
  91.   {$I-}
  92.   Rewrite(T);
  93.   {$I+}
  94.   if IOResult<>0 then ValidDir := false
  95.   else begin
  96.     Close(T);
  97.     Erase(T);
  98.     ValidDir := true;
  99.   end;
  100. end;
  101.  
  102. procedure HaltWithMsg(M: string);
  103. {
  104.   Displays the message in M to the user and halts program execution.  Used
  105.   with critical errors.
  106. }
  107. begin
  108.   WriteLn(M);
  109.   Halt;
  110. end;
  111.  
  112.  
  113. procedure DisplayProgramHeader;
  114. {
  115.   Display program version number and credits.
  116. }
  117. begin
  118.   WriteLn;
  119.   WriteLn('A2Z - ARC/PAK to ZIP converter');
  120.   WriteLn('version 1.6 by Ian McLean');
  121.   WriteLn;
  122. end;
  123.  
  124.  
  125. procedure InvokeConfiguration;
  126. {
  127.   Configure A2Z by entering the paths for PKZIP, PKUNZIP, PKUNPAK, and PAK,
  128.   as well as a compression level for ASCII and binary files.  This information
  129.   is then stored in the executable for A2Z for future use.
  130. }
  131. var
  132.   A:                    file of byte;  { Temp variable for referencing A2Z.EXE }
  133.   L:                    longint;       { Location of search }
  134.   MatchUp:              byte;          { Number of bytes currently matched }
  135.   C:                    char;          { Character to match to }
  136. begin
  137.   DisplayProgramHeader;
  138.   if not FileFound('A2Z.EXE') then
  139.     HaltWithMsg('A2Z.EXE must be in the current directory when invoking configuration.');
  140.   repeat
  141.     WriteLn;
  142.     WriteLn('Enter the name and path for PKWARE''s PKZIP.EXE.  Please be sure to enter a');
  143.     WriteLn('path, filename, and extention:');
  144.     ReadLn(PKZIP);
  145.   until FileFound(PKZIP);
  146.   repeat
  147.     WriteLn;
  148.     WriteLn('Enter the name and path for PKWARE''s PKUNZIP.EXE.  Again, please include a');
  149.     WriteLn('path, filename, and extention:');
  150.     ReadLn(PKUNZIP);
  151.   until FileFound(PKUNZIP);
  152.   repeat
  153.     WriteLn;
  154.     WriteLn('Enter the name and path for PKWARE''s PKUNPAK.EXE:  (Do I need to remind you to');
  155.     WriteLn('include a path, name, and extention?)');
  156.     ReadLn(PKUNPAK);
  157.   until FileFound(PKUNPAK);
  158.   repeat
  159.     WriteLn;
  160.     WriteLn('If you have .PAK files to convert, enter the name and path for NoGate');
  161.     WriteLn('Consulting''s PAK.EXE; otherwise just press enter:  (Don''t forget to');
  162.     WriteLn('include...)');
  163.     ReadLn(PAK);
  164.   until (PAK='') or FileFound(PAK);
  165.   WriteLn;
  166.   Write('Compression level for binary files: ');
  167.   repeat
  168.     repeat until KeyPressed;
  169.     BinaryLevel := ReadKey;
  170.   until BinaryLevel in ['1'..'4'];
  171.   WriteLn(BinaryLevel);
  172.   Write('Compression level for ASCII files:  ');
  173.   repeat
  174.     repeat until KeyPressed;
  175.     AsciiLevel := ReadKey;
  176.   until AsciiLevel in ['1'..'4'];
  177.   WriteLn(AsciiLevel);
  178.   WriteLn;
  179.   Assign(A, 'A2Z.EXE');      { Configuration information is written to A2Z.EXE, }
  180.   Reset(A);                  { overlaying what was in the CONST block previously }
  181.   L := FileSize(A)-1;   { Search starting at EOF, as constants are usually found there }
  182.   MatchUp := 10;      { First character to match is the fifth of the string CONFIGNEXT }
  183.   repeat
  184.     Seek(A, L);          { Read character from file }
  185.     Read(A, byte(C));
  186.     Dec(L);              { Decrement counter (search backwards) }
  187.     case MatchUp of
  188.       10:  if C=DataNext[MatchUp] then Dec(MatchUp); { If the character matches, we need to match the next one, otherwise we}
  189.       else if C=DataNext[MatchUp] then Dec(MatchUp) else MatchUp := 10; { need to match the tenth next (string wasn't correct)}
  190.     end;
  191.   until (MatchUp=0) or (L=0);  { Repeat this until string found (Matchup=0) or we're at start of file }
  192.   if MatchUp<>0 then
  193.     HaltWithMsg('Unable to find configuration data area.  Corrupted A2Z.EXE!');
  194.   Seek(A, L+12);   { Seek the configuration information block }
  195.   for L := 0 to 321 do Write(A, Mem[seg(PKZIP):ofs(PKZIP)+L]);  { Write the Directory/filenames and compression levels }
  196.   Close(A);
  197.   HaltWithMsg('A2Z is now configured for use.');
  198. end;
  199. { End of procedure InvokeConfiguration }
  200.  
  201.  
  202. procedure ShowInvokation;
  203. {
  204.   Display program information and the invokation parameters for A2Z, then
  205.   halt the program.
  206. }
  207. begin
  208.   DisplayProgramHeader;
  209.   WriteLn('A2Z [/C] [/Z] [/A] [/B] [/S=device] [/W=dir] [filespec] [!filespec]');
  210.   WriteLn;
  211.   WriteLn('/C          Invoke configuration');
  212.   WriteLn('/Z          Search ZIP files for imbedded ARC/PAK files and process');
  213.   WriteLn('/A          Append to log file, if it exists, instead of overwriting');
  214.   WriteLn('/B          Batch mode.  Don''t pause for a keypress at beginning');
  215.   WriteLn('/N          Create no log file.');
  216.   WriteLn('/S=[device] Set the status display device (eg: /S=COM1).  Default is NUL');
  217.   WriteLn('/W=[dir]    Set the work directory to [dir].  Default is current directory or');
  218.   WriteLn('            value set by the environment variable A2ZWORK.');
  219.   WriteLn;
  220.   WriteLn('[filespec]  Directory name or search specification of files to convert.  If');
  221.   WriteLn('            there''s an ! before the name, subdirectories of the one specified');
  222.   WriteLn('            are searched.  Up to twenty path names may be entered.');
  223.   WriteLn;
  224.   WriteLn('Examples:');
  225.   WriteLn('A2Z !C:\ !D:\ /Z        Convert all dirs on drives C: and D:, search ZIPs');
  226.   WriteLn('                        for imbedded ARC/PAKs');
  227.   WriteLn('A2Z FOOBAR.ARC          Convert the file FOOBAR.ARC to a ZIP');
  228.   WriteLn('A2Z C:\*.PAK            Convert all PAK files in dir C:\ to ZIPs');
  229.   Halt;
  230. end;
  231.  
  232.  
  233. procedure ReadCommandLine;
  234. {
  235.   Read the parameters entered at the command line and build the list of
  236.   directories to convert.  Check for configuration and show invokation if
  237.   necessary.
  238. }
  239.  
  240.   procedure ParseParameter(S: string);
  241.   {
  242.     Parse the parameter in S.
  243.   }
  244.   var
  245.     D:                  DirStr;    { Temp holders for path name, etc }
  246.     N:                  NameStr;
  247.     E:                  ExtStr;
  248.   begin
  249.     if S[1]='/' then
  250.       case upcase(S[2]) of
  251.         'C':  InvokeConfiguration;
  252.         'Z':  SearchZips := true;
  253.         'A':  AppendLog := true;
  254.         'B':  BatchMode := true;
  255.         'N':  SuppressLog := true;
  256.         'W':  begin
  257.                 if (length(S)<5) or (S[3]<>'=') then ShowInvokation;
  258.                 WorkDir := copy(S,4,255);
  259.               end;
  260.         'S':  begin
  261.                 if (length(S)<4) or (S[3]<>'=') then ShowInvokation;
  262.                 StatusFileName := copy(S,4,255);
  263.               end;
  264.         else ShowInvokation;
  265.       end
  266.     else begin
  267.       Inc(NumDirs);
  268.       with Dir[NumDirs] do
  269.       begin
  270.         if S[1]='!' then
  271.         begin
  272.           S := copy(S,2,255);
  273.           Below := true;
  274.         end
  275.         else Below := false;
  276.         if S[length(S)]<>'\' then
  277.           if (not FileFound(S)) and (FileFound(S+'\*.*')) then S := S+'\';
  278.         FSplit(FExpand(S), D,N,E);
  279.         if N='' then N := '*';
  280.         if (E='') or (E='.') then E := '.*';
  281.         Dir := D;
  282.         Name := N+E;
  283.       end;
  284.     end;
  285.   end;
  286.  
  287. var
  288.   L:                    byte;  { Loop variable }
  289.  
  290. begin
  291.   SearchZips := false;
  292.   AppendLog := false;
  293.   BatchMode := false;
  294.   SuppressLog := false;
  295.   WorkDir := GetEnv('A2ZWORK');
  296.   StatusFileName := 'NUL';
  297.   NumDirs := 0;
  298.   if ParamCount=0 then ShowInvokation;
  299.   for L := 1 to ParamCount do ParseParameter(ParamStr(L));
  300.   if NumDirs=0 then ShowInvokation;
  301.   if WorkDir='' then GetDir(0,WorkDir);
  302.   WorkDir := FExpand(WorkDir);
  303.   if WorkDir[length(WorkDir)]<>'\' then WorkDir := WorkDir+'\';
  304.   if not ValidDir(WorkDir) then HaltWithMsg('Invalid work directory specified.');
  305.   Assign(StatusFile, StatusFileName);
  306.   {$I-}
  307.   Rewrite(StatusFile);
  308.   {$I+}
  309.   if IOResult<>0 then
  310.   begin
  311.     WriteLn('Unable to open specified status file.');
  312.     Assign(StatusFile, 'NUL');
  313.     Rewrite(StatusFile);
  314.   end
  315.   else WriteLn(StatusFile, 'A2Z v1.6 by Ian McLean');
  316. end;
  317. { End of procedure ReadCommandLine }
  318.  
  319. procedure NewExitProc1;
  320. {
  321.   This exit procedure closes the log file.
  322. }
  323. begin
  324.   if not SuppressLog then Close(LogFile);
  325.   Close(StatusFile);
  326.   ExitProc := OldExitProc1;
  327. end;
  328.  
  329. procedure CheckSubPrograms;
  330. begin
  331.   if PKZIP='UNCONFIGURED' then InvokeConfiguration;
  332.   if not (FileFound(PKZIP) and FileFound(PKUNZIP) and FileFound(PKUNPAK) and
  333.   (FileFound(PAK) or (PAK=''))) then
  334.   begin
  335.     WriteLn;
  336.     WriteLn('** Invalid program paths in configuration **');
  337.     InvokeConfiguration;
  338.   end;
  339. end;
  340.  
  341. procedure OpenLogFile;
  342. {
  343.   Open the file A2Z.LOG in the current directory.  If it exists, append to it.
  344.   Place a date/time stamp on it, too, just for the heck of it.  Also sets up
  345.   an exit procedure to close the file.  If AppendLog is true, we'll append
  346.   to the log, otherwise we'll rewrite it.
  347. }
  348.  
  349.   function DateString: string;
  350.   {
  351.     Returns the current date in a string of the form:  MON ## YEAR.
  352.     E.g, 21 Feb 1989 or 02 Jan 1988.
  353.   }
  354.   const
  355.     Month:              array[1..12] of string[3]=
  356.                         ('Jan','Feb','Mar','Apr','May','Jun',
  357.                          'Jul','Aug','Sep','Oct','Nov','Dec');
  358.   var
  359.     Y,M,D,Junk:         word;
  360.     DS,YS:              string[5];
  361.   begin
  362.     GetDate(Y,M,D,Junk);
  363.     Str(Y,YS);
  364.     Str(D,DS);
  365.     if length(DS)<2 then DS := '0'+DS;
  366.     DateString := DS+' '+Month[M]+' '+YS;
  367.   end;
  368.  
  369.   function TimeString: string;
  370.   {
  371.     Returns the current time in the form:  HH:MM am/pm
  372.     E.g, 12:00 am or 09:12 pm.
  373.   }
  374.   var
  375.     H,M,Junk:           word;
  376.     HS,MS:              string[5];
  377.     Am:                 boolean;
  378.   begin
  379.     GetTime(H,M,Junk,Junk);
  380.     case H of
  381.       0:     begin
  382.                Am := true;
  383.                H := 12;
  384.              end;
  385.       1..11: Am := true;
  386.       12:    Am := false;
  387.       else   begin
  388.                Am := false;
  389.                H := H-12;
  390.              end;
  391.     end;
  392.     Str(H,HS);
  393.     Str(M,MS);
  394.     if length(HS)<2 then HS := '0'+HS;
  395.     if length(MS)<2 then MS := '0'+MS;
  396.     if Am then TimeString := HS+':'+MS+' am'
  397.     else TimeString := HS+':'+MS+' pm';
  398.   end;
  399.  
  400. begin
  401.   if not SuppressLog then
  402.   begin
  403.     Assign(LogFile, 'A2Z.LOG');
  404.     {$I-}
  405.     if AppendLog then Append(LogFile) else Rewrite(LogFile);
  406.     {$I+}
  407.     if IOResult<>0 then Rewrite(LogFile);
  408.     WriteLn(LogFile);
  409.     WriteLn(LogFile, DateString+' '+TimeString);
  410.     WriteLn(LogFile, '--------------------');
  411.   end;
  412.   OldExitProc1 := ExitProc;
  413.   ExitProc := @NewExitProc1;
  414. end;
  415. { End procedure OpenLogFile }
  416.  
  417. procedure LogError(E: string);
  418. {
  419.   Write the message in string E to the screen and to the log file.
  420. }
  421. begin
  422.   WriteLn(E);
  423.   if not SuppressLog then WriteLn(LogFile, E);
  424. end;
  425.  
  426. procedure WriteStatus(M: string);
  427. begin
  428.   Write(StatusFile,M);
  429. end;
  430.  
  431. procedure WriteLnStatus(M: string);
  432. {
  433.   Write the message in M to the status device, with linefeed.
  434. }
  435. begin
  436.   WriteLn(StatusFile,M);
  437. end;
  438.  
  439.  
  440. (********* The following search engine routines are sneakly swiped *********)
  441. (********* from Turbo Technix v1n6.  See there for further details *********)
  442.  
  443. type
  444.   ProcType=             procedure(var S: SearchRec; P: PathStr);
  445.  
  446. var
  447.   EngineMask:           FullNameStr;
  448.   EngineAttr:           byte;
  449.   EngineProc:           ProcType;
  450.   EngineCode:           byte;
  451.  
  452. function ValidExtention(var S: SearchRec): boolean;
  453. var
  454.   Junk:                 string;
  455.   E:                    ExtStr;
  456. begin
  457.   if S.Attr and Directory=Directory then
  458.   begin
  459.     ValidExtention := true;
  460.     exit;
  461.   end;
  462.   FSplit(S.Name,Junk,Junk,E);
  463.   if (E='.ARC') or (E='.PAK') or (SearchZips and (E='.ZIP')) then
  464.   ValidExtention := true else ValidExtention := false;
  465. end;
  466.  
  467. procedure SearchEngine(Mask: PathStr; Attr: byte; Proc: ProcType;
  468.                        var ErrorCode: byte);
  469. var
  470.   S:                    SearchRec;
  471.   P:                    PathStr;
  472.   Ext:                  ExtStr;
  473. begin
  474.   FSplit(Mask, P, Mask, Ext);
  475.   Mask := Mask+Ext;
  476.   FindFirst(P+Mask,Attr,S);
  477.   if DosError<>0 then
  478.   begin
  479.     ErrorCode := DosError;
  480.     exit;
  481.   end;
  482.   while DosError=0 do
  483.   begin
  484.     if ValidExtention(S) then Proc(S, P);
  485.     FindNext(S);
  486.   end;
  487.   if DosError=18 then ErrorCode := 0
  488.   else ErrorCode := DosError;
  489. end;
  490.  
  491. function GoodDirectory(S: SearchRec): boolean;
  492. begin
  493.   GoodDirectory := (S.name<>'.') and (S.Name<>'..') and
  494.   (S.Attr and Directory=Directory);
  495. end;
  496.  
  497. procedure SearchOneDir(var S: SearchRec; P: PathStr);
  498. begin
  499.   if GoodDirectory(S) then
  500.   begin
  501.     P := P+S.Name;
  502.     SearchEngine(P+'\'+EngineMask,EngineAttr,EngineProc,EngineCode);
  503.     SearchEngine(P+'\*.*',Directory or Archive, SearchOneDir,EngineCode);
  504.   end;
  505. end;
  506.  
  507. procedure SearchEngineAll(Path: PathStr; Mask: FullNameStr; Attr: byte;
  508.                           Proc: ProcType; var ErrorCode: byte);
  509. begin
  510.   EngineMask := Mask;
  511.   EngineProc := Proc;
  512.   EngineAttr := Attr;
  513.   SearchEngine(Path+Mask,Attr,Proc,ErrorCode);
  514.   SearchEngine(Path+'*.*',Directory or Archive,SearchOneDir,ErrorCode);
  515.   ErrorCode := EngineCode;
  516. end;
  517.  
  518. (************** Thus ends the sneakly swiped code *************)
  519. (**** We now return you to our regularly scheduled program ****)
  520.  
  521.  
  522. procedure AddToEstimate(var S: SearchRec; P: PathStr);
  523. {
  524.   Called by the search engine, adds the information in S to the file estimates
  525.   NumFiles and NumBytes.  Displays the filename temporaraly, too.
  526. }
  527. var
  528.   X:                    byte;
  529. begin
  530.   Inc(NumFiles);
  531.   Inc(NumBytes,S.Size);
  532.   X := WhereX;
  533.   ClrEol;
  534.   Write(S.Name);
  535.   GotoXY(X,WhereY);
  536. end;
  537.  
  538. procedure GetFileEstimates;
  539. {
  540.   Estimate the number of bytes and number of files to convert.
  541. }
  542. var
  543.   L:                    byte;
  544.   ErrorCode:            byte;
  545. begin
  546.   DisplayProgramHeader;
  547.   WriteLn('Searching directories...');
  548.   WriteLn;
  549.   NumFiles := 0;
  550.   NumBytes := 0;
  551.   for L := 1 to NumDirs do
  552.   with Dir[L] do
  553.   begin
  554.     Write(Dir);
  555.     if Below then SearchEngineAll(Dir,Name,Archive,AddToEstimate,ErrorCode)
  556.        else SearchEngine(Dir+Name,Archive,AddToEstimate,ErrorCode);
  557.     ClrEol;
  558.     WriteLn;
  559.   end;
  560.   WriteLn;
  561.   Write(NumBytes,' bytes in ',NumFiles,' file(s) to ');
  562.   if SearchZips then WriteLn('convert/examine.')
  563.   else WriteLn('convert.');
  564.   WriteLn;
  565.   if NumFiles=0 then HaltWithMsg('No files to convert!');
  566.   if not BatchMode then
  567.   begin
  568.     WriteLn('Press any key...');
  569.     repeat until KeyPressed;
  570.   end;
  571.   while KeyPressed do char(L) := ReadKey;
  572. end;
  573. { End of procedure GetFileEstimates }
  574.  
  575.  
  576. procedure IPP;
  577. { Interrupt pre-processor.  This is a new handler for interrupt 29h which
  578.   provides special functions.  See comments in IHAND.ASM}
  579. interrupt;
  580. begin
  581.   InLine(
  582.       $06/                   {          push    es                      }
  583.       $1E/                   {          push    ds                      }
  584.       $53/                   {          push    bx                      }
  585.       $57/                   {          push    di                      }
  586.       $BB/$3F/$3F/           {          mov     bx, 3f3fh               }
  587.       $8E/$C3/               {          mov     es, bx                  }
  588.       $BB/$3F/$3F/           {          mov     bx, 3f3fh               }
  589.       $26/$8B/$3F/           {          mov     di, word ptr [es:bx]    }
  590.       $26/$8E/$5F/$02/       {          mov     ds, word ptr [es:bx+2]  }
  591.       $88/$05/               {          mov     byte ptr [di], al       }
  592.       $26/$FF/$07/           {          inc     word ptr [es:bx]        }
  593.       $5F/                   {          pop     di                      }
  594.       $5B/                   {          pop     bx                      }
  595.       $1F/                   {          pop     ds                      }
  596.       $07/                   {          pop     es                      }
  597.       $3C/$0A/               {          cmp     al, 10                  }
  598.       $75/$28/               {          jne     looper                  }
  599.       $50/                   {          push    ax                      }
  600.       $52/                   {          push    dx                      }
  601.       $51/                   {          push    cx                      }
  602.       $53/                   {          push    bx                      }
  603.       $B4/$03/               {          mov     ah, 3                   }
  604.       $B7/$00/               {          mov     bh, 0                   }
  605.       $CD/$10/               {          int     10h                     }
  606.       $80/$FE/$18/           {          cmp     dh, 24                  }
  607.       $75/$15/               {          jne     popper                  }
  608.       $FE/$CE/               {          dec     dh                      }
  609.       $B7/$00/               {          mov     bh, 0                   }
  610.       $B4/$02/               {          mov     ah, 2                   }
  611.       $CD/$10/               {          int     10h                     }
  612.       $B8/$01/$06/           {          mov     ax, 0601h               }
  613.       $B7/$07/               {          mov     bh, 7                   }
  614.       $B9/$00/$11/           {          mov     cx, 1100h               }
  615.       $BA/$4F/$18/           {          mov     dx, 184fh               }
  616.       $CD/$10/               {          int     10h                     }
  617.       $5B/                   {  popper: pop     bx                      }
  618.       $59/                   {          pop     cx                      }
  619.       $5A/                   {          pop     dx                      }
  620.       $58/                   {          pop     ax                      }
  621.       $9C/                   {  looper: pushf                           }
  622.       $9A/$00/$00/$00/$00/   {          call    far [0:0]               }
  623.       $CF);                  {          iret                            }
  624. end;
  625.  
  626.  
  627. procedure NewExitProc2;
  628. { This exit procedure removes the interrupt 29h handler from memory and places
  629.   the cursor at the bottom of the screen. }
  630. begin
  631.   Reg.AH := $25;
  632.   Reg.AL := $29;
  633.   Reg.DS := OldSeg;
  634.   Reg.DX := OldOfs;
  635.   MsDos(Reg);
  636.   Window(1,1,80,25);
  637.   GotoXY(1,24);
  638.   TextAttr := $07;
  639.   ClrEol;
  640.   WriteLn('Thank you for using A2Z!');
  641.   ExitProc := OldExitProc2;
  642. end;
  643.  
  644. procedure ResetBuffer;
  645. { Reset pointers to the text buffer, effectivly deleting any text in it }
  646. begin
  647.   MemW[seg(BufData):ofs(BufData)] := BufferOfs;    { Set first 2 bytes of BufData to point to buffer offset }
  648.   MemW[seg(BufData):ofs(BufData)+2] := BufferSeg;  { And next two bytes to point to buffer segment }
  649.   MemW[seg(IPP):ofs(IPP)+21] := seg(BufData);    { Now point the interrupt routine to BufData for pointer }
  650.   MemW[seg(IPP):ofs(IPP)+26] := ofs(BufData);    {  to the text buffer }
  651. end;
  652.  
  653. function BufSize: word;
  654. { This returns the number of characters in the text buffer.  It's what BufData
  655.   now points to minus what is origionally pointed to, eg, the number of times
  656.   IPP incremented it }
  657. begin
  658.   BufSize := MemW[seg(BufData):ofs(BufData)]-BufferOfs;
  659. end;
  660.  
  661. function InBuffer(S: string): integer;
  662. { This searched the text buffer for the string S, and if it's found returns
  663.   the offset in the buffer.  If it's not found a -1 is returned }
  664. var
  665.   L,M:                  word;
  666.   X:                    byte;
  667. begin
  668.   X := 1;
  669.   L := BufferOfs;
  670.   M := BufSize;
  671.   while (X<=length(S)) and (L<=M) do
  672.   begin
  673.     if Mem[BufferSeg:L]=byte(S[X]) then Inc(X) else X := 1;
  674.     Inc(L);
  675.   end;
  676.   if X>length(S) then InBuffer := L-length(S) else InBuffer := -1;
  677. end;
  678.  
  679. procedure InstallInterruptHandler;
  680. { Installs the int 29h handler }
  681. begin
  682.   BufferLen := $4000;  { Set up a 16k buffer }
  683.   GetMem(BufferPtr,BufferLen);  { Allocate memory pointed at by BufferPtr }
  684.   BufferSeg := seg(BufferPtr^);  { Read segment and offset of buffer for easy access }
  685.   BufferOfs := ofs(BufferPtr^);
  686.   ResetBuffer;    { Place these values in the IPP routine, resetting buffer }
  687.   Reg.AH := $35;
  688.   Reg.AL := $29;  { DOS service 35h, get interrupt vector for 29h }
  689.   MsDos(Reg);
  690.   OldSeg := Reg.ES;   { Store the segment and offset of the old vector for later use }
  691.   OldOfs := Reg.BX;
  692.   MemW[seg(IPP):ofs(IPP)+90] := Reg.BX;  { And store them so IPP can call the routine }
  693.   MemW[seg(IPP):ofs(IPP)+92] := Reg.ES;
  694.   Reg.AL := $29; { DOS service 25h, set interrupt vector 29h }
  695.   Reg.AH := $25;
  696.   Reg.DS := seg(IPP);    { Store segment and offset for IPP.  The +16 is to skip TP stack }
  697.   Reg.DX := ofs(IPP)+16; { maintainence routines }
  698.   MsDos(Reg);
  699.   OldExitProc2 := ExitProc;     { Set up new exit procedure to remove routine at program termination }
  700.   ExitProc := @NewExitProc2;
  701.   TextAttr := $07;   { Clear the screen to white on black }
  702.   ClrScr;
  703.   GotoXY(1,15);      { Go to line 15 and 16 and draw an inverse bar which will show the }
  704.   TextAttr := $70;   { current command being executed. }
  705.   Write('DOS COMMAND:');
  706.   ClrEol;
  707.   WriteLn;
  708.   ClrEol;
  709.   TextAttr := $07;    { Set text color back to white on black }
  710.   Window(1,1,80,13);  { Make active window at top of screen and home cursor }
  711.   GotoXY(1,1);
  712.   CmdY := 18;   { Assume the cursor in the lower window's at the top of window }
  713. end;
  714.  
  715. procedure ExecCommand(Cmd,Parm: string);
  716. { Executes the command in Cmd with command line parameters in Parm.  This is
  717.   executed in the lower window }
  718. var
  719.   OX,OY: byte;  { Upper window X and Y }
  720. begin
  721.   ResetBuffer;  { Clear text buffer }
  722.   OX := WhereX;  { Store upper window X and Y }
  723.   OY := WhereY;
  724.   Window(1,1,80,25);  { Make entire screen active window }
  725.   GotoXY(14,15);      { Go to line 14 (COMMAND bar) }
  726.   TextAttr := $70;
  727.   Write(Cmd,' ',Parm);  { Write the command and parameters in inverse }
  728.   GotoXY(1,CmdY);     { Go to location in bottom window }
  729.   TextAttr := $07;    { Normal text color }
  730.   Exec(Cmd,Parm);     { Execute command }
  731.   CmdY := WhereY;     {  Store new Y location }
  732.   GotoXY(14,15);
  733.   TextAttr := $70;    { Erase the COMMAND bar }
  734.   ClrEol;
  735.   WriteLn;
  736.   ClrEol;
  737.   TextAttr := $07;
  738.   Window(1,1,80,13);   { Reset the upper window }
  739.   GotoXY(OX,OY);       { Re-position cursor }
  740. end;
  741.  
  742. function ArchiveBad: boolean;
  743. {
  744.   Returns true if there are any text strings in the buffer that would
  745.   indicate a bad archive
  746. }
  747. begin
  748.   if (InBuffer('error in')<>-1) or (InBuffer('Insufficent Memory')<>-1) or
  749.      (InBuffer('Disk full')<>-1) or (InBuffer('Unknown comp')<>-1) or
  750.      (InBuffer('CRC check')<>-1) or (InBuffer('run-time')<>-1) then
  751.   ArchiveBad := true else ArchiveBad := false;
  752. end;
  753.  
  754. function PakBad: boolean;
  755. {
  756.   Returns true if there are any PAK errors in the buffer.
  757. }
  758. begin
  759.   if (InBuffer('Could not open')<>-1) or (InBuffer('Unknown')<>-1) or
  760.      (InBuffer('CRC ')<>-1) or (InBuffer('Unable')<>-1) then
  761.   PakBad := true else PakBad := false;
  762. end;
  763.  
  764. function ZipBad: boolean;
  765. {
  766.   Same as above two routines, except that this checks the output that PKZIP
  767.   would have made
  768. }
  769. begin
  770.   if (InBuffer('can''t create')<>-1) or (InBuffer('disk full')<>-1) or
  771.      (InBuffer('memory ')<>-1) or (InBuffer('run-time')<>-1) then
  772.      ZipBad := true else ZipBad := false;
  773. end;
  774.  
  775. function InternalInZip: boolean;
  776. begin
  777.   if (InBuffer('.ARC')<>-1) or (InBuffer('.PAK')<>-1) or
  778.      (InBuffer('.ZIP'#13#10' ')<>-1) or
  779.      (InBuffer('.ZIP'#13#10'-')<>-1) then InternalInZip := true else
  780.      InternalInZip := false;
  781. end;
  782.  
  783. function ZipViewBad: boolean;
  784. begin
  785.   if (InBuffer('memory ')<>-1) or (InBuffer('run-time')<>-1) or
  786.      (InBuffer('ZipRecover')<>-1) or (InBuffer('I don''t')<>-1) or
  787.      (InBuffer('inconsistant local')<>-1) then ZipViewBad := true
  788.      else ZipViewBad := false;
  789. end;
  790.  
  791. function UnZipBad: boolean;
  792. begin
  793.   if ZipBad or
  794.      (InBuffer('Warning!')<>-1) or (InBuffer('can''t')<>-1) or
  795.      (InBuffer('in ZIP')<>-1) then UnZipBad := true
  796.      else UnZipBad := false;
  797. end;
  798.  
  799. var
  800.   X:                    integer;
  801.   L:                    string[60];
  802.   C:                    string[10];
  803.   Code:                 integer;
  804.   Okay:                 boolean;
  805.   T:                    text;
  806.   SRec:                 SearchRec;
  807.   Z:                    ComStr;
  808.   EC:                   byte;
  809.   RC:                   char;
  810.   CurWork:              string;
  811.  
  812. procedure Convert(var S: SearchRec; P: PathStr);
  813.  
  814.   procedure Indent;
  815.   var
  816.     L:                  byte;
  817.   begin
  818.     for L := 1 to InternalCount do Write('  ');
  819.   end;
  820.  
  821.   procedure ArchiveError(N: string);
  822.   {
  823.     Report an archive error if we're working with the top file, otherwise
  824.     set an error flag.
  825.   }
  826.   begin
  827.     if ConvertingInside then
  828.     begin
  829.       Indent;
  830.       WriteLn(N);
  831.       TrickleUpError := true;
  832.     end
  833.     else LogError(N);
  834.   end;
  835.  
  836.   procedure DeleteDir(P: string);
  837.   {
  838.     Delete all files in the directory named and remove it.
  839.   }
  840.   var
  841.     SRec:               SearchRec;
  842.     ErrorCode:          byte;
  843.   begin
  844.     FindFirst(P+'\*.*',0,SRec);
  845.     while DosError=0 do
  846.     begin
  847.       Assign(T, P+'\'+SRec.Name);
  848.       {$I-}
  849.       Erase(T);
  850.       {$I+}
  851.       ErrorCode := IOResult;
  852.       FindNext(SRec);
  853.     end;
  854.     {$I-}
  855.     RmDir(P);
  856.     {$I+}
  857.     ErrorCode := IOResult;
  858.   end;
  859.  
  860.   procedure CopyFile(SourceName,DestName: ComStr);
  861.   var
  862.     Source,Dest:           file;
  863.     RecsRead:              word;
  864.     Buffer:                pointer;
  865.     BufSize:               word;
  866.     T:                     longint;
  867.   begin
  868.     if MaxAvail>65535 then BufSize := 65535 else BufSize := MaxAvail;
  869.     BufSize := BufSize div 1024;
  870.     GetMem(Buffer, BufSize*1024);
  871.     Assign(Source, SourceName);
  872.     Reset(Source,1024);
  873.     Assign(Dest,DestName);
  874.     Rewrite(Dest,1024);
  875.     for T := 1 to FileSize(Source) do
  876.     begin
  877.       BlockRead(Source,Buffer^,BufSize,RecsRead);
  878.       BlockWrite(Dest,Buffer^,RecsRead);
  879.     end;
  880.     T := FileSize(Source)*1024;
  881.     Reset(Source,1);
  882.     Reset(Dest,1);
  883.     Seek(Source,T);
  884.     Seek(Dest,T);
  885.     repeat
  886.       BlockRead(Source,Buffer^,BufSize*1024,RecsRead);
  887.       BlockWrite(Dest,Buffer^,RecsRead);
  888.     until RecsRead=0;
  889.     GetFTime(Source, T);
  890.     SetFTime(Dest, T);
  891.     Close(Source);
  892.     Close(Dest);
  893.     FreeMem(Buffer, BufSize*1024);
  894.     Erase(Source);
  895.   end;
  896.  
  897.   function IndentSpaces: string;
  898.   var
  899.     S:  string;
  900.     L:  byte;
  901.   begin
  902.     S := '';
  903.     for L := 1 to InternalCount do S := S+'  ';
  904.     IndentSpaces := S;
  905.   end;
  906.  
  907. var
  908.   N:                    NameStr;
  909.   E:                    ExtStr;
  910.   ArcComment:           string[50];
  911.   FilesInArc:           word;
  912.   UnArcedSize:          longint;
  913.   ArcedSize:            longint;
  914.   OCI:                  boolean;
  915. begin
  916.   if TrickleUpError then exit;
  917.   if KeyPressed then
  918.   begin
  919.     RC := ReadKey;
  920.     if RC=#27 then
  921.     begin
  922.       if ConvertingInside then
  923.       begin
  924.         TrickleUpError := true;
  925.         InterruptRequested := true;
  926.         exit;
  927.       end
  928.       else begin
  929.         LogError('*** Conversion interrupted ***');
  930.         WriteLnStatus('**** Conversion interrupted ***');
  931.         Halt;
  932.       end;
  933.     end;
  934.   end;
  935.   FSplit(P+S.Name,P,N,E);
  936.   WriteLnStatus(IndentSpaces+'Converting '+S.Name);
  937.   if not ConvertingInside then
  938.   begin
  939.     Inc(FileNum);
  940.     WriteLn;
  941.     WriteLnStatus('');
  942.     TextAttr := $0F;
  943.     WriteLn('Converting ',P+S.Name,'  Saved: ',Saved,' bytes  File: ',FileNum,' of ',NumFiles);
  944.     TextAttr := $07;
  945.   end
  946.   else begin
  947.     Indent;
  948.     TextAttr := $0F;
  949.     WriteLn('Converting internal file ',N,E);
  950.     WriteLnStatus(IndentSpaces+'Converting internal file '+N+E);
  951.     TextAttr := $07;
  952.   end;
  953.   if E='.ZIP' then
  954.   begin
  955.     Indent;
  956.     Write('Checking ',N,E,' for internal files...');
  957.     WriteStatus(IndentSpaces+'Checking '+S.Name+' for internal files...');
  958.     ExecCommand(PKZIP,'/V '+P+N);
  959.     if ZipViewBad then
  960.     begin
  961.       WriteLn;
  962.       ArchiveError('Error in ZIPfile '+P+N+E+'; file skipped.');
  963.       WriteLnStatus(' Error in ZIPfile; file skipped.');
  964.       exit;
  965.     end;
  966.     ArcedSize := S.Size;
  967.     if InternalInZIP then
  968.     begin
  969.       WriteLn(' found.');
  970.       WriteLnStatus(' found.');
  971.       X := InBuffer('Searching');
  972.       if X=-1 then
  973.       begin
  974.         ArchiveError('Error in Zipfile '+P+N+E+'; file skipped.');
  975.         WriteLnStatus(IndentSpaces+'Error in Zipfile '+N+E+'; file skipped.');
  976.         exit;
  977.       end;
  978.       ArcComment := '';
  979.       X := X+15;
  980.       repeat
  981.         Inc(X);
  982.       until char(Mem[BufferSeg:X]) in [' ',#13,#10];
  983.       if char(Mem[BufferSeg:X])=' ' then
  984.       begin
  985.         repeat
  986.           Inc(X);
  987.         until char(Mem[BufferSeg:X])=' ';
  988.         Inc(X);
  989.         repeat
  990.           ArcComment := ArcComment+char(Mem[BufferSeg:X]);
  991.           Inc(X);
  992.         until char(Mem[BufferSeg:X]) in [#10,#13];
  993.       end;
  994.       while ArcComment[length(ArcComment)]=' ' do Dec(ArcComment[0]);
  995.       L := '';
  996.       X := InBuffer('--------'+#13+#10);
  997.       if X=-1 then
  998.       begin
  999.         ArchiveError('Error in Zipfile '+P+N+E+'; file skipped.');
  1000.         WriteLnStatus(IndentSpaces+'Error in Zipfile '+N+E+'; file skipped.');
  1001.         exit;
  1002.       end;
  1003.       repeat
  1004.         Inc(X);
  1005.       until char(Mem[BufferSeg:X]) in ['0'..'9'];
  1006.       repeat
  1007.         L := L+char(Mem[BufferSeg:X]);
  1008.         Inc(X);
  1009.       until char(Mem[BufferSeg:X]) in [#10,#13];
  1010.       C := '';
  1011.       repeat
  1012.         C := C+L[1];
  1013.         L := copy(L,2,255);
  1014.       until L[1]=' ';
  1015.       while L[1]=' ' do L := copy(L,2,255);
  1016.       Val(C,UnarcedSize,Code);
  1017.       C := '';
  1018.       repeat
  1019.         C := C+L[1];
  1020.         L := copy(L,2,255);
  1021.       until L[1]=' ';
  1022.       while L[1]=' ' do L := copy(L,2,255);
  1023.       while L[1]<>' ' do L := copy(L,2,255);
  1024.       while L[1]=' ' do L := copy(L,2,255);
  1025.       Val(C,ArcedSize,Code);
  1026.       Val(L,FilesInArc,Code);
  1027.       Indent;
  1028.       ArcedSize := S.Size;
  1029.       WriteLn(FilesInArc,' files(s), ',ArcedSize,' bytes zipped, ',UnArcedSize,' bytes unzipped');
  1030.       Str(FilesInArc,Z);
  1031.       Str(ArcedSize,L);
  1032.       Str(UnarcedSize,C);
  1033.       WriteLnStatus(IndentSpaces+Z+' file(s), '+L+' bytes zipped, '+C+' bytes unzipped');
  1034.       if ArcComment<>'' then
  1035.       begin
  1036.         Indent;
  1037.         WriteLn('Zipfile comment: "',ArcComment,'"');
  1038.         WriteLnStatus(IndentSpaces+'Zipfile comment: "'+ArcComment+'"');
  1039.       end;
  1040.       Indent;
  1041.       Write('Unzipping ',N,E,'...');
  1042.       WriteStatus(IndentSpaces+'Unzipping '+N+E+'...');
  1043.       CurWork := CurWork+'\A2Z.$$$';
  1044.       MkDir(CurWork);
  1045.       ExecCommand(PKUNZIP,P+N+' '+CurWork);
  1046.       if UnZipBad then
  1047.       begin
  1048.         DeleteDir(CurWork);
  1049.         Dec(CurWork[0],8);
  1050.         WriteLn;
  1051.         ArchiveError('Error unzipping '+P+N+E+'; file skipped.');
  1052.         WriteLnStatus('');
  1053.         WriteLnStatus(IndentSpaces+'Error unzipping '+N+E+'; file skipped.');
  1054.         exit;
  1055.       end;
  1056.       WriteLn(' done.');
  1057.       WriteLnStatus(' done.');
  1058.     end
  1059.     else
  1060.     begin
  1061.       WriteLn(' none found.');
  1062.       WriteLnStatus(' none found.');
  1063.       ArchiveError(N+E+' did not need to be modified.');
  1064.       WriteLnStatus(IndentSpaces+N+E+' did not need to be modified.');
  1065.       TrickleUpError := false;
  1066.       exit;
  1067.     end;
  1068.   end
  1069.   else begin
  1070.     Indent;
  1071.     Write('Analyzing ',N,E,'...');
  1072.     WriteStatus(IndentSpaces+'Analyzing '+N+E+'...');
  1073.     ExecCommand(PKUNPAK,'-V '+P+N+E);
  1074.     WriteLn(' done.');
  1075.     WriteLnStatus(' done.');
  1076.     if ArchiveBad then
  1077.     begin
  1078.       ArchiveError('Error in archive '+P+N+E+'; file skipped.');
  1079.       WriteLnStatus(IndentSpaces+'Error in archive; file skipped.');
  1080.       exit;
  1081.     end;
  1082.     X := InBuffer('Searching');
  1083.     if X=-1 then
  1084.     begin
  1085.       ArchiveError('Error in archive '+P+N+E+'; file skipped.');
  1086.       WriteLnStatus(IndentSpaces+'Error in archive; file skipped.');
  1087.       exit;
  1088.     end;
  1089.     ArcComment := '';
  1090.     X := X+11;
  1091.     repeat
  1092.       Inc(X);
  1093.     until char(Mem[BufferSeg:X]) in [' ',#13,#10];
  1094.     if char(Mem[BufferSeg:X])=' ' then
  1095.     begin
  1096.       repeat
  1097.         Inc(X);
  1098.       until char(Mem[BufferSeg:X])=' ';
  1099.       Inc(X);
  1100.       repeat
  1101.         ArcComment := ArcComment+char(Mem[BufferSeg:X]);
  1102.         Inc(X);
  1103.       until char(Mem[BufferSeg:X]) in [#10,#13];
  1104.     end;
  1105.     while ArcComment[length(ArcComment)]=' ' do Dec(ArcComment[0]);
  1106.     L := '';
  1107.     X := InBuffer(#13+#10+'---- ');
  1108.     if X=-1 then
  1109.     begin
  1110.       ArchiveError('Error in archive '+P+N+E+'; file skipped.');
  1111.       WriteLnStatus(IndentSpaces+'Error in archive; file skipped.');
  1112.       exit;
  1113.     end;
  1114.     X := X+52;
  1115.     repeat
  1116.       L := L+char(Mem[BufferSeg:X]);
  1117.       Inc(X);
  1118.     until char(Mem[BufferSeg:X]) in [#10,#13];
  1119.     C := '';
  1120.     repeat
  1121.       C := C+L[1];
  1122.       L := copy(L,2,255);
  1123.     until L[1]=' ';
  1124.     while L[1]=' ' do L := copy(L,2,255);
  1125.     Val(C,FilesInArc,Code);
  1126.     C := '';
  1127.     repeat
  1128.       C := C+L[1];
  1129.       L := copy(L,2,255);
  1130.     until L[1]=' ';
  1131.     while L[1]=' ' do L := copy(L,2,255);
  1132.     Val(C,UnArcedSize,Code);
  1133.     C := '';
  1134.     repeat
  1135.       C := C+L[1];
  1136.       L := copy(L,2,255);
  1137.     until L[1] in [#13,#10,#32];
  1138.     Val(C,ArcedSize,Code);
  1139.     Indent;
  1140.     WriteLn(FilesInArc,' files(s), ',ArcedSize,' bytes arced, ',UnArcedSize,' bytes unarced');
  1141.     Str(FilesInArc,Z);
  1142.     Str(ArcedSize,L);
  1143.     Str(UnarcedSize,C);
  1144.     WriteLnStatus(IndentSpaces+Z+' file(s), '+L+' bytes arced, '+C+' bytes unarced');
  1145.     if ArcComment<>'' then
  1146.     begin
  1147.       Indent;
  1148.       WriteLn('Archive comment: "',ArcComment,'"');
  1149.       WriteLnStatus(IndentSpaces+'Archive comment: "'+ArcComment+'"');
  1150.     end;
  1151.     Indent;
  1152.     Write('Extracting files...');
  1153.     WriteStatus(IndentSpaces+'Extracting files...');
  1154.     CurWork := CurWork+'\A2Z.$$$';
  1155.     MkDir(CurWork);
  1156.     if E='.ARC' then
  1157.     begin
  1158.       ExecCommand(PKUNPAK,P+N+' '+CurWork);
  1159.       Okay := not ArchiveBad;
  1160.     end;
  1161.     if E='.PAK' then
  1162.     begin
  1163.       ExecCommand(PAK,'e '+P+N+' '+CurWork);
  1164.       Okay := not PakBad;
  1165.     end;
  1166.     WriteLn(' done.');
  1167.     if not Okay then
  1168.     begin
  1169.       ArchiveError('Error extracting '+P+N+E+'; skipping.');
  1170.       WriteLnStatus(IndentSpaces+'Error extracting archive; skipping.');
  1171.       DeleteDir(CurWork);
  1172.       Dec(CurWork[0],8);
  1173.       exit;
  1174.     end;
  1175.   end;
  1176.   Indent;
  1177.   WriteLn('Checking internal files...');
  1178.   WriteLnStatus(IndentSpaces+'Checking internal files...');
  1179.   OCI := ConvertingInside;
  1180.   ConvertingInside := true;
  1181.   Inc(InternalCount);
  1182.   SearchEngine(CurWork+'\*.*',Archive,Convert,EC);
  1183.   Dec(InternalCount);
  1184.   ConvertingInside := OCI;
  1185.   if TrickleUpError then
  1186.   begin
  1187.     if InterruptRequested then
  1188.     begin
  1189.       DeleteDir(CurWork);
  1190.       Dec(CurWork[0],8);
  1191.       if ConvertingInside then exit;
  1192.       LogError('*** Conversion interrupted ***');
  1193.       WriteLnStatus('*** Conversion interrupted ***');
  1194.       Halt;
  1195.     end;
  1196.     if not ConvertingInside then
  1197.     begin
  1198.       TrickleUpError := false;
  1199.       LogError('Unable to convert '+P+N+E+' due to an internal file error.');
  1200.       WriteLnStatus(IndentSpaces+'Unable to convert '+N+E+' due to an internal file error.');
  1201.     end;
  1202.     DeleteDir(CurWork);
  1203.     Dec(CurWork[0],8);
  1204.     exit;
  1205.   end;
  1206.   CopyFile(P+N+E,P+N+'.A2B');
  1207.   Indent;
  1208.   Write('Creating ZIP file ',N,'.ZIP...');
  1209.   WriteStatus(IndentSpaces+'Creating ZIP file '+N+'.ZIP...');
  1210.   Z := P+N+'.ZIP';
  1211.   Assign(T, Z);
  1212.   {$I-}
  1213.   Erase(T);
  1214.   {$I+}
  1215.   Code := IOResult;
  1216.   if ArcComment='' then
  1217.     ExecCommand(PKZIP,Z+' -ea'+AsciiLevel+' -eb'+BinaryLevel+' '+
  1218.                 CurWork+'\*.*')
  1219.   else
  1220.   begin
  1221.     Assign(T, WorkDir+'ZCOMMENT.A2Z');
  1222.     Rewrite(T);
  1223.     WriteLn(T, ArcComment);
  1224.     Close(T);
  1225.     Reg.BX := 0;
  1226.     Reg.AH := $45;
  1227.     MsDos(Reg);
  1228.     Code := Reg.AX;
  1229.     Reset(T);
  1230.     Reg.BX := TextRec(T).Handle;
  1231.     Reg.CX := 0;
  1232.     Reg.AH := $46;
  1233.     MsDos(Reg);
  1234.     ExecCommand(PKZIP,Z+' -ea'+AsciiLevel+' -eb'+BinaryLevel+' -a '+CurWork+'\*.* -z');
  1235.     Reg.BX := Code;
  1236.     Reg.CX := 0;
  1237.     Reg.AH := $46;
  1238.     MsDos(Reg);
  1239.     Reg.BX := Code;
  1240.     Reg.AH := $3E;
  1241.     MsDos(Reg);
  1242.     Close(T);
  1243.     Erase(T);
  1244.   end;
  1245.   WriteLn(' done.');
  1246.   WriteLnStatus(' done.');
  1247.   if ZipBad then
  1248.   begin
  1249.     ArchiveError('Unable to create zip file: '+Z+'; file skipped.');
  1250.     WriteLnStatus(IndentSpaces+'Unable to create zip file; file skipped');
  1251.     DeleteDir(CurWork);
  1252.     Dec(CurWork[0],8);
  1253.     CopyFile(P+N+'.A2B',P+N+E);
  1254.     exit;
  1255.   end;
  1256.   FindFirst(Z,0,SRec);
  1257.   Assign(T, P+N+'.A2B');
  1258.   {$I-}
  1259.   Erase(T);
  1260.   {$I+}
  1261.   Code := IOResult;
  1262.   if not ConvertingInside then Saved := Saved+(ArcedSize-SRec.Size);
  1263.   Assign(T, Z);
  1264.   Reset(T);
  1265.   SetFTime(T, S.Time);
  1266.   Close(T);
  1267.   Str(ArcedSize-SRec.Size,C);
  1268.   if ConvertingInside then
  1269.   begin
  1270.     Indent;
  1271.     WriteLn('Internal file '+N+E+' converted.');
  1272.     WriteLnStatus(IndentSpaces+'Internal file '+N+E+' converted.');
  1273.   end
  1274.   else
  1275.     if E='.ZIP' then
  1276.     begin
  1277.       LogError(P+N+E+' internally converted to ZIP, '+C+' bytes saved.');
  1278.       WriteLnStatus(N+E+' internally converted to ZIP, '+C+' bytes saved.');
  1279.     end
  1280.     else begin
  1281.       LogError('File '+P+N+E+' converted to ZIP, '+C+' bytes saved.');
  1282.       WriteLnStatus('File '+N+E+' converted to ZIP, '+C+' bytes saved.');
  1283.     end;
  1284.   DeleteDir(CurWork);
  1285.   Dec(CurWork[0],8);
  1286. end;
  1287.  
  1288.  
  1289. procedure ConvertFiles;
  1290. {
  1291.   This is the main conversion loop of the program.  It will call the convert
  1292.   arc routine from the search engine.
  1293. }
  1294. var
  1295.   L:                    byte;
  1296.   ErrorCode:            byte;
  1297. begin
  1298.   FileNum := 0;
  1299.   ConvertingInside := false;
  1300.   InternalCount := 0;
  1301.   InterruptRequested := false;
  1302.   Saved := 0;
  1303.   TrickleUpError := false;
  1304.   CurWork := copy(WorkDir,1,length(WorkDir)-1);
  1305.   for L := 1 to NumDirs do
  1306.   with Dir[L] do
  1307.     if Below then SearchEngineAll(Dir,Name,Archive,Convert,ErrorCode)
  1308.        else SearchEngine(Dir+Name,Archive,Convert,ErrorCode);
  1309. end;
  1310.  
  1311. procedure SummarizeLog;
  1312. var
  1313.   S:                    string[30];
  1314. begin
  1315.   Str(Saved, S);
  1316.   LogError(S+' bytes saved total.');
  1317. end;
  1318.  
  1319. begin
  1320.   ReadCommandLine;
  1321.   CheckSubPrograms;
  1322.   OpenLogFile;
  1323.   GetFileEstimates;
  1324.   CheckBreak := false;
  1325.   InstallInterruptHandler;
  1326.   ConvertFiles;
  1327.   SummarizeLog;
  1328. end.
  1329.  
  1330.  
  1331.