[fpc-pascal] TStringList Bug?

[Graeme Geldenhuys]

On 26/09/06, Jeremy Cowgar <jeremy at cowgar.com> wrote:
> Thanks for the info though, I'll figure another way.
>
> Jeremy

Try the following approach:

----------------------------------------------
function tiNumToken(const pStrValue, pStrToken : string) : integer;
var
  i, iCount : integer;
  lsValue : string;
begin
  Result := 0;
  if pStrValue = '' then
    Exit; //==>

  iCount := 0;
  lsValue := pStrValue;
  i := pos(pStrToken, lsValue);
  while i <> 0 do begin
    delete(lsValue, i, length(pStrToken));
    inc(iCount);
    i := pos(pStrToken, lsValue);
  end;
  Result := iCount + 1;
end;


function tiToken(const pStrValue, pStrToken : string; const pIntNum :
integer) : string;
var
  i, iCount, iNumToken : integer;
  lsValue : string;
begin
  result := '';

  iNumToken := tiNumToken(pStrValue, pStrToken);
  if pIntNum = 1 then begin
    if pos(pStrToken, pStrValue) = 0 then result := pStrValue
    else result := copy(pStrValue, 1, pos(pStrToken, pStrValue)-1);
    end
  else if (iNumToken < pIntNum-1) or (pIntNum<1) then begin
    result := '';
    end
  else begin

    { Remove leading blocks }
    iCount := 1;
    lsValue := pStrValue;
    i := pos(pStrToken, lsValue);
    while (i<>0) and (iCount<pIntNum) do begin
      delete(lsValue, 1, i + length(pStrToken) - 1);
      inc(iCount);
      i := pos(pStrToken, lsValue);
    end;

    if (i=0) and (iCount=pIntNum) then result := lsValue
    else if (i=0) and (iCount<>pIntNum) then
      result := ''
    else
      result := copy(lsValue, 1, i-1);
  end;
end;

----------------------------------------------

Below is the Unit Tests explaining how it works and expected results

--------------------------------------------
procedure TTestTIUtils.tiNumToken ;
begin
  CheckEquals( 0, tiUtils.tiNumToken( '', ',' ), 'Failed on 1' ) ;
  CheckEquals( 1, tiUtils.tiNumToken( 'adf adf', ',' ), 'Failed on 2' ) ;
  CheckEquals( 2, tiUtils.tiNumToken( 'adf,', ',' ), 'Failed on 3' ) ;
  CheckEquals( 2, tiUtils.tiNumToken( 'adf,adf', ',' ), 'Failed on 4' ) ;
  CheckEquals( 3, tiUtils.tiNumToken( 'adf,adf,adf', ',' ), 'Failed on 5' ) ;
end ;


procedure TTestTIUtils.tiToken ;
begin
  CheckEquals( '', tiUtils.tiToken( '', ',', 1 ), 'Failed on 1' ) ;
  CheckEquals( 'a', tiUtils.tiToken( 'a,b,c', ',', 1 ), 'Failed on 2' ) ;
  CheckEquals( 'b', tiUtils.tiToken( 'a,b,c', ',', 2 ), 'Failed on 3' ) ;
  CheckEquals( 'c', tiUtils.tiToken( 'a,b,c', ',', 3 ), 'Failed on 4' ) ;
  CheckEquals( '', tiUtils.tiToken( 'a,b,c', ',', 4 ), 'Failed on 5' ) ;
  CheckEquals( 'aa', tiUtils.tiToken( 'aa,bb,cc', ',', 1 ), 'Failed on 6' ) ;
  CheckEquals( 'bb', tiUtils.tiToken( 'aa,bb,cc', ',', 2 ), 'Failed on 7' ) ;
  CheckEquals( 'cc', tiUtils.tiToken( 'aa,bb,cc', ',', 3 ), 'Failed on 8' ) ;
  CheckEquals( '', tiUtils.tiToken( 'aa,bb,cc', ',', 4 ), 'Failed on 9' ) ;
end ;

---------------------------------------------

Basically you can do a simple for loop:

for i := 1 to tiNumToken(string, '|') do
   stringvalue :=  tiToken(string, '|', i);
   ....



Regards,
  - Graeme -