#pas
function GetTok(var s:string; const c:char):string; // в s получаем указатель на исходную строку и символ
var p:integer;
begin
   p := Pos(c,s);                     // получаем позицию вхождения
   if p > 0 then                       // есть вхождение
     begin
       Result := Copy(s,1,p-1); // создаётся новая строка с указателем в Result и длиной p-1
       if p = Length(s) then       // проверяем на конец строки
         s := '                          // Да, конец - переносим признак конца строки 
                                           // на место первого символа 
                                           // и указатель на пустую строку автоматом уничтожается
       else Delete(s,1,p);          // не конец: СМЕЩАЕМ (ПЕРЕЗАПИСЫВАЕМ) ВСЮ СТРОКУ от найденого Pos до конца строки- 
                                            //вот это основной тормоз. Указатель на строку отстается прежний
     end
   else Result := s;                 //нет вхождения. В Result значение указателя исходной строки. 
end;

function FParse(var S: string; const Delimiters: char): string;
var
  Pos : Integer;
  I, J : Integer;
  P, F: PChar;
begin
  P := PChar(S);
  Pos := -1;
  F := StrScan(P, Delimiters);
  J := -1;
  if F <> nil then
    J := Integer(F) - Integer(P) + 1;
  if (J > 0) and ((Pos < 0) or (J < Pos)) then Pos := J;
  Result := S;
  if Pos <= 0 then Pos := Length(S) + 1;
  S := CopyEnd(Result, Pos + 1);
  Result := Copy(Result, 1, Pos - 1);
end;

   Pos := -1;
.....
    J := Integer(F) - Integer(P) + 1;
  if (J > 0) and ((Pos < 0) or (J < Pos)) then Pos := J;

//---------------- Функция обратного парсирования строки ----------------------- 

function RParse(var S: string; const Delimiters: char): string;
var
  I, Pos: integer;
  P, F: PChar;
begin
  P := PChar(S);
  F := StrRScan(P, Delimiters);
  if F <> nil then
  begin
    Pos := Integer(F) - Integer(P);
    if Pos <= 0 then Pos := -1;    
  end  
  else
    Pos := -1;    
  Result := S;
  S := Copy(Result, 1, Pos);
  Result := CopyEnd(Result, Pos + 2);
end;

//------------------------------------------------------------------------------
//
//------------ Исправленная функция прямого парсирования строки ----------------
function FParse(var S: string; const Delimiters: char): string;
var
  I, Pos: Integer;
  P, F: PChar;
begin
  P := PChar(S);
  F := StrScan(P, Delimiters);
  if F <> nil then
  begin
    Pos := Integer(F) - Integer(P) + 1;
    if Pos <= 0 then Pos := Length(S) + 1;
  end  
  else
    Pos := Length(S) + 1;    
  Result := S;
  S := CopyEnd(Result, Pos + 1);
  Result := Copy(Result, 1, Pos - 1);
end;

//------------------------------------------------------------------------------

#pas
function FParse(var S: string; const Delimiters: char): string;
var
  I, Pos: Integer;
  P, F: PChar;
begin
  P := PChar(S);
  F := StrScan(P, Delimiters);
  if F <> nil then
  begin
    Pos := Integer(F) - Integer(P) + 1;
    if Pos <= 0 then Pos := Length(S) + 1;   //Когда сработает эта строка если  if F <> nil ? 
  end  
  else
    Pos := Length(S) + 1;      //  ??
  Result := S;
  S := CopyEnd(Result, Pos + 1);
  Result := Copy(Result, 1, Pos - 1);
end;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function StrScan(Str: PChar; Chr: Char): PChar; assembler;
asm
        PUSH    EDI
        PUSH    EAX
        MOV     EDI,Str
        OR      ECX, -1
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        POP     EDI
        XCHG    EAX, EDX
        REPNE   SCASB

        XCHG    EAX, EDI
        POP     EDI

        JE      @@1
        MOV     EAX,1
@@1:    DEC     EAX
end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF};

function GetTok(var S: string; const c: char): string;
var
  I, Pos: Integer;
  P, F: PChar;
begin
  P := PChar(S);
  F := StrScan(P, c);
  if F <> nil then
  begin
    Pos := Integer(F) - Integer(P) + 1;
    if Pos <= 0 then Pos := Length(S) + 1;  
  end  
  else
    Pos := Length(S) + 1;    
  Result := S;
  S := CopyEnd(Result, Pos + 1);
  Result := Copy(Result, 1, Pos - 1);
end;