home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / jsage / znode3 / uploads / tpatch.lbr / CHAIN.PZS / CHAIN.PAS
Encoding:
Pascal/Delphi Source File  |  1993-06-07  |  5.0 KB  |  204 lines

  1. (*
  2.  * Chain - replaces former CHAINDU
  3.  * Herbert Oppmann 1/93
  4.  * needs NewChain.INC, Z3Env.INC, NamedDir.INC
  5.  *)
  6.  
  7. {at the beginning, for installation purposes}
  8. {to facilitate installation with a debugger there are labels before each item}
  9. CONST
  10.   (*
  11.    * search path (as in XRUN)
  12.    * First byte is drive (1-16 = A-P), second byte is user (0-31)
  13.    * ORD('$') =24h =36d for current drive/user
  14.    * an entry with drive = 0 terminates the list if there are less than 5 entries
  15.    *)
  16.   IPath_Magic : ARRAY[0..8] OF CHAR = '[INTPATH>';
  17.   IPath : ARRAY[0..4] OF ARRAY[0..1] OF BYTE =
  18.     ((0,0), (0,0), (0,0), (0,0), (0,0));
  19.  
  20.   (*
  21.    * filename of CHN-library (extension .LBR is needed)
  22.    * leave empty if you don't want library search
  23.    *)
  24.   ChainLib_Magic : ARRAY[0..9] OF CHAR = '[CHAINLIB>';
  25.   ChainLib : STRING[22] = '';
  26.  
  27.   (*
  28.    * filename of extended command processor (ECP) that is to be called
  29.    * if CHAIN fails (extension .COM is needed)
  30.    * leave empty if you don't want another ECP to be started
  31.    *)
  32.   CmdProz_Magic : ARRAY[0..8] OF CHAR = '[CMDPROC>';
  33.   CmdProz  : STRING[22] = '';
  34.  
  35. {$I NewChain.INC}
  36. {$I Z3Env.INC}
  37. {$I NamedDir.INC}
  38.  
  39. CONST Dollar = $24;
  40. TYPE  PName = ARRAY[0..10] OF CHAR;
  41.  
  42. VAR
  43.   f : FILE;
  44.   FName : FNameT;
  45.   CmpName : PName;
  46.   i, j : INTEGER;
  47.  
  48.  
  49. PROCEDURE Hallo; {no return}
  50. BEGIN
  51.   WriteLn('Comfortable Chain (C) 8/92 Herbert Oppmann');
  52.   Write('Syntax: CHAIN <DU:/DIR:>name <parameter ...>');
  53.   Halt;
  54. END; {Hallo}
  55.  
  56.  
  57. {search CHN at the given drive/user}
  58. PROCEDURE TryDU;
  59. VAR
  60.   fib : {this is just for having easy access to the parsed filename}
  61.    RECORD
  62.     dummy : ARRAY[0..12] OF BYTE;
  63.     fn : PName;
  64.    END ABSOLUTE f;
  65. BEGIN
  66.   Assign(f, Dir2Du(FName));
  67.   CmpName := fib.fn; {save the parsed name for later use}
  68.   Chain(f);
  69.   {we only come here if something went wrong}
  70.   IF (IORes <>1) THEN ChkIORes;
  71.   {handle only 'File does not exist', report other errors}
  72. END; {TryDU}
  73.  
  74.  
  75. {search CHN along internal path}
  76. PROCEDURE TryInternalPath;
  77. VAR
  78.   d, u : INTEGER;
  79.   TmpFN : FNameT;
  80. BEGIN
  81.   FOR i := 0 TO 5 DO
  82.     BEGIN
  83.     d := IPath[i][0];
  84.     if (d =0) THEN Exit;
  85.     u := IPath[i][1];
  86.     IF (d =Dollar) THEN TmpFN := '' ELSE TmpFN := Chr(d+64);
  87.     IF (u <>Dollar) THEN TmpFN := TmpFN+Chr((u DIV 10)+48)+Chr((u MOD 10)+48);
  88.     IF (TmpFN ='') THEN TmpFN := FName ELSE TmpFN := TmpFN+':'+FName;
  89.     Assign(f, TmpFN);
  90.     Chain(f);
  91.     IF (IORes <>1) THEN ChkIORes;
  92.     END; {FOR}
  93. END; {TryInternalPath}
  94.  
  95.  
  96. {try the library}
  97. PROCEDURE TryLibrary;
  98. TYPE
  99.   DirEntry =
  100.    RECORD
  101.     Status : BYTE;
  102.     Name   : PName;
  103.     Index, Len, Crc,
  104.     CreateD, ChangeD, CreateT,
  105.     ChangeT : INTEGER;
  106.     PadCnt : BYTE;
  107.     Filler : ARRAY[27..31] OF BYTE
  108.    END;
  109. VAR
  110.   dir : ARRAY[0..3] OF DirEntry;
  111.   dirlen : INTEGER;
  112. BEGIN
  113.   IF (ChainLib ='') THEN Exit;
  114.   IF (Pos('.',ChainLib) =0) THEN ChainLib := ChainLib+'.LBR';
  115.   IORes := 0;
  116.   Assign(f, Dir2Du(ChainLib));
  117.   {$I-}
  118.   Reset(f);
  119.   {$I+}
  120.   IF (IORes =1) THEN
  121.     BEGIN
  122.     IORes := 0;
  123.     WriteLn('Chain: Library ',ChainLib,' not found.');
  124.     Exit;
  125.     END;
  126.   IF (IORes <>0) THEN ChkIORes;
  127.   BlockRead(f,dir,1);
  128.   WITH dir[0] DO
  129.     BEGIN
  130.     IF (Status <>0) OR (Name <>'           ') OR (Index <>0) THEN
  131.       BEGIN
  132.       Write('Chain: ',ChainLib,' is no library.');
  133.       Exit;
  134.       END;
  135.     DirLen := Len;
  136.     END;
  137.   i := 1;
  138.   WHILE (DirLen >0) DO
  139.     BEGIN
  140.     WITH dir[i] DO
  141.       IF (Status =0) THEN
  142.         IF Name=CmpName THEN {no return}
  143.           BEGIN
  144.           Seek(f, Index);
  145.           NCLib := Len;
  146.           Chain(f);
  147.           ChkIORes;
  148.           END; {IF, IF, WITH}
  149.     i := Succ(i);
  150.     IF (i >3) THEN
  151.       BEGIN
  152.       i := 0;
  153.       DirLen := Pred(DirLen);
  154.       IF (DirLen >0) THEN BlockRead(f,dir,1);
  155.       END;
  156.     END; {WHILE}
  157. END; {TryLibrary}
  158.  
  159.  
  160. PROCEDURE TryECP;
  161. BEGIN
  162.   IF (CmdProz ='') THEN Exit;
  163.   NCCmdLine := ParamStr(1)+' '+NCCmdLine;
  164.   IF (Pos('.',CmdProz) =0) THEN CmdProz := CmdProz+'.COM';
  165.   Assign(f, Dir2Du(CmdProz));
  166.   Execute(f);
  167.   IF (IORes =1) THEN
  168.     BEGIN
  169.     IORes := 0;
  170.     WriteLn('Chain: ECP ',CmdProz,' not found.');
  171.     Exit;
  172.     END;
  173.   ChkIORes;
  174. END; {TryECP}
  175.  
  176.  
  177. BEGIN {Chain}
  178. {is there something to do?}
  179.   i := ParamCount;
  180.   IF (i =0) THEN Hallo;
  181. {prepare name of the CHN-file}
  182.   FName := ParamStr(1);
  183.   IF (Pos('.',FName) =0) THEN FName := FName+'.CHN';
  184. {build command line}
  185.   NCCmdLine := '';
  186.   j := 2;
  187.   WHILE (j <=i) DO
  188.     BEGIN
  189.     NCCmdLine := NCCmdLine+' '+ParamStr(j);
  190.     j := Succ(j);
  191.     END;
  192.   TryDU;             {given drive/user}
  193.   {if a DU:/DIR: was given we don't search}
  194.   i := Pos(':',FName);
  195.   IF (i =0) THEN
  196.     BEGIN
  197.     TryInternalPath; {internal path}
  198.     TryLibrary;      {Library. TryDU must be called first because of CmpName}
  199.     TryECP;          {other command processor}
  200.     END; {IF}
  201.   IORes := 0;
  202.   WriteLn('Chain: ',FName,' not found.');
  203. END. {Chain}
  204.