home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1994 September / Simtel-MSDOS-Sep1994-CD2.iso / disc2 / turbopas / pastools.pas < prev    next >
Pascal/Delphi Source File  |  1984-03-20  |  5KB  |  189 lines
  1. 20-Mar-84 20:48:17-PST,5273;000000000001
  2. Return-Path: <b-davis@utah-cs>
  3. Received: FROM utah-cs BY USC-ISIB.ARPA WITH TCP ; 20 Mar 84 20:46:17 PST
  4. Received: by utah-cs.ARPA (4.19/3.33.3)
  5.     id AA24179; Tue, 20 Mar 84 21:40:08 mst
  6. Date: Tue, 20 Mar 84 21:40:08 mst
  7. From: b-davis@utah-cs (Brad Davis)
  8. Message-Id: <8403210440.AA24179@utah-cs.ARPA>
  9. To: info-ibmpc@usc-isib
  10. Subject: New Tools for MS-Pascal
  11.  
  12.  
  13. I have three routines that the readers might be interested in.
  14.  
  15.     ENV (const s1: lstring; var s2: lstring);
  16.         Returns the value of s1 from the current
  17.         enviroment.  See the SET command.  If
  18.         s1 were COMSPEC then s2 probably would be
  19.         C:\COMMAND.COM for an XT.
  20.  
  21.     ARGC : integer;
  22.         Returns the count of the parameters on the 
  23.         command line.  Counts the program name as
  24.         one of the parameters, e.g.  C>FOO BAR  would
  25.         return 2.
  26.  
  27.     ARGV (i: integer; var s: lstring);
  28.         I is the position of the parameter to return.
  29.         In the example above ARGV(1,s) would return
  30.         BAR in s.  Since MS-DOS doesn't give the 
  31.         program name like UNIX, ARGV(0,s) would give
  32.         the null string in s.  
  33.  
  34.  
  35. ARGC and ARGV match the Berkely Pascal conventions for the same
  36. named pre-declared routines.  They also match the C conventions
  37. for the parameters to main().
  38.  
  39. All you need to do to use them is to declare them external in
  40. your program and link them to your program.  If you have any 
  41. questions just write.
  42.  
  43.  
  44.                 Brad Davis
  45.  
  46. P.S.  Sorry if the code is cryptic.  I usually don't spend time
  47.       commenting my hacks.  I will answer any questions anyone
  48.       might have.
  49.  
  50.  
  51. ------------------------------------------------------------------------
  52. {$DEBUG-}
  53. INTERFACE;
  54. UNIT
  55.     command_line(argc,argv,env);
  56.  
  57.     function argc: integer;
  58.     procedure argv(num: integer; var s: lstring);
  59.     procedure env(var inps,outs: lstring);
  60.  
  61. END;
  62. IMPLEMENTATION OF command_line;
  63. CONST
  64.     CR = chr(13);
  65.     PARAM = #80;
  66.     ENVOFF = #2C;
  67. TYPE
  68.     smallstring = lstring(40);
  69.     alphaarray = super array[0..*] of smallstring;
  70. VAR
  71.     doparse: boolean;
  72.     doenv: boolean;
  73.     parsecnt: integer;
  74.     envcnt: integer;
  75.     arguments: ^alphaarray;
  76.     environment: ^alphaarray;
  77.     CESXQQ [EXTERN]: WORD;
  78. VALUE
  79.     doparse := true;
  80.     doenv:= true;
  81.  
  82.     procedure parsecommand;
  83.     var
  84.         i,j,k: integer;
  85.         doskip: boolean;
  86.         a: ads of lstring(255);
  87.     begin
  88.         doparse := false;
  89.         a.s := CESXQQ;
  90.         a.r := PARAM;
  91.         parsecnt := 1;
  92.         i := 1;
  93.         while i <= (ord(a^.len)) do begin
  94.             while a^[i] = ' ' do i := i + 1;
  95.             parsecnt := parsecnt + 1;
  96.             while (a^[i] <> ' ') and (a^[i] <> CR) do i := i + 1;
  97.         end;
  98.         new(arguments,parsecnt-1);
  99.         i := 1;
  100.         arguments^[0] := null;  { MS-DOS doesn't give us the program name }
  101.         j := 0;
  102.         while i <= (ord(a^.len)) do begin
  103.             while a^[i] = ' ' do i := i + 1;
  104.             j := j + 1;
  105.             k := 1;
  106.             while (a^[i] <> ' ') and (a^[i] <> CR) do begin
  107.                 arguments^[j][k] := a^[i];
  108.                 i := i + 1;
  109.                 k := k + 1;
  110.             end;
  111.             arguments^[j].len := wrd(k-1);
  112.         end;
  113.     end;
  114.  
  115.     procedure getenvironment;
  116.     var
  117.         i,j,k: integer;
  118.         a: adsmem;
  119.         offset: ads of word;
  120.     begin
  121.         doenv := false;
  122.         offset.s := CESXQQ;
  123.         offset.r := ENVOFF;
  124.         a.s := offset^;
  125.         a.r := 0;
  126.         i := 0;
  127.         envcnt := 0;
  128.         while a^[wrd(i)] <> 0 do begin
  129.             envcnt := envcnt + 1;
  130.             while a^[wrd(i)] <> 0 do i := i + 1;
  131.             i := i + 1;
  132.         end;
  133.         new(environment,envcnt);
  134.         i := 0;
  135.         j := 0;
  136.         while a^[wrd(i)] <> 0 do begin
  137.             k := 1;
  138.             while a^[wrd(i)] <> 0 do begin
  139.                 environment^[j][k] := chr(a^[wrd(i)]);
  140.                 i := i + 1;
  141.                 k := k + 1;
  142.             end;
  143.             environment^[j].len := wrd(k-1);
  144.             j := j + 1;
  145.             i := i + 1;
  146.         end;
  147.     end;
  148.  
  149.     function argc{: integer};
  150.     begin
  151.         if doparse then parsecommand;
  152.         argc := parsecnt;
  153.     end;
  154.  
  155.     procedure argv{num: integer; var s: lstring};
  156.     begin
  157.         if doparse then parsecommand;
  158.         if num < parsecnt then
  159.             movel(adr arguments^[num],adr s,arguments^[num].len+1)
  160.         else
  161.             s.len := 0;
  162.     end;
  163.  
  164.     procedure env{var inps,outs: lstring};
  165.     var
  166.         i,j: integer;
  167.         s1,s2: lstring(255);
  168.     begin
  169.         if doenv then getenvironment;
  170.         for i := 1 to ord(inps.len) do
  171.             if (inps[i] >= 'a') and (inps[i] <= 'z') then
  172.                 s1[i] := chr(ord(inps[i]) - ord('a') + ord('A'))
  173.             else
  174.                 s1[i] := inps[i];
  175.         s1.len := inps.len;
  176.         outs.len := 0;
  177.         for i := 0 to envcnt-1 do begin
  178.             s2 := environment^[i];
  179.             j := positn('=',s2,1);
  180.             delete(s2,j,ord(s2.len)-j+1);
  181.             if s2 = s1 then begin
  182.                 movel(adr environment^[i],adr outs,environment^[i].len+1);
  183.                 delete(outs,1,j);
  184.             end;
  185.         end;
  186.     end;
  187.  
  188. END.
  189.