Subject: Substrings from a string

79. *****
 Q: How do I extract (parse) substrings from an input string?

 A: Carefully study these two routines which I have included in
 19593 Jun 1 12:12 ftp://garbo.uwasa.fi/pc/research/simirr10.zip
 simirr10.zip Deriving IRR from ARR: A Simulation Testbench, TS+IV
They use space (and anything in ascii below it) as the separator.
Change the while tests if you wish to have a different set of
separators.
  (* Number of substrings in a string *)
  function PARSENFN (sj : string) : integer;
  var i, n, p : integer;
  begin
    p := Length(sj);
    n := 0;
    i := 1;
    repeat
      while (sj[i] <= #32) and (i <= p) do Inc(i);
      if i > p then begin parsenfn := n; exit; end;
      while (sj[i] > #32) and (i <= p) do Inc(i);
      Inc(n);
      if i > p then begin parsenfn := n; exit; end;
    until false;
  end;  (* parsenfn *)
  {}
  (* Get substrings from a string *)
  function PARSERFN (sj : string; PartNumber : integer) : string;
  var i, j, n, p : integer;
      stash      : string;
  begin
    if (PartNumber < 1) or (PartNumber > PARSENFN(sj)) then
      begin PARSERFN := ''; exit; end;
    p := Length(sj);
    n := 0;
    i := 1;
    repeat
      while (sj[i] <= #32) and (i <= p) do Inc(i);
      Inc(n);
      if n = PartNumber then
        begin
          j := 0;
          while (sj[i] > #32) and (i <= p) do
            begin
              Inc(j);
              stash[0] := chr(j);
              stash[j] := sj[i];
              Inc(i);
            end;
          PARSERFN := stash;
          exit;
        end
       else
         while (sj[i] > #32) and (i <= p) do Inc(i);
    until false;
  end;  (* parserfn *)
  {}
  {... A separate, but useful function from the same package ...}
  (* Delete trailing white spaces etc rubble from a string *)
  function TRAILFN (sj : string) : string;
  var i : byte;
  begin
    i := Length (sj);
    while (i > 0) and (sj[i] <= #32) do i := i - 1;
    sj[0] := chr(i); trailfn := sj;
  end;  (* trailfn *)
  {}
  {... Another separate, but useful function from the same package ...}
  (* Delete leading white spaces etc subble from a string *)
  function LEADFN (sj : string) : string;
  var i, p : byte;
  begin
    p := Length (sj); i := 1;
    while (i <= p) and (sj[i] <= #32) do i := i + 1;
    leadfn := Copy (sj, i, p-i+1);
  end;  (* leadfn *)
--------------------------------------------------------------------