home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR31 / A2Z16D.ZIP / A2Z16D.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-15  |  49KB  |  1,535 lines
  1. {$A+}  {word alignment}
  2. {$B-}  {shortcircuit boolean eval}
  3. {$D-}  {Debug information off (was +)}
  4. {$E-}  {8087 emulation off}
  5. {$F-}  {Force FAR calls as needed (was +)}
  6. {$I-}  {I/O checking off}
  7. {$L-}  {Local symbols off (was +)}
  8. {$N-}  {Numeric coprocessing=software}
  9. {$O-}  {No Overlays allowed (was +)}
  10. {$R-}  {Range checking off}
  11. {$S-}  {Stack overflow checking off (was on)}
  12. {$V-}  {Var-string checking off}
  13. {$M 32767,32767,32767}
  14.  
  15. PROGRAM A2Z;
  16.  
  17. {
  18.   Version 1.6
  19.  
  20.   This version represents minor changes in code structure.  It will also be
  21.   the last version released, unless some fatal flaw is uncovered.  Enjoy.
  22.  
  23.               Ian McLean                   404 428 7829 (voice)
  24.               3365 Timber Lake Road
  25.               Kennesaw, GA
  26.               30144
  27.   v1.6d  Toad Hall, 12 Oct 89
  28.   - Removing the -ex, -eb4, etc. for the newer PK v1.01 ZIP.
  29.  
  30.   v1.6c  Toad Hall, 15 Jun 89
  31.   - Tweaking a little
  32.  
  33.   v1.6b  Toad Hall, 9 Apr 89
  34.   - WHY are we messing with the horrendous error-trapping
  35.     (during unarcing procedures), processing strings for error msgs?
  36.     Just look for the ERRORLEVEL returned by the executing program!
  37.     If it's not 0, there was a problem!  THEN Die!
  38.   - Why are we processing strings for file sizes, number of archive
  39.     files, etc?  All that is right there in the .ARC or .PAK file
  40.     entry!  Snarf it from the raw file.
  41.     (Of course that means we must know header structures, how to
  42.     reposition file pointers, snarf long integers from the headers,
  43.     etc. .. but we can do that, ne?
  44.  
  45.   v1.6a  Toad Hall Tweak, 7 Apr 89
  46.   - Changed some switches (above)
  47.   - Added Ascii file "-ex" switch
  48.   - Tightened up the Convert code by consolidating
  49.     common (shared) code.
  50.   - Vastly tightened up the Log, StatFile and other reports
  51.     by consolidating WriteLn, etc.
  52.   - Enabled the F- (no FAR calls) switch
  53.     with F+ switches only when absolutely required.
  54.   - To Do:
  55.       Figure how to read .PAK comments
  56.  
  57.     David Kirschbaum
  58.     Toad Hall
  59.     kirsch@braggvax.ARPA
  60. }
  61.  
  62. Uses DOS, CRT;
  63.  
  64. CONST
  65.   MAXDIRENTRIES = 20; { Maximum number of directories that can be specified
  66.                         to search.  This doesn't include those searched
  67.                         "below" ones specified.   }
  68.  
  69.   DataNext:             STRING[10]=    'CONFIGNEXT';
  70.   PKZIP:                PathStr=       'U:\PKZIP.EXE';   {  80 bytes }
  71.   PKUNZIP:              PathStr=       'U:\PKUNZIP.EXE'; {  80 bytes }
  72.   PKUNPAK:              PathStr=       'U:\PKXARC.EXE';  {  80 bytes }
  73.   PAK:                  PathStr=       'U:\PAK.EXE';     {  80 bytes }
  74. (* v1.6d
  75.   EASwitch :            STRING[5] =    ' -ex ';          {  6  bytes v1.6a}
  76.   EBSwitch :            STRING[5] =    ' -eb4';          {  6  bytes v1.6a}
  77.                                                          { --------- }
  78.                                                          { 334 bytes }
  79. *)
  80.                                                          { --------- }
  81.                                                          { 320 bytes }
  82.   HDRLEN = 319;  {v1.6d length of directory names - 1}
  83.  
  84. TYPE
  85.   FullNameStr    = STRING[12];    { Type for storing name+dot+extension }
  86.   DirSearchEntry = RECORD         { This data type is used to store
  87.                                     all the paths that will be searched }
  88.                      Dir  : DirStr;      {   <-- Path to search }
  89.                      Name : FullNameStr; {   <-- File spec to search }
  90.                      Below: BOOLEAN;     {   <-- TRUE=search directories
  91.                                                  below the specified one }
  92.                    END;
  93.  
  94. VAR
  95.   Dir : ARRAY[1..MAXDIRENTRIES] OF DirSearchEntry;  { This holds all the
  96.                                                       directories specified
  97.                                                       to convert }
  98.   numdirs:              Byte;       { The number of directories used in
  99.                                       above array }
  100.   SearchZips:           BOOLEAN;    { Search ZIP files for inclosed ARCs
  101.                                       or PAKs }
  102.   AppendLog:            BOOLEAN;    { TRUE=Append to log
  103.                                       FALSE=rewrite log file }
  104.   BatchMode:            BOOLEAN;    { TRUE=Don't wait for a keypress
  105.                                       at beginning }
  106.   SuppressLog:          BOOLEAN;    { TRUE=Don't make a log file }
  107.   LogFile:              TEXT;       { Log file handle, A2Z.LOG }
  108.   OldExitProc1:         pointer;    { Pointer to previous exit procedure
  109.                                       routine. }
  110.   oldSeg,oldOfs:        word;        { Old segment and offset
  111.                                        for interrupt 29h handler }
  112.   OldExitProc2:         pointer;     { Holder for old exit proc }
  113.   Reg:                  Registers;   { Register storage for DOS calls }
  114.   cmdY:                 Byte;        { Line the cursor's on
  115.                                        in the bottom window }
  116.   bufData:              longint;     { Pointer to the text buffer }
  117.   bufferSeg:            word;        { Segment of the text buffer }
  118.   bufferOfs:            word;        { Offset  "  "   "    "      }
  119.   BufferPtr:            pointer;     { Pointer to the text buffer,
  120.                                        in pointer format }
  121.   bufferlen:            word;        { Current length of text buffer }
  122.  
  123.   numfiles:             word;         { Number of files to convert }
  124.   numBytes:             longint;      { Number of bytes to convert }
  125.   filenum:              word;         { Current file number        }
  126.   ConvertingInside:     BOOLEAN;      { TRUE=Converting internal arc files }
  127.   saved:                longint;      { Total bytes saved so far }
  128.   TrickleUpError:       BOOLEAN;      { Error converting an internal file }
  129.   internalcount:        Byte;
  130.   InterruptRequested:   BOOLEAN;
  131.   WorkDir:              String;
  132.   StatusFile:           TEXT;
  133.   StatusFileName:       String;
  134.   TStr:                 String;       {v1.6a}
  135.   execerror :           Byte;         {v1.6b}
  136.   ExecErrStr :          STRING[5];    {v1.6b}
  137.  
  138. function File_Found(F: ComStr): BOOLEAN;
  139. {
  140.   This returns TRUE if the file F exists, FALSE otherwise.
  141.   F can contain wildcard characters.
  142. }
  143.   VAR
  144.     SRec : SearchRec;
  145.   BEGIN
  146.     SRec.Name := '*';
  147.     FindFirst(F,0,SRec);
  148.     File_Found := NOT (SRec.Name='*');  {v1.6a}
  149.   END;  {of File_Found}
  150.  
  151.  
  152. function Valid_Dir(D: String): BOOLEAN;
  153.   VAR
  154.     T:  FILE;
  155.   BEGIN
  156.     Assign(T, D+'VALID!!!.A2Z');
  157.     {$I-}  REWRITE(T);  {$I+}
  158.     IF IOResult<>0 THEN Valid_Dir := FALSE
  159.     ELSE BEGIN
  160.       CLOSE(T);
  161.       Erase(T);
  162.       Valid_Dir := TRUE;
  163.     END;
  164.   END;  {of Valid_Dir}
  165.  
  166.  
  167. PROCEDURE HaltWithMsg(M: String);
  168. {
  169.   Displays the message in M to the user and halts program execution.
  170.   Used with critical errors.
  171. }
  172.   BEGIN
  173.     WRITELN(M);
  174.     HALT;
  175.   END;  {of HaltWithMsg}
  176.  
  177.  
  178. PROCEDURE DisplayProgramHeader;
  179. {
  180.   Display program version number and credits.
  181. }
  182.   BEGIN
  183.     WRITELN;
  184.     WRITELN('A2Z - ARC/PAK to ZIP converter');
  185.     WRITELN('version 1.6d by Ian McLean (with a Toad Hall Tweak!)');
  186.     WRITELN;
  187.   END;  {of DisplayProgramHeader}
  188.  
  189.  
  190. PROCEDURE InvokeConfiguration;
  191. {
  192.   Configure A2Z by entering the paths for PKZIP, PKUNZIP, PKUNPAK, and PAK,
  193.   as well as a compression level for ASCII and binary files.  This information
  194.   is then stored in the executable for A2Z for future use.
  195. }
  196.   VAR
  197.     A:        FILE OF Byte;  { Temp variable for referencing A2Z.EXE }
  198.     l:        longint;       { Location of search }
  199.     matchup:  Byte;          { Number of bytes currently matched }
  200.     C:        CHAR;          { Character to match to }
  201.  
  202.     PROCEDURE Get_Name(VAR Name : PathStr; Pk : BOOLEAN);
  203.       {v1.6c a common procedure.
  204.        v1.6d Bug fixed.
  205.       }
  206.       VAR  S,N : PathStr;
  207.       BEGIN
  208.         IF Pk THEN S := 'PKWare''s ' + Name + '.'
  209.         ELSE S := 'NoGate Consulting''s ' + Name + '.';
  210.  
  211.         N := Name;  {v1.6d}
  212.         REPEAT
  213.           WRITELN;
  214.           WRITELN('Enter the name and path for ', S);
  215.           WRITELN('Please be sure to enter a path, filename, and extension:');
  216.           READLN(N);
  217.         UNTIL File_Found(N);  {v1.6d}
  218.         Name := N;  {post global v1.6d}
  219.       END;  {of Get_Name}
  220.  
  221.   TYPE
  222.     Str4 = STRING[4];
  223.  
  224.   FUNCTION Get_Char(Query : String; CharSet : Str4) : CHAR;
  225.     VAR Ch : CHAR;
  226.     BEGIN
  227.       WRITE(Query);
  228.       REPEAT
  229.         REPEAT UNTIL KeyPressed;
  230.         Ch := UpCase(ReadKey);
  231.       UNTIL POS(Ch,CharSet) <> 0;
  232.       Get_Char := Ch;
  233.     END;  {of Get_Char}
  234.  
  235.  
  236.   BEGIN  {InvokeConfiguration}
  237.     DisplayProgramHeader;
  238.     IF NOT File_Found('A2Z.EXE')
  239.     THEN HaltWithMsg(
  240. 'A2Z.EXE must be in the current directory when invoking configuration.');
  241.  
  242.     Get_Name(PKZIP,TRUE);      {v1.6c get PKZIP.EXE's path and name}
  243.  
  244.     Get_Name(PKUNZIP,TRUE);    {v1.6c get PKUNZIP.EXE's path and name}
  245.  
  246.     Get_Name(PKUNPAK,TRUE);    {v1.6c get PKUNPAK.EXE's path and name}
  247.  
  248.     C := Get_Char('Do you have .PAK files to convert? [Y/N] ', 'YN');
  249.  
  250.     WRITELN(C);                         {display, new line}
  251.     IF C = 'Y'
  252.     THEN Get_Name(PAK,FALSE)
  253.     ELSE PAK := '';
  254.  
  255.     WRITELN;
  256. (* v1.6d
  257.     C := Get_Char('Compression level for binary files [1..4]: ', '1234');
  258.  
  259.     EBSwitch[5] := C;                   {v1.6a move into ' -eb%' string}
  260.     WRITELN(EBSwitch);                  {v1.6a}
  261.  
  262. { v1.6a Add 'ex' for ASCII files }
  263.  
  264.     C := Get_Char('Compression level for ASCII files [1..4,X]: ', '1234X');
  265.  
  266.     IF C = 'X'                          {v1.6a}
  267.     THEN EASwitch := ' -ex'             {v1.6a}
  268.     ELSE EASwitch := ' -ea' + C;        {v1.6a}
  269.     WRITELN(EASwitch);                  {v1.6a}
  270.  
  271.     WRITELN;
  272. *)
  273.     Assign(A, 'A2Z.EXE'); { Configuration information is written to A2Z.EXE, }
  274.     RESET(A);             { overlaying what was in the CONST block previously}
  275.     l := FileSize(A)-1;   { Search starting at EOF, as constants are usually
  276.                             found there }
  277.     matchup := 10;        { First character to match is the fifth of the
  278.                             string CONFIGNEXT }
  279.     REPEAT
  280.       Seek(A, l);          { Read character from file }
  281.       READ(A, Byte(C));
  282.       Dec(l);              { Decrement counter (search backwards) }
  283.       CASE matchup OF
  284.         10:  IF C=DataNext[matchup]  { If the char matches,}
  285.              THEN Dec(matchup);      { we need to match the next one,
  286.                                        otherwise we}
  287.         ELSE IF C=DataNext[matchup]  { need to match the tenth next }
  288.         THEN Dec(matchup) ELSE matchup := 10; { (string wasn't correct)}
  289.       END;
  290.     UNTIL (matchup=0) OR (l=0);  { Repeat this until string found (matchup=0)
  291.                                    or we're at start of file }
  292.     IF matchup <> 0
  293.     THEN HaltWithMsg(
  294. 'Unable to find configuration data area.  Corrupted A2Z.EXE!');
  295.  
  296.     Seek(A, l+12);               { Seek the configuration information block }
  297. (* v1.6d
  298.     for l := 0 TO 321 DO         {Write the Directory/filenames}
  299.       WRITE(A, Mem[Seg(PKZIP):Ofs(PKZIP)+l]);  { and compression levels }
  300. *)
  301.    FOR l := 0 TO HDRLEN DO       {Write the Directory/filenames} {v1.6d}
  302.      WRITE(A,Mem[Seg(PKZIP):Ofs(PKZIP)+l]);
  303.  
  304.     CLOSE(A);
  305.     HaltWithMsg('A2Z is now configured for use.');
  306.   END;  { of InvokeConfiguration }
  307.  
  308.  
  309. PROCEDURE ShowInvokation;
  310. {
  311.   Display program information and the invokation parameters for A2Z,
  312.   then halt the program.
  313. }
  314. BEGIN
  315.   DisplayProgramHeader;
  316.   WRITELN(
  317. 'A2Z [/C] [/Z] [/A] [/B] [/S=device] [/W=dir] [filespec] [!filespec]');
  318.   WRITELN;
  319.   WRITELN(
  320. '/C          Invoke configuration');
  321.   WRITELN(
  322. '/Z          Search ZIP files for imbedded ARC/PAK files and process');
  323.   WRITELN(
  324. '/A          Append to log file, if it exists, instead of overwriting');
  325.   WRITELN(
  326. '/B          Batch mode.  Don''t pause for a keypress at beginning');
  327.   WRITELN(
  328. '/N          Create no log file.');
  329.   WRITELN(
  330. '/S=[device] Set the status display device (eg: /S=COM1).  Default is NUL');
  331.   WRITELN(
  332. '/W=[dir]    Set the work directory to [dir].  Default is current directory');
  333.   WRITELN(
  334. '            or value set by the environment variable A2ZWORK.');
  335.   WRITELN;
  336.   WRITELN(
  337. '[filespec]  Directory name or search specification of files to convert.  If');
  338.   WRITELN(
  339. '            there''s an ! before the name, subdirectories of the one specified');
  340.   WRITELN(
  341. '            are searched.  Up to twenty path names may be entered.');
  342.   WRITELN;
  343.   WRITELN('Examples:');
  344.   WRITELN(
  345. 'A2Z !C:\ !D:\ /Z        Convert all dirs on drives C: and D:, search ZIPs');
  346.   WRITELN(
  347. '                        for imbedded ARC/PAKs');
  348.   WRITELN(
  349. 'A2Z FOOBAR.ARC          Convert the file FOOBAR.ARC to a ZIP');
  350.   WRITELN(
  351. 'A2Z C:\*.PAK            Convert all PAK files in dir C:\ to ZIPs');
  352.   HALT;
  353. END;  {of ShowInvocation}
  354.  
  355.  
  356. PROCEDURE ReadCommandLine;
  357. {
  358.   Read the parameters entered at the command line and build the list of
  359.   directories to convert.  Check for configuration and show invokation if
  360.   necessary.
  361. }
  362.  
  363.   PROCEDURE ParseParameter(S: String);
  364.   {
  365.     Parse the parameter in S.
  366.   }
  367.   VAR
  368.     D : DirStr;    { Temp holders for path name, etc }
  369.     N : NameStr;
  370.     E : ExtStr;
  371.   BEGIN
  372.     IF S[1]='/' THEN
  373.       CASE UpCase(S[2]) OF
  374.         'C':  InvokeConfiguration;
  375.         'Z':  SearchZips := TRUE;
  376.         'A':  AppendLog := TRUE;
  377.         'B':  BatchMode := TRUE;
  378.         'N':  SuppressLog := TRUE;
  379.         'W':  BEGIN
  380.                 IF (LENGTH(S)<5) OR (S[3]<>'=') THEN ShowInvokation;
  381.                 WorkDir := COPY(S,4,255);
  382.               END;
  383.         'S':  BEGIN
  384.                 IF (LENGTH(S)<4) OR (S[3]<>'=') THEN ShowInvokation;
  385.                 StatusFileName := COPY(S,4,255);
  386.               END;
  387.         ELSE ShowInvokation;
  388.       END  {case}
  389.     ELSE BEGIN
  390.       Inc(numdirs);
  391.       WITH Dir[numdirs] DO BEGIN
  392.         IF S[1]='!' THEN BEGIN
  393.           S := COPY(S,2,255);
  394.           Below := TRUE;
  395.         END
  396.         ELSE Below := FALSE;
  397.         IF S[LENGTH(S)]<>'\' THEN
  398.           IF (NOT File_Found(S)) AND (File_Found(S+'\*.*')) THEN S := S+'\';
  399.         FSplit(FExpand(S), D,N,E);
  400.         IF N='' THEN N := '*';
  401.         IF (E='') OR (E='.') THEN E := '.*';
  402.         Dir := D;
  403.         Name := N+E;
  404.       END;
  405.     END;
  406.   END;  {of ParseParameter}
  407.  
  408.  
  409.   VAR  l : Byte;  { Loop variable }
  410.  
  411.   BEGIN  {ReadCommandLine}
  412.     SearchZips := FALSE;
  413.     AppendLog := FALSE;
  414.     BatchMode := FALSE;
  415.     SuppressLog := FALSE;
  416.     WorkDir := GetEnv('A2ZWORK');
  417.     StatusFileName := 'NUL';
  418.     numdirs := 0;
  419.     IF ParamCount=0 THEN ShowInvokation;  {and die}
  420.  
  421.     for l := 1 TO ParamCount DO ParseParameter(ParamStr(l));
  422.     IF numdirs=0 THEN ShowInvokation;
  423.  
  424.     IF WorkDir='' THEN GetDir(0,WorkDir);
  425.     WorkDir := FExpand(WorkDir);
  426.     IF WorkDir[LENGTH(WorkDir)]<>'\' THEN WorkDir := WorkDir+'\';
  427.     IF NOT Valid_Dir(WorkDir)
  428.     THEN HaltWithMsg('Invalid work directory specified.');
  429.  
  430.     Assign(StatusFile, StatusFileName);
  431.     {$I-}  REWRITE(StatusFile);  {$I+}
  432.     IF IOResult<>0 THEN BEGIN
  433.       WRITELN('Unable to open specified status file.');
  434.       Assign(StatusFile, 'NUL');
  435.       REWRITE(StatusFile);
  436.     END
  437.     ELSE WRITELN(StatusFile, 'A2Z v1.6b by Ian McLean');
  438.   END;  { of ReadCommandLine }
  439.  
  440.  
  441. {$F+}  {v1.6a Use FAR calls}
  442. PROCEDURE NewExitProc1;
  443. {
  444.   This exit procedure closes the log file.
  445. }
  446.   BEGIN
  447.     IF NOT SuppressLog THEN CLOSE(LogFile);
  448.     CLOSE(StatusFile);
  449.     ExitProc := OldExitProc1;
  450.   END;  {of NewExitProc1}
  451. {$F-}  {v1.6a No FAR calls}
  452.  
  453.  
  454. PROCEDURE CheckSubPrograms;
  455.   BEGIN
  456.     IF PKZIP='UNCONFIGURED' THEN InvokeConfiguration;
  457.     IF NOT (File_Found(PKZIP) AND File_Found(PKUNZIP)
  458.        AND File_Found(PKUNPAK)
  459.        AND (File_Found(PAK)
  460.             OR (PAK='')))
  461.     THEN BEGIN
  462.       WRITELN;
  463.       WRITELN('** Invalid program paths in configuration **');
  464.       InvokeConfiguration;
  465.     END;
  466.   END;  {of CheckSubPrograms}
  467.  
  468.  
  469. PROCEDURE OpenLogFile;
  470. {
  471.   Open the file A2Z.LOG in the current directory.  If it exists, append to it.
  472.   Place a date/time stamp on it, too, just for the heck of it.  Also sets up
  473.   an exit procedure to close the file.  If AppendLog is true, we'll append
  474.   to the log, otherwise we'll rewrite it.
  475. }
  476.  
  477.   function Date_String: String;
  478.   {
  479.     Returns the current date in a string of the form:  MON ## YEAR.
  480.     E.g, 21 Feb 1989 or 02 Jan 1988.
  481.   }
  482.   CONST
  483.     Month:              ARRAY[1..12] OF STRING[3]=
  484.                         ('Jan','Feb','Mar','Apr','May','Jun',
  485.                          'Jul','Aug','Sep','Oct','Nov','Dec');
  486.   VAR
  487.     y,m,d,junk : word;
  488.     DS,YS:       STRING[5];
  489.   BEGIN
  490.     GetDate(y,m,d,junk);
  491.     STR(y,YS);
  492.     STR(d,DS);
  493.     IF LENGTH(DS)<2 THEN DS := '0'+DS;
  494.     Date_String := DS+' '+Month[m]+' '+YS;
  495.   END;
  496.  
  497.   function Time_String: String;
  498.   {
  499.     Returns the current time in the form:  HH:MM am/pm
  500.     E.g, 12:00 am or 09:12 pm.
  501.   }
  502.   VAR
  503.     h,m,junk: word;
  504.     HS,MS:    STRING[5];
  505.     Am:       BOOLEAN;
  506.   BEGIN
  507.     GetTime(h,m,junk,junk);
  508.     CASE h OF
  509.       0:     BEGIN
  510.                Am := TRUE;
  511.                h := 12;
  512.              END;
  513.       1..11: Am := TRUE;
  514.       12:    Am := FALSE;
  515.       ELSE   BEGIN
  516.                Am := FALSE;
  517.                h := h-12;
  518.              END;
  519.     END;
  520.     STR(h,HS);
  521.     STR(m,MS);
  522.     IF LENGTH(HS)<2 THEN HS := '0'+HS;
  523.     IF LENGTH(MS)<2 THEN MS := '0'+MS;
  524.     IF Am THEN Time_String := HS+':'+MS+' am'
  525.     ELSE Time_String := HS+':'+MS+' pm';
  526.   END;  {of Time_String}
  527.  
  528.   BEGIN  {OpenLogFile}
  529.     IF NOT SuppressLog THEN BEGIN
  530.       Assign(LogFile, 'A2Z.LOG');
  531.       {$I-}
  532.       IF AppendLog THEN Append(LogFile) ELSE REWRITE(LogFile);
  533.       {$I+}
  534.       IF IOResult<>0 THEN REWRITE(LogFile);
  535.       WRITELN(LogFile);
  536.       WRITELN(LogFile, Date_String+' '+Time_String);
  537.       WRITELN(LogFile, '--------------------');
  538.     END;
  539. {$F+}  {v1.6a Use FAR calls}
  540.     OldExitProc1 := ExitProc;
  541.     ExitProc := @NewExitProc1;
  542. {$F-}  {v1.6a No FAR calls}
  543.   END;  { of OpenLogFile }
  544.  
  545.  
  546. function Indent_Spaces: String;
  547.   {v1.6a moved this to be a global function,
  548.          tightened up a bit.
  549.   }
  550.     VAR
  551.       S:  String;
  552.       i : INTEGER;  {v1.6b}
  553.     BEGIN
  554.       i := internalcount ShL 1;         {v1.6b}
  555.       S[0] := CHAR(i);                  {v1.6b}
  556.       IF internalcount <> 0
  557.       THEN FillChar(S[1], i,' ');       {v1.6b}
  558.       Indent_Spaces := S;
  559.     END;  {of Indent_Spaces}
  560.  
  561.  
  562. PROCEDURE LogError(E: String; Stat : BOOLEAN);
  563. {
  564.   Write the message in string E to the screen and to the log file.
  565.   v1.6a If Stat is TRUE, write it to the status file also.
  566. }
  567.   BEGIN
  568.     WRITELN(E);
  569.     IF NOT SuppressLog THEN WRITELN(LogFile, E);
  570.     IF Stat THEN WRITELN(StatusFile,Indent_Spaces + E);  {v1.6a}
  571.   END;  {of LogError}
  572.  
  573.  
  574. PROCEDURE WriteStatus(M: String);
  575.   {v1.6a  We ALWAYS Write(M),
  576.    and we ALWAYS indent .. so consolidating here.
  577.   }
  578.   BEGIN
  579.     M := Indent_Spaces + M;             {v1.6a}
  580.     WRITE(M);                           {v1.6a}
  581.     WRITE(StatusFile,M);
  582.   END;  {of WriteStatus}
  583.  
  584.  
  585. PROCEDURE WritelnStatFil(M: String; W : BOOLEAN);
  586. {
  587.   Write the message in M to the status device, with linefeed.
  588.   v1.6a  IF W is TRUE, Writeln(M) also.
  589. }
  590.   BEGIN
  591.     IF W THEN WRITELN(M);               {v1.6a}
  592.     WRITELN(StatusFile,M);
  593.   END;  {of WritelnStatFil}
  594.  
  595.  
  596. {********* The following search engine routines are sneakly swiped *********
  597.  ********* from Turbo Technix v1n6.  See there for further details *********}
  598.  
  599. {$F+}  {v1.6a we need far calls for this ProcType business}
  600.  
  601. TYPE
  602.   ProcType=             PROCEDURE(VAR S: SearchRec; P: PathStr);
  603.  
  604. VAR
  605.   EngineMask:           FullNameStr;
  606.   engineattr:           Byte;
  607.   EngineProc:           ProcType;
  608.   enginecode:           Byte;
  609.  
  610. {$F-}
  611. function Valid_Extension(VAR S: SearchRec): BOOLEAN;
  612.   VAR
  613.     Junk : String;
  614.     E    : ExtStr;
  615.   BEGIN
  616.     IF S.Attr AND Directory=Directory THEN BEGIN
  617.       Valid_Extension := TRUE;
  618.       Exit;
  619.     END;
  620.  
  621.     FSplit(S.Name,Junk,Junk,E);
  622.     Valid_Extension :=                  {v1.6a}
  623.       (E='.ARC') OR (E='.PAK')
  624.       OR (SearchZips AND (E='.ZIP') );
  625.   END;  {of Valid_Extension}
  626.  
  627. {$F+}  {v1.6a Use FAR calls}
  628.  
  629. PROCEDURE SearchEngine(Mask: PathStr; attr: Byte; Proc: ProcType;
  630.                        VAR errorcode: Byte);
  631.   VAR
  632.     S   : SearchRec;
  633.     P   : PathStr;
  634.     Ext : ExtStr;
  635.   BEGIN
  636.     FSplit(Mask, P, Mask, Ext);
  637.     Mask := Mask+Ext;
  638.     FindFirst(P+Mask,attr,S);
  639.     IF DosError<>0 THEN BEGIN
  640.       errorcode := DosError;
  641.       Exit;
  642.     END;
  643.  
  644.     WHILE DosError=0 DO BEGIN
  645.       IF Valid_Extension(S) THEN Proc(S, P);
  646.       FindNext(S);
  647.     END;
  648.     IF DosError=18 THEN errorcode := 0
  649.     ELSE errorcode := DosError;
  650.   END;  {of SearchEngine}
  651.  
  652. {$F-}  {v1.6a No FAR calls}
  653.  
  654. function Good_Directory(S: SearchRec): BOOLEAN;
  655.   {1 call}
  656.   BEGIN
  657.     Good_Directory := (S.name<>'.') AND (S.Name<>'..')
  658.                   AND (S.attr AND Directory=Directory);
  659.   END;  {of Good_Directory}
  660.  
  661. {$F+}  {v1.6a  Use FAR calls}
  662.  
  663. PROCEDURE SearchOneDir(VAR S: SearchRec; P: PathStr);
  664.   BEGIN
  665.     IF Good_Directory(S) THEN BEGIN
  666.       P := P+S.Name;
  667.       SearchEngine(P+'\'+EngineMask,engineattr,EngineProc,enginecode);
  668.       SearchEngine(P+'\*.*',Directory OR Archive, SearchOneDir,enginecode);
  669.     END;
  670.   END;  {of SearchOneDir}
  671.  
  672.  
  673. PROCEDURE SearchEngineAll(Path: PathStr; Mask: FullNameStr; attr: Byte;
  674.                           Proc: ProcType; VAR errorcode: Byte);
  675.   BEGIN
  676.     EngineMask := Mask;
  677.     EngineProc := Proc;
  678.     engineattr := attr;
  679.     SearchEngine(Path+Mask,attr,Proc,errorcode);
  680.     SearchEngine(Path+'*.*',Directory OR Archive,SearchOneDir,errorcode);
  681.     errorcode := enginecode;
  682.   END;  {of SearchEngineAll}
  683.  
  684.  
  685. {************** Thus ends the sneakly swiped code *************
  686.  **** We now return you to our regularly scheduled program ****}
  687.  
  688. PROCEDURE AddToEstimate(VAR S: SearchRec; P: PathStr);
  689.  
  690. {$F-}  {v1.6a and back to no Far calls}
  691. {
  692.   Called by the search engine, adds the information in S to the file estimates
  693.   numfiles and numBytes.  Displays the filename temporarily, too.
  694. }
  695.   VAR
  696.     x : Byte;
  697.   BEGIN
  698.     Inc(numfiles);                      {bump nr of files processed}
  699.     Inc(numBytes,S.size);               {bump total bytes in all files
  700.                                          by .ARC/.PAK file size}
  701.     x := WhereX;
  702.     ClrEol;
  703.     WRITE(S.Name);
  704.     GotoXY(x,WhereY);
  705.   END;  {of AddToEstimate}
  706.  
  707.  
  708. PROCEDURE GetFileEstimates;
  709. {
  710.   Estimate the number of bytes and number of files to convert.
  711. }
  712.   VAR
  713.     l, errorcode : Byte;
  714.   BEGIN
  715.     DisplayProgramHeader;
  716.     WRITELN('Searching directories...');
  717.     WRITELN;
  718.     numfiles := 0;                      {clear nr ARC/PAK files processed}
  719.     numBytes := 0;                      {and total nr file bytes}
  720.     for l := 1 TO numdirs DO
  721.     WITH Dir[l] DO BEGIN
  722.       WRITE(Dir);
  723. {$F+}  {v1.6a Use Far calls}
  724.       IF Below THEN SearchEngineAll(Dir,Name,Archive,AddToEstimate,errorcode)
  725.                ELSE SearchEngine(Dir+Name,Archive,AddToEstimate,errorcode);
  726. {$F-}  {v1.6a No Far calls}
  727.  
  728.       ClrEol;
  729.       WRITELN;
  730.     END;
  731.     WRITELN;
  732.     WRITE(numBytes,' bytes in ',numfiles,' file(s) to ');
  733.     IF SearchZips THEN WRITELN('convert/examine.')
  734.     ELSE WRITELN('convert.');
  735.     WRITELN;
  736.     IF numfiles=0 THEN HaltWithMsg('No files to convert!');
  737.  
  738.     IF NOT BatchMode THEN BEGIN
  739.       WRITELN('Press any key...');
  740.       REPEAT UNTIL KeyPressed;
  741.     END;
  742.     WHILE KeyPressed DO CHAR(l) := ReadKey;
  743.   END;  { of GetFileEstimates }
  744.  
  745.  
  746. PROCEDURE IPP;
  747. { Interrupt pre-processor.  This is a new handler for interrupt 29h which
  748.   provides special functions.  See comments in IHAND.ASM}
  749. interrupt;
  750. BEGIN
  751.   InLine(
  752.       $06/             {  push    es }
  753.       $1E/             {  push    ds }
  754.       $53/             {  push    bx }
  755.       $57/             {  push    di }
  756.       $BB/$3F/$3F/     {  mov     bx, 3f3fh }
  757.       $8E/$C3/         {  mov     es, bx }
  758.       $BB/$3F/$3F/     {  mov     bx, 3f3fh }
  759.       $26/$8B/$3F/     {  mov     di, word ptr [es:bx]    }
  760.       $26/$8E/$5F/$02/ {  mov     ds, word ptr [es:bx+2]  }
  761.       $88/$05/         {  mov     byte ptr [di], al       }
  762.       $26/$FF/$07/     {  inc     word ptr [es:bx]        }
  763.       $5F/             {  pop     di }
  764.       $5B/             {  pop     bx }
  765.       $1F/             {  pop     ds }
  766.       $07/             {  pop     es }
  767.       $3C/$0A/         {  cmp     al, 10 }
  768.       $75/$28/         {  jne     looper }
  769.       $50/             {  push    ax }
  770.       $52/             {  push    dx }
  771.       $51/             {  push    cx }
  772.       $53/             {  push    bx }
  773.       $B4/$03/         {  mov     ah, 3 }
  774.       $B7/$00/         {  mov     bh, 0 }
  775.       $CD/$10/         {  int     10h }
  776.       $80/$FE/$18/     {  cmp     dh, 24 }
  777.       $75/$15/         {  jne     popper }
  778.       $FE/$CE/         {  dec     dh }
  779.       $B7/$00/         {  mov     bh, 0 }
  780.       $B4/$02/         {  mov     ah, 2 }
  781.       $CD/$10/         {  int     10h }
  782.       $B8/$01/$06/     {  mov     ax, 0601h }
  783.       $B7/$07/         {  mov     bh, 7 }
  784.       $B9/$00/$11/     {  mov     cx, 1100h }
  785.       $BA/$4F/$18/     {  mov     dx, 184fh }
  786.       $CD/$10/         {  int     10h }
  787.                        {popper: }
  788.       $5B/             {  pop     bx }
  789.       $59/             {  pop     cx }
  790.       $5A/             {  pop     dx }
  791.       $58/             {  pop     ax }
  792.                        {looper: }
  793.       $9C/             {  pushf }
  794.       $9A/$00/$00/$00/$00/ { call    far [0:0] }
  795.       $CF);            {  iret }
  796. END;  {of IPP}
  797.  
  798.  
  799. {$F+}  {v1.6a Use FAR calls}
  800.  
  801. PROCEDURE NewExitProc2;
  802. { This exit procedure removes the interrupt 29h handler from memory
  803.   and places the cursor at the bottom of the screen. }
  804.   BEGIN
  805.     Reg.AX := $2529;                    {v1.6a}
  806.     Reg.DS := oldSeg;
  807.     Reg.DX := oldOfs;
  808.     MsDos(Reg);
  809.     Window(1,1,80,25);
  810.     GotoXY(1,24);
  811.     TextAttr := $07;
  812.     ClrEol;
  813.     WRITELN('Thank you for using A2Z!');
  814.     ExitProc := OldExitProc2;
  815.   END;  {of NewExitProc2}
  816.  
  817. {$F-}  {v1.6a No FAR calls}
  818.  
  819.  
  820. PROCEDURE ResetBuffer;
  821. { Reset pointers to the text buffer, effectively deleting any text in it }
  822.   BEGIN
  823.     MemW[Seg(bufData):Ofs(bufData)] := bufferOfs;    { Set first 2 bytes
  824.                                   of bufData to point to buffer offset }
  825.     MemW[Seg(bufData):Ofs(bufData)+2] := bufferSeg;  { And next two bytes
  826.                                   to point to buffer segment }
  827.     MemW[Seg(IPP):Ofs(IPP)+21] := Seg(bufData);    { Now point the interrupt
  828.                                   routine to bufData for pointer }
  829.     MemW[Seg(IPP):Ofs(IPP)+26] := Ofs(bufData);    {  to the text buffer }
  830.   END;  {of ResetBuffer}
  831.  
  832.  
  833. function in_Buffer(S: String): INTEGER;
  834.   { This searched the text buffer for the string S,
  835.     and if it's found, returns the offset in the buffer.
  836.     If it's not found, a -1 is returned.
  837.   }
  838.   VAR
  839.     l,m : word;
  840.     x   :  Byte;
  841.   BEGIN
  842.     x := 1;
  843.     l := bufferOfs;
  844.     m := MemW[Seg(bufData):Ofs(bufData)]-bufferOfs;  {v1.6a}
  845.     WHILE (x<=LENGTH(S)) AND (l<=m) DO BEGIN
  846.       IF Mem[bufferSeg:l] = Byte(S[x]) THEN Inc(x)
  847.       ELSE x := 1;
  848.       Inc(l);
  849.     END;
  850.     IF x > LENGTH(S) THEN in_Buffer := l-LENGTH(S)
  851.     ELSE in_Buffer := -1;
  852.   END;  {of in_Buffer}
  853.  
  854.  
  855. PROCEDURE InstallInterruptHandler;
  856.   { Installs the int 29h handler }
  857.   BEGIN
  858.     bufferlen := $4000;                 { Set up a 16k buffer }
  859.     GetMem(BufferPtr,bufferlen);        { Allocate memory pointed at
  860.                                           by BufferPtr }
  861.     bufferSeg := Seg(BufferPtr^);       { Read segment and offset
  862.                                           of buffer for easy access }
  863.     bufferOfs := Ofs(BufferPtr^);
  864.     ResetBuffer;                        { Place these values in the IPP
  865.                                           routine, resetting buffer }
  866.     Reg.AX := $3529;                    {v1.6a DOS svc 35H,
  867.                                          get Int 29H vector}
  868.     MsDos(Reg);
  869.     oldSeg := Reg.ES;                   { Store the segment and offset
  870.                                           of the old vector for later use }
  871.     oldOfs := Reg.BX;
  872.     MemW[Seg(IPP):Ofs(IPP)+90] := Reg.BX;  { And store them }
  873.     MemW[Seg(IPP):Ofs(IPP)+92] := Reg.ES;  { so IPP can call the routine }
  874.  
  875.     Reg.AX := $2529;                    {v1.6a DOS svc 25H,
  876.                                          set Int 29H vector}
  877.     Reg.DS := Seg(IPP);                 { Store segment and offset for IPP.
  878.                                           The +16 is to skip TP stack }
  879.     Reg.DX := Ofs(IPP)+16;              { maintanence routines }
  880.     MsDos(Reg);
  881.  
  882. {$F+}  {v1.6a use FAR calls}
  883.     OldExitProc2 := ExitProc;           { Set up new exit procedure to remove
  884.                                           routine at program termination }
  885.     ExitProc := @NewExitProc2;
  886. {$F-}  {v1.6a No FAR calls}
  887.  
  888.     TextAttr := $07;                    { Clear the screen to white on black}
  889.     ClrScr;
  890.     GotoXY(1,15);                       { Go to line 15 and 16 and draw an
  891.                                           inverse bar which will show the }
  892.     TextAttr := $70;                    { current command being executed. }
  893.     WRITE('DOS COMMAND:');
  894.     ClrEol;  WRITELN;  ClrEol;
  895.     TextAttr := $07;                    { Set text color back
  896.                                           to white on black }
  897.     Window(1,1,80,13);                  { Make active window at top of screen
  898.                                           and home cursor }
  899.     GotoXY(1,1);
  900.     cmdY := 18;                         { Assume the cursor in the lower
  901.                                           window's at the top of window }
  902.   END;  {of InstallInterruptHandler}
  903.  
  904.  
  905. PROCEDURE ExecCommand(Cmd,Parm: String);
  906. { Executes the command in Cmd with command line parameters in Parm.
  907.   This is executed in the lower window }
  908.   VAR
  909.     ox,oy : Byte;  { Upper window X and Y }
  910.   BEGIN
  911.     ResetBuffer;                        { Clear text buffer }
  912.     ox := WhereX;                       { Store upper window X and Y }
  913.     oy := WhereY;
  914.     Window(1,1,80,25);                  { Make entire screen active window }
  915.     GotoXY(14,15);                      { Go to line 14 (COMMAND bar) }
  916.  
  917.     TextAttr := $70;
  918.     WRITE(Cmd,' ',Parm);                { Write the command and parameters
  919.                                           in inverse }
  920.     GotoXY(1,cmdY);                     { Go to location in bottom window }
  921.     TextAttr := $07;                    { Normal text color }
  922.  
  923.     Exec(Cmd,Parm);                     { Execute command }
  924.     execerror := DosExitCode;           {v1.6b remember child process
  925.                                          exit codes}
  926.     IF execerror <> 0                   {v1.6b there was one!}
  927.     THEN STR(execerror,ExecErrStr);     {v1.6b so make the string now}
  928.  
  929.     cmdY := WhereY;                     { Store new Y location }
  930.     GotoXY(14,15);
  931.  
  932.     TextAttr := $70;                    { Erase the COMMAND bar }
  933.     ClrEol;  WRITELN;  ClrEol;
  934.     TextAttr := $07;
  935.  
  936.     Window(1,1,80,13);                  { Reset the upper window }
  937.     GotoXY(ox,oy);                      { Re-position cursor }
  938.   END;  {of ExecCommand}
  939.  
  940.  
  941. function Internal_In_Zip: BOOLEAN;
  942.   {1 call}
  943.   BEGIN
  944.     IF (in_Buffer('.ARC')<>-1)
  945.     OR (in_Buffer('.PAK')<>-1)
  946.     OR (in_Buffer('.ZIP'#13#10' ')<>-1)
  947.     OR (in_Buffer('.ZIP'#13#10'-')<>-1)
  948.     THEN Internal_In_Zip := TRUE
  949.     ELSE Internal_In_Zip := FALSE;
  950.   END;  {of Internal_In_Zip}
  951.  
  952.  
  953.   VAR
  954.     x:       INTEGER;
  955.     L:       STRING[60];
  956.     C:       STRING[10];
  957.     code:    INTEGER;
  958.     Okay:    BOOLEAN;
  959.     T:       TEXT;
  960.     SRec:    SearchRec;
  961.     Z:       ComStr;
  962.     ec:      Byte;
  963.     RC:      CHAR;
  964.     CurWork: String;
  965.  
  966. {$F+}
  967. PROCEDURE Convert(VAR S: SearchRec; P: PathStr);
  968. {$F-}
  969.  
  970.  
  971.   PROCEDURE ArchiveError(N: String);
  972.   {
  973.     Report an archive error if we're working with the top file, otherwise
  974.     set an error flag.
  975.     v1.6a Common code:  We ALWAYS call WriteLnStatus right after
  976.     ArchiveError (with an Indent_Str added to the front).
  977.     Adding this common function right here.
  978.   }
  979.     BEGIN
  980.       IF ConvertingInside THEN BEGIN
  981.         WRITELN(Indent_Spaces + N);  {v1.6a}
  982.         TrickleUpError := TRUE;
  983.       END
  984.       ELSE LogError(N,TRUE);  {v1.6 WriteLn to StatFile also}
  985.     END;  {of ArchiveError}
  986.  
  987.  
  988.   PROCEDURE DeleteDir(P: String);
  989.     {
  990.       Delete all files in the directory named and remove it.
  991.     }
  992.     VAR
  993.       SRec:      SearchRec;
  994.       errorcode: Byte;
  995.     BEGIN
  996.       FindFirst(P+'\*.*',0,SRec);
  997.       WHILE DosError=0 DO BEGIN
  998.         Assign(T, P+'\'+SRec.Name);
  999.         {$I-}  Erase(T);  {$I+}
  1000.         errorcode := IOResult;
  1001.         FindNext(SRec);
  1002.       END;
  1003.       {$I-}  RmDir(P);  {$I+}
  1004.       errorcode := IOResult;
  1005.     END;  {of DeleteDir}
  1006.  
  1007.  
  1008.   PROCEDURE CopyFile(SourceName,DestName: ComStr);
  1009.     {v1.6a Replacing length DIV and * instructions with shifts}
  1010.     VAR
  1011.       Source,Dest: FILE;
  1012.       recsread:    word;
  1013.       buffer:      pointer;
  1014.       bufsize:     word;
  1015.       t:           longint;
  1016.     BEGIN
  1017.       IF MaxAvail>65535 THEN bufsize := 65535 ELSE bufsize := MaxAvail;
  1018.  
  1019.       bufsize := bufsize ShR 10;        {v1.6a}
  1020.       GetMem(buffer, bufsize ShL 10);   {v1.6a}
  1021.       Assign(Source, SourceName);
  1022.       RESET(Source,1024);
  1023.       Assign(Dest,DestName);
  1024.       REWRITE(Dest,1024);
  1025.       for t := 1 TO FileSize(Source) DO BEGIN
  1026.         BlockRead(Source,buffer^,bufsize,recsread);
  1027.         BlockWrite(Dest,buffer^,recsread);
  1028.       END;
  1029.  
  1030.       t := FileSize(Source) ShL 10;     {v1.6a}
  1031.       RESET(Source,1);
  1032.       RESET(Dest,1);
  1033.       Seek(Source,t);
  1034.       Seek(Dest,t);
  1035.  
  1036.       bufsize := bufsize ShL 10;        {v1.6a}
  1037.       REPEAT
  1038.         BlockRead(Source, buffer^, bufsize, recsread);  {v1.6a}
  1039.         BlockWrite(Dest,buffer^,recsread);              {v1.6a}
  1040.       UNTIL recsread = 0;                               {v1.6a}
  1041.  
  1042.       GetFTime(Source, t);
  1043.       SetFTime(Dest, t);
  1044.       CLOSE(Source);
  1045.       CLOSE(Dest);
  1046.  
  1047.       FreeMem(buffer, bufsize);         {v1.6a}
  1048.       Erase(Source);
  1049.     END;  {of CopyFile}
  1050.  
  1051.  
  1052. VAR  {for Convert}
  1053.   N:           NameStr;
  1054.   E:           ExtStr;
  1055.   ArcComment:  STRING[50];
  1056.   filesinarc:  word;
  1057.   unarcedSize: longint;
  1058.   arcedSize:   longint;
  1059.   OCI:         BOOLEAN;
  1060.  
  1061.  
  1062.   PROCEDURE Comment_Common;
  1063.     {v1.6a Common code .. we do this twice}
  1064.     BEGIN
  1065.       ArcComment := '';
  1066.       REPEAT
  1067.         Inc(x);
  1068.       UNTIL CHAR(Mem[bufferSeg:x]) IN [' ',#13,#10];
  1069.       IF CHAR(Mem[bufferSeg:x])=' ' THEN BEGIN
  1070.         REPEAT
  1071.           Inc(x);
  1072.         UNTIL CHAR(Mem[bufferSeg:x])=' ';
  1073.         Inc(x);
  1074.          REPEAT
  1075.           ArcComment := ArcComment+CHAR(Mem[bufferSeg:x]);
  1076.           Inc(x);
  1077.         UNTIL CHAR(Mem[bufferSeg:x]) IN [#10,#13];
  1078.       END;  {had a comment}
  1079.  
  1080.       WHILE ArcComment[LENGTH(ArcComment)]=' ' DO Dec(ArcComment[0]);
  1081.  
  1082.     END;  {of Comment_Common}
  1083.  
  1084.  
  1085.   PROCEDURE Snarf_Digits;
  1086.     {v1.6a more common code}
  1087.     BEGIN
  1088.       C := '';
  1089.       REPEAT
  1090.         C := C+L[1];
  1091.         L := COPY(L,2,255);
  1092.       UNTIL L[1]=' ';
  1093.       WHILE L[1]=' ' DO L := COPY(L,2,255);
  1094.     END;  {of Snarf_Digits}
  1095.  
  1096.  
  1097.     PROCEDURE Build_L;
  1098.       {v1.6a common code}
  1099.       BEGIN
  1100.         REPEAT
  1101.           L := L+CHAR(Mem[bufferSeg:x]);
  1102.           Inc(x);
  1103.         UNTIL CHAR(Mem[bufferSeg:x]) IN [#10,#13];
  1104.       END;  {of Build_L}
  1105.  
  1106.     PROCEDURE Strip_Zeros;
  1107.       {v1.6a strips leading 0's from L (a filesinarc string)}
  1108.       BEGIN
  1109.         WHILE (LENGTH(L) <> 0)
  1110.         AND (L[1] = '0') DO
  1111.           DELETE(L,1,1);
  1112.       END;  {of Strip_Zeros}
  1113.  
  1114.  
  1115.   BEGIN  {Convert}
  1116.     IF TrickleUpError THEN Exit;
  1117.  
  1118.     IF KeyPressed THEN BEGIN
  1119.       RC := ReadKey;
  1120.       IF RC=#27 THEN BEGIN
  1121.         IF ConvertingInside THEN BEGIN
  1122.           TrickleUpError := TRUE;
  1123.           InterruptRequested := TRUE;
  1124.           Exit;
  1125.         END
  1126.  
  1127.         ELSE BEGIN
  1128.           TStr := '*** Conversion interrupted ***';  {v1.6a}
  1129.           LogError(TStr,TRUE);          {v1.6a Writeln to StatFile also}
  1130.           HALT;
  1131.         END;
  1132.       END;
  1133.     END;
  1134.  
  1135.     FSplit(P+S.Name,P,N,E);
  1136.     WritelnStatFil(
  1137.       Indent_Spaces + 'Converting '+S.Name,
  1138.       TRUE);                            {v1.6a Writeln also}
  1139.  
  1140.     IF NOT ConvertingInside THEN BEGIN
  1141.       Inc(filenum);                     {bump file count}
  1142.       WritelnStatFil('', TRUE);         {v1.6a Writeln also}
  1143.       TextAttr := $0F;
  1144.       WRITELN('Converting ',P+S.Name,
  1145.               '  Saved: ',saved,' bytes  File: ',filenum,' of ',numfiles);
  1146.       TextAttr := $07;
  1147.     END
  1148.     ELSE BEGIN
  1149.       WRITE(Indent_Spaces);             {v1.6a}
  1150.       TStr := 'Converting internal file ' + N + E;  {v1.6a}
  1151.       TextAttr := $0F;
  1152.       WRITELN(TStr);                                {v1.6a}
  1153.       TextAttr := $07;
  1154.       WritelnStatFil(Indent_Spaces + TStr,FALSE);   {v1.6a No Writeln}
  1155.     END;
  1156.  
  1157.     IF E='.ZIP' THEN BEGIN
  1158.       WriteStatus('Checking ' + S.Name
  1159.                   + ' for internal files...');  {v1.6a Write also}
  1160.  
  1161.       ExecCommand(PKZIP,'/V '+P+N);
  1162.       IF execerror <> 0 THEN BEGIN      {v1.6b Exec had child process error}
  1163.         WRITELN;
  1164.         ArchiveError('Error ' + ExecErrStr + ' in ZIPfile ' + P+N+E
  1165.                      + '; file skipped.');  {v1.6b}
  1166.  
  1167.         Exit;
  1168.       END;
  1169.  
  1170.       arcedSize := S.size;
  1171.       IF Internal_In_Zip THEN BEGIN
  1172.         WritelnStatFil(' found.',TRUE);      {v1.6a Writeln also}
  1173.  
  1174. {v1.6a Common error string for two possible errors }
  1175.  
  1176.         TStr := 'Error in Zipfile ' + P+N+E+'; file skipped.';  {v1.6a}
  1177.  
  1178.         x := in_Buffer('Searching');
  1179.         IF x=-1 THEN BEGIN
  1180.           ArchiveError(TStr);           {v1.6a}
  1181.           Exit;
  1182.         END;
  1183.  
  1184.         Inc(x,15);
  1185.         Comment_Common;                 {v1.6a do common code}
  1186.  
  1187.         L := '';
  1188.         x := in_Buffer('--------'#13#10);  {v1.6a}
  1189.         IF x=-1 THEN BEGIN
  1190.           ArchiveError(TStr);           {v1.6a unchanged from last error}
  1191.           Exit;
  1192.         END;
  1193.  
  1194.         REPEAT
  1195.           Inc(x);
  1196.         UNTIL CHAR(Mem[bufferSeg:x]) IN ['0'..'9'];
  1197.  
  1198.         Build_L;                        {v1.6a common code}
  1199.  
  1200.         Snarf_Digits;                   {v1.6a builds C}
  1201.         Z := C;                         {v1.6a save unarcedSize a sec}
  1202.  
  1203.         Snarf_Digits;                   {v1.6a builds C}
  1204.  
  1205.         WHILE L[1]<>' ' DO L := COPY(L,2,255);
  1206.         WHILE L[1]=' ' DO L := COPY(L,2,255);
  1207.  
  1208. {  v1.6a  reminder:
  1209.   Z = unarcedSize string
  1210.   L = filesinarc string
  1211.   C = arcedSize string
  1212.   S.size := arcedSize word
  1213.   The only variable we'll use later is arcedSize,
  1214.   so no need to convert the other strings to numbers.
  1215.   The filesinarc string may be 0-padded, so we'll strip
  1216.   those leading 0's.
  1217. }
  1218.         arcedSize := S.size;               {v1.6a}
  1219.  
  1220.         Strip_Zeros;                       {v1.6a strip L's leading 0's}
  1221.  
  1222.         WritelnStatFil(                    {v1.6a}
  1223.           Indent_Spaces + L + 'FILE(s), '  {v1.6a}
  1224.           + C + ' bytes zipped, '          {v1.6a}
  1225.           + Z + ' bytes unzipped', TRUE);  {v1.6a Writeln also}
  1226.  
  1227.         if ArcComment<>''
  1228.         THEN WritelnStatFil(            {v1.6a}
  1229.             Indent_Spaces + 'Zipfile comment: :'
  1230.             + ArcComment + '"', TRUE);     {v1.6a Writeln also}
  1231.  
  1232.         WriteStatus('Unzipping ' + N + E + '...');  {v1.6a Write also}
  1233.  
  1234.         CurWork := CurWork+'\A2Z.$$$';
  1235.         MkDir(CurWork);
  1236.         ExecCommand(PKUNZIP,P+N+' '+CurWork);
  1237.  
  1238.         IF execerror <> 0 THEN BEGIN    {v1.6b}
  1239.           DeleteDir(CurWork);
  1240.           Dec(CurWork[0],8);
  1241.           ArchiveError(#$0D#$0A'Error ' + ExecErrStr   {v1.6b}
  1242.                        + ' unzipping ' + P + N + E
  1243.                        + '; FILE skipped.'); {v1.6a}
  1244. (* v1.6a didn't DO this quite right .. leaving it for now...
  1245.           WriteLnStatus(#$0D#$0A + Indent_Spaces + TStr);  {v1.6a}
  1246. *)
  1247.           Exit;
  1248.         END;
  1249.  
  1250.         WritelnStatFil(' done.', TRUE); {v1.6a Writeln also}
  1251.       END
  1252.  
  1253.       ELSE BEGIN
  1254.         WritelnStatFil(' none found.', TRUE);  {v1.6a Writeln also}
  1255.         ArchiveError(N+E+' did not need to be modified.');  {v1.6a}
  1256.  
  1257.         TrickleUpError := FALSE;
  1258.         Exit;
  1259.       END;
  1260.  
  1261.     END
  1262.     ELSE BEGIN  {PKPak file}
  1263.       WriteStatus('Analyzing ' + N + E + '...'); {v1.6a  Write also}
  1264.  
  1265.       ExecCommand(PKUNPAK,'-V '+P+N+E);
  1266.       WritelnStatFil(' done.', TRUE);   {v1.6a Writeln also}
  1267.  
  1268.       TStr := 'Error ' + ExecErrStr + ' in archive ' + P + N + E  {v1.6b}
  1269.             + '; file skipped.';      {v1.6a}
  1270.  
  1271.       IF execerror <> 0 THEN BEGIN      {v1.6b}
  1272.         ArchiveError(TStr);             {v1.6a}
  1273.         Exit;
  1274.       END;
  1275.  
  1276.       x := in_Buffer('Searching');
  1277.       IF x=-1 THEN BEGIN
  1278.         ArchiveError(TStr);             {v1.6a Same error msg}
  1279.         Exit;
  1280.       END;
  1281.  
  1282.       Inc(x,11);  {v1.6c}
  1283.       Comment_Common;                   {v1.6a common code}
  1284.  
  1285.       L := '';
  1286.       x := in_Buffer(#13#10'---- ');  {v1.6a}
  1287.  
  1288.       IF x=-1 THEN BEGIN
  1289.         ArchiveError(TStr);             {v1.6a same error msg}
  1290.         Exit;
  1291.       END;
  1292.  
  1293.       Inc(x,52);   {v1.6c}
  1294.       Build_L;                          {v1.6a read until CR/LF}
  1295.  
  1296.       Snarf_Digits;                     {v1.6a builds C}
  1297.       TStr := C;                        {v1.6a save filesinarc string}
  1298.  
  1299.       Snarf_Digits;                     {v1.6a builds C}
  1300.       Z := C;                           {v1.6a save unarcedSize string}
  1301.  
  1302.       C := '';
  1303.       REPEAT
  1304.         C := C+L[1];
  1305.         L := COPY(L,2,255);
  1306.       UNTIL L[1] IN [#13,#10,#32];
  1307.  
  1308.       L := TStr;                        {v1.6a restore filesinarc string}
  1309.  
  1310. {  v1.6a  reminder:
  1311.   Z = unarcedSize string
  1312.   L = filesinarc string
  1313.   C = arcedSize string
  1314.   The only variable we'll need later is arcedSize,
  1315.   so that's the only one we'll convert.
  1316.   The filesinarc string may be 0-padded,
  1317.   so we'll strip those leading 0's.
  1318. }
  1319.       Val(C,arcedSize,code);            {v1.6a  We'll need this later}
  1320.  
  1321.       Strip_Zeros;                      {v1.6a Strip L's leading 0's}
  1322.       WritelnStatFil(                   {v1.6a}
  1323.         Indent_Spaces + L + ' file(s), '{v1.6a}
  1324.         + C + ' bytes arced, '
  1325.         + Z + ' bytes unarced', TRUE);  {v1.6a Writeln also}
  1326.  
  1327.       IF ArcComment<>''
  1328.       THEN WritelnStatFil(
  1329.           Indent_Spaces
  1330.           + 'Archive comment: "'
  1331.           + ArcComment + '"', TRUE);   {v1.6a WriteLn also}
  1332.  
  1333.       WriteStatus('Extracting files...');  {v1.6a Write also}
  1334.  
  1335.       CurWork := CurWork+'\A2Z.$$$';
  1336.       MkDir(CurWork);
  1337.       IF E='.ARC' THEN BEGIN
  1338.         ExecCommand(PKUNPAK,P+N+' '+CurWork);
  1339.         Okay := (execerror = 0);        {v1.6b}
  1340.       END;
  1341.  
  1342.       IF E='.PAK' THEN BEGIN
  1343.         ExecCommand(PAK,'e '+P+N+' '+CurWork);
  1344.         Okay := (execerror = 0);        {v1.6b}
  1345.       END;
  1346.  
  1347.       WRITELN(' done.');
  1348.  
  1349.       IF NOT Okay THEN BEGIN
  1350.         ArchiveError('Error ' + ExecErrStr + ' extracting '  {v1.6b}
  1351.               + P + N + E
  1352.               + '; skipping.');         {v1.6a}
  1353.  
  1354.         DeleteDir(CurWork);
  1355.         Dec(CurWork[0],8);
  1356.         Exit;
  1357.       END;
  1358.  
  1359.     END;
  1360.  
  1361.     WritelnStatFil(
  1362.       Indent_Spaces
  1363.       + 'Checking internal files...', TRUE);  {v1.6a Writeln also}
  1364.  
  1365.     OCI := ConvertingInside;
  1366.     ConvertingInside := TRUE;
  1367.     Inc(internalcount);
  1368. {$F+}  {v1.6a need Far calls for this}
  1369.     SearchEngine(CurWork+'\*.*',Archive,Convert,ec);
  1370. {$F-}
  1371.     Dec(internalcount);
  1372.     ConvertingInside := OCI;
  1373.     IF TrickleUpError THEN BEGIN
  1374.       IF InterruptRequested THEN BEGIN
  1375.         DeleteDir(CurWork);
  1376.         Dec(CurWork[0],8);
  1377.         IF ConvertingInside THEN Exit;
  1378.  
  1379.         LogError('*** Conversion interrupted ***',
  1380.                  TRUE);                 {v1.6a Status file also}
  1381.         HALT;
  1382.       END;
  1383.  
  1384.       IF NOT ConvertingInside THEN BEGIN
  1385.         TrickleUpError := FALSE;
  1386.         LogError('Unable to convert '
  1387.                  + P + N + E
  1388.                  + ' due to an internal file error.',
  1389.                  TRUE);                 {v1.6a StatFile output also}
  1390.       END;
  1391.       DeleteDir(CurWork);
  1392.       Dec(CurWork[0],8);
  1393.       Exit;
  1394.     END;
  1395.  
  1396.     CopyFile(P+N+E,P+N+'.A2B');
  1397.     WriteStatus('Creating ZIP file '
  1398.           + N + '.ZIP...');              {v1.6a Write also}
  1399.  
  1400.     Z := P+N+'.ZIP';
  1401.     Assign(T, Z);
  1402.     {$I-}  Erase(T);  {$I+}
  1403.     code := IOResult;
  1404.  
  1405.     IF ArcComment='' THEN
  1406. (* v1.6d
  1407.       ExecCommand(PKZIP,Z + EASwitch + EBSwitch + ' '    {v1.6a}
  1408.                   + CurWork+'\*.*')
  1409. *)
  1410.       ExecCommand(PKZIP,Z + ' '    + CurWork+'\*.*')     {v1.6d}
  1411.     ELSE BEGIN
  1412.       Assign(T, WorkDir+'ZCOMMENT.A2Z');
  1413.       REWRITE(T);
  1414.       WRITELN(T, ArcComment);
  1415.       CLOSE(T);
  1416.       Reg.BX := 0;
  1417.       Reg.AH := $45;
  1418.       MsDos(Reg);
  1419.       code := Reg.AX;
  1420.       RESET(T);
  1421.       Reg.BX := TextRec(T).Handle;
  1422.       Reg.CX := 0;
  1423.       Reg.AH := $46;
  1424.       MsDos(Reg);
  1425. (* v1.6d
  1426.       ExecCommand(PKZIP,Z + EASwitch + EBSwitch + ' -a '  {v1.6a}
  1427.                   + CurWork+'\*.* -z');
  1428. *)
  1429.       ExecCommand(PKZIP,Z + ' -a '  + CurWork+'\*.* -z');  {v1.6d}
  1430.  
  1431.       Reg.BX := code;
  1432.       Reg.CX := 0;
  1433.       Reg.AH := $46;
  1434.       MsDos(Reg);
  1435.       Reg.BX := code;
  1436.       Reg.AH := $3E;
  1437.       MsDos(Reg);
  1438.       CLOSE(T);
  1439.       Erase(T);
  1440.     END;
  1441.  
  1442.     WritelnStatFil(' done.', TRUE);     {v1.6a Writeln also}
  1443.  
  1444.     IF execerror <> 0 THEN BEGIN        {v1.6b}
  1445.       ArchiveError('Error ' + ExecErrStr             {v1.6b}
  1446.                    + ' Unable to create zip file: '  {v1.6b}
  1447.                    + Z + '; file skipped.');   {v1.6a}
  1448.  
  1449.       DeleteDir(CurWork);
  1450.       Dec(CurWork[0],8);
  1451.       CopyFile(P+N+'.A2B',P+N+E);
  1452.       Exit;
  1453.     END;
  1454.  
  1455.     FindFirst(Z,0,SRec);
  1456.     Assign(T, P+N+'.A2B');
  1457.     {$I-}  Erase(T);  {$I+}
  1458.     code := IOResult;
  1459.     IF NOT ConvertingInside THEN saved := saved+(arcedSize-SRec.size);
  1460.     Assign(T, Z);
  1461.     RESET(T);
  1462.     SetFTime(T, S.Time);
  1463.     CLOSE(T);
  1464. { v1.6a no need to do this yet .. it may NOT be needed:
  1465.    STR(arcedSize-SRec.size,C);
  1466. }
  1467.     IF ConvertingInside
  1468.     THEN WritelnStatFil(
  1469.         Indent_Spaces
  1470.         + 'Internal file '
  1471.         + N + E
  1472.         + ' converted.',
  1473.         TRUE)                           {v1.6a Writeln also}
  1474.  
  1475.     ELSE BEGIN  {v1.6a}
  1476.  
  1477.       STR(arcedSize-SRec.size,C);       {v1.6a NOW do this}
  1478.       TStr := 'File ' + P + N + E;      {v1.6a build first part}
  1479.  
  1480.       IF E = '.ZIP'
  1481.       THEN TStr := TStr + ' internally';  {v1.6a build first part}
  1482.  
  1483.       TStr := TStr + ' converted to ZIP, '
  1484.             + C + ' bytes saved.';      {v1.6a}
  1485.       LogError(TStr,TRUE);              {v1.6a StatFile output also}
  1486.     END;
  1487.  
  1488.     DeleteDir(CurWork);
  1489.     Dec(CurWork[0],8);
  1490.   END;  {of Convert}
  1491.  
  1492.  
  1493. PROCEDURE ConvertFiles;
  1494. {
  1495.   This is the main conversion loop of the program.  It will call the convert
  1496.   arc routine from the search engine.
  1497. }
  1498.   VAR
  1499.     l, errorcode : Byte;
  1500.   BEGIN
  1501.     filenum := 0;
  1502.     ConvertingInside := FALSE;
  1503.     internalcount := 0;
  1504.     InterruptRequested := FALSE;
  1505.     saved := 0;
  1506.     TrickleUpError := FALSE;
  1507.     CurWork := COPY(WorkDir,1,PRED(LENGTH(WorkDir)) );  {v1.6a}
  1508.     for l := 1 TO numdirs DO
  1509.     WITH Dir[l] DO
  1510. {$F+}  {v1.6a need FAR calls}
  1511.     IF Below THEN SearchEngineAll(Dir,Name,Archive,Convert,errorcode)
  1512.              ELSE SearchEngine(Dir+Name,Archive,Convert,errorcode);
  1513. {$F-}  {v1.6a No FAR calls}
  1514.   END;  {of ConvertFiles}
  1515.  
  1516.  
  1517. PROCEDURE SummarizeLog;
  1518.   VAR  S : STRING[30];
  1519.   BEGIN
  1520.     STR(saved, S);
  1521.     LogError(S+' bytes saved total.', FALSE);  {v1.6a no Stat File}
  1522.   END;  {of SummarizeLog}
  1523.  
  1524.  
  1525. BEGIN  {main}
  1526.   ReadCommandLine;
  1527.   CheckSubPrograms;
  1528.   OpenLogFile;
  1529.   GetFileEstimates;
  1530.   CheckBreak := FALSE;
  1531.   InstallInterruptHandler;
  1532.   ConvertFiles;
  1533.   SummarizeLog;
  1534. END.
  1535.