home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / d / drcpas10.zip / PARAMTRS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-17  |  4KB  |  170 lines
  1. {$A+,B-,D-,F-,I-,L-,N-,O-,R-,S+,V-}
  2. unit Paramtrs;
  3.  
  4. (* by David R. Conrad, for Turbo Pascal 5.5
  5.  
  6.    This code is not copyrighted, you may use it freely.
  7.    There are no guarantees, either expressed or implied,
  8.    as to either merchantability or fitness for a particular
  9.    purpose.  The author's liability is limited to the amount
  10.    you paid for it.
  11.  
  12.    David R. Conrad, 17 Nov 92
  13.    David_Conrad@mts.cc.wayne.edu
  14.    dave@michigan.com
  15. *)
  16.  
  17. interface
  18.  
  19. (* paramcount and paramstr, as usual, except:
  20.  
  21.    program one two"three \"four\" five" -q\" \"six\"
  22.    is parsed as 'one', 'two', 'three "four" five', '-q"', '"six"'
  23.  
  24.    In other words, quotes surround parameters which may contain spaces,
  25.    and backslashes escape quotes, but backslashes do not escape other
  26.    backslashes, so it isn't possible to get the literal sequence \" in
  27.    a parameter.
  28. *)
  29.  
  30. function ParamCount : word;
  31. function ParamStr(index : word) : string;
  32.  
  33. implementation
  34.  
  35. uses dos, tools;
  36.  
  37. type
  38.   paramstring = string[128];
  39.  
  40. var
  41.   prmstrptr : ^paramstring;
  42.   prmstr : paramstring;
  43.  
  44. function ParamCount : word;
  45. var
  46.   i, p : integer;
  47. begin
  48.   p := 0;
  49.   i := 1;
  50.   while (i <= length(prmstr)) do
  51.     begin
  52.       case prmstr[i] of
  53.         ' ' : ;
  54.         '"' : if (prmstr[i-1] <> '\') then
  55.                 begin
  56.                   inc (p);
  57.                   repeat
  58.                     inc (i);
  59.                   until (i >= length(prmstr)) or
  60.                         ((prmstr[i] = '"') and (prmstr[i-1] <> '\'));
  61.                 end;
  62.       else
  63.         if (prmstr[i-1] = ' ') or
  64.            ((prmstr[i-1] = '"') and (prmstr[i-2] <> '\')) then
  65.           inc (p);
  66.       end;
  67.       inc (i);
  68.     end;
  69.   ParamCount := p;
  70. end;
  71.  
  72. function GetNameFromEnv : string;
  73. var
  74.   c : ^char;
  75.   w : ^word;
  76.   last : char;
  77.   name : string;
  78.   extra : word;
  79. begin
  80.   w := ptr(prefixseg,$2C);
  81.   c := ptr(w^,0);
  82.   repeat
  83.     last := c^;
  84.     IncPtr (pointer(c));
  85.   until (last = #0) and (c^ = #0);
  86.   IncPtr (pointer(c));
  87.   extra := ord(c^); (* lsb *)
  88.   IncPtr (pointer(c));
  89.   extra := extra + (ord(c^) SHL 8); (* msb *)
  90.   if (extra = 0) then (* if no extra strings in environment *)
  91.     begin
  92.       GetNameFromEnv := '';
  93.       exit;
  94.     end;
  95.   IncPtr (pointer(c));
  96.   name := '';
  97.   while (c^ <> #0) do
  98.     begin
  99.       name := name + c^;
  100.       IncPtr (pointer(c));
  101.     end;
  102.   GetNameFromEnv := name;
  103. end;
  104.  
  105. function ParamStr(index : word) : string;
  106. var
  107.   i, p : integer;
  108.   param : string;
  109. begin
  110.   if (index = 0) then (* handle ParamStr(0) *)
  111.     begin
  112.       if lo(dosversion) < 3 then
  113.         ParamStr := ''
  114.       else
  115.         ParamStr := GetNameFromEnv;
  116.       exit;
  117.     end;
  118.   p := 0;
  119.   i := 1;
  120.   while (i <= length(prmstr)) and (p < index) do
  121.     begin
  122.       case prmstr[i] of
  123.         ' ' : ;
  124.         '"' : if (prmstr[i-1] <> '\') then
  125.                 begin
  126.                   inc (p);
  127.                   inc (i);
  128.                   param := '';
  129.                   while (i <= length(prmstr)) and
  130.                         ((prmstr[i] <> '"') or (prmstr[i-1] = '\')) do
  131.                     begin
  132.                       if (prmstr[i] = '"') then
  133.                         param[length(param)] := prmstr[i]
  134.                       else
  135.                         param := param + prmstr[i];
  136.                       inc (i);
  137.                     end;
  138.                 end;
  139.       else
  140.         if (prmstr[i-1] = ' ') or (prmstr[i-1] = '"') then
  141.           begin
  142.             inc (p);
  143.             param := '';
  144.             while (i <= length(prmstr)) and (prmstr[i] <> ' ') and
  145.                   ((prmstr[i] <> '"') or (prmstr[i-1] = '\')) do
  146.               begin
  147.                 if prmstr[i] = '"' then
  148.                   param[length(param)] := prmstr[i]
  149.                 else
  150.                   param := param + prmstr[i];
  151.                 inc (i);
  152.               end;
  153.             if (i <= length(prmstr)) and
  154.                ((prmstr[i] = '"') and (prmstr[i-1] <> '\')) then
  155.               dec (i);
  156.           end;
  157.       end;
  158.       inc (i);
  159.     end;
  160.   if (p = index) then
  161.     ParamStr := param
  162.   else
  163.     ParamStr := '';
  164. end;
  165.  
  166. begin
  167.   prmstrptr := ptr(prefixseg,$80);
  168.   prmstr := prmstrptr^;
  169. end.
  170.