Привет. Поможите мне плз написать функцию для получения параметров из строки. Это навроде ParamStr, только получать нужно не из коммандной строки, а из обычной переменной типа String.

Под параметрами я подразумеваю слова, разделенные друг от друга пробелом. Но нужно учитывать, что словом может называться и группа слов, взятых в кавычки.

Пример.

Код

Str:='Слово1 Слово2 Слово3 "Группа слов1" Слово4'; GetParam(3, Str);

Функция GetParam должна вернуть 'Группа слов1' (если первый параметр 3)... Если первый параметр 0, тогда 'Слово1'.

Много раз сам писал такую функцию (выдирал ее из VCL и немного поправлял), она хорошо работала, но к сожалению иногда глючит. А разобраться очень тяжело. Может быть в арсенале WinAPI есть подобного рода функции?

Плз, ну хоть какие-нибудь мысли есть?
Прогу уже готова, осталось только избавиться от глюка.

Код

function GetParam(const str: String; const ind: Integer): String; begin   with TStringList.Create do try    Delimiter:= ' ';    CommaText:= str;    Result:= Strings[ind];  finally    Free;  end; end; procedure TfrmMain.Button2Click(Sender: TObject); begin  ShowMessage(GetParam('Слово1 Слово2 Слово3 "Группа слов1" Слово4', 3)); end;

Это конечно не плохо, только вот размер моей проги не должен превышать 20Kb, в связи с этим приходится юзать WinAPI. Я написал громадную функцию, которая прекрасно работает, когда вызывается не более 2 раз... А потом дает ошибку, почему? Сам не знаю... Вот и жду халявы, может кто подскажет способ по короче да и по проще. Свой код пока давать не хочу: чтобы не сбивать кодеров с мыслей. За сим жду помощи...

Код

function GetParam(s:string; id:integer):string; var c:char; i:integer; cl: integer; d,s1:string; b:boolean; begin d:=s; b:=false; cl:=0; while not b and (d <> '') do  begin   while d[1] = ' ' do Delete(d,1,1);   if d <> ''    then     begin      cl:=0;      i:=Pos(' ', d);      if i = 0       then         s1:=d       else        begin         s1:=Copy(d,1,i-1);         Delete(d,1,i);        end;      b:=(cl-1)=id;     end;  end; if b  then   Result:=s1  else   Result:=''; end;

Вроде так... но не проверял...

Это сообщение отредактировал(а) Pakshin A. S. - 3.1.2005, 19:19

Код

function GetParam(const str: String; const ind: Integer): String; const  QuoteChar = '"';  Delimiter = ' '; var  P, P1: PChar;  S: string;  n: Integer; begin  n:= 0;  P := PChar(str);  while P^ in [#1..' '] do  {$IFDEF MSWINDOWS}    P := CharNext(P);  {$ELSE}    Inc(P);  {$ENDIF}  while P^ <> #0 do begin    if P^ = QuoteChar then      S := AnsiExtractQuotedStr(P, QuoteChar)    else begin      P1 := P;      while (P^ > ' ') and (P^ <> Delimiter) do      {$IFDEF MSWINDOWS}        P := CharNext(P);      {$ELSE}        Inc(P);      {$ENDIF}      SetString(S, P1, P - P1);    end;    if n = ind then begin      Result:= S;      Exit;    end;    Inc(n);    while P^ in [#1..' '] do    {$IFDEF MSWINDOWS}      P := CharNext(P);    {$ELSE}      Inc(P);    {$ENDIF}    if P^ = Delimiter then begin      P1 := P;      {$IFDEF MSWINDOWS}      if CharNext(P1)^ = #0 then      {$ELSE}      Inc(P1);      if P1^ = #0 then      {$ENDIF}        if n = ind then begin          Result:= '';          Exit;        end;        Inc(n);      repeat        {$IFDEF MSWINDOWS}        P := CharNext(P);        {$ELSE}        Inc(P);        {$ENDIF}      until not (P^ in [#1..' ']);    end;  end; end;

Спасибо всем.
Pakshin A. S. - твой код виснет.
Alex - Код работает, но я список uses у меня не должен содержать модуля SysUtils. У меня там только WinSock и Windows. Пробовал расширить твою функцию, добавляя в нее недостающие процедуры из SysUtils, но все равно не получается... Плз, поможи чем можешь!

Цитата(Pakshin @ 3.1.2005, 20:16)

begin     cl:=0;

Вместо этого:

Код

beign  inc(cl);

Pakshin A. S. не пашет... Теперь код не виснет, но мне необходимо сделать так, чтобы группа слов, взятых в кавычки тоже считался одним параметром. У
Alex'а все путем, только вот нужно подключать модуль SysUtils, а мне этого ой как не хотца...

Код

function ExtractQuotedStr(var Src: PChar; Quote: Char): string;  function StrScan(Str: PChar; Chr: Char): PChar;  begin    Result := Str;    while Result^ <> Chr do    begin      if Result^ = #0 then      begin        Result := nil;        Exit;      end;      Inc(Result);    end;  end;  function StrEnd(const Str: PChar): PChar; assembler;  asm          MOV     EDX,EDI          MOV     EDI,EAX          MOV     ECX,0FFFFFFFFH          XOR     AL,AL          REPNE   SCASB          LEA     EAX,[EDI-1]          MOV     EDI,EDX  end; var  P, Dest: PChar;  DropCount: Integer; begin  Result := '';  if (Src = nil) or (Src^ <> Quote) then Exit;  Inc(Src);  DropCount := 1;  P := Src;  Src := StrScan(Src, Quote);  while Src <> nil do   // count adjacent pairs of quote chars  begin    Inc(Src);    if Src^ <> Quote then Break;    Inc(Src);    Inc(DropCount);    Src := StrScan(Src, Quote);  end;  if Src = nil then Src := StrEnd(P);  if ((Src - P) <= 1) then Exit;  if DropCount = 1 then    SetString(Result, P, Src - P - 1)  else  begin    SetLength(Result, Src - P - DropCount);    Dest := PChar(Result);    Src := StrScan(P, Quote);    while Src <> nil do    begin      Inc(Src);      if Src^ <> Quote then Break;      Move(P^, Dest^, Src - P);      Inc(Dest, Src - P);      Inc(Src);      P := Src;      Src := StrScan(Src, Quote);    end;    if Src = nil then Src := StrEnd(P);    Move(P^, Dest^, Src - P - 1);  end; end; function GetParam(const str: String; const ind: Integer): String; const  QuoteChar = '"';  Delimiter = ' '; var  P, P1: PChar;  S: string;  n: Integer; begin  n:= 0;  P := PChar(str);  while P^ in [#1..' '] do  {$IFDEF MSWINDOWS}    P := CharNext(P);  {$ELSE}    Inc(P);  {$ENDIF}  while P^ <> #0 do begin    if P^ = QuoteChar then      S := ExtractQuotedStr(P, QuoteChar)    else begin      P1 := P;      while (P^ > ' ') and (P^ <> Delimiter) do      {$IFDEF MSWINDOWS}        P := CharNext(P);      {$ELSE}        Inc(P);      {$ENDIF}      SetString(S, P1, P - P1);    end;    if n = ind then begin      Result:= S;      Exit;    end;    Inc(n);    while P^ in [#1..' '] do    {$IFDEF MSWINDOWS}      P := CharNext(P);    {$ELSE}      Inc(P);    {$ENDIF}    if P^ = Delimiter then begin      P1 := P;      {$IFDEF MSWINDOWS}      if CharNext(P1)^ = #0 then      {$ELSE}      Inc(P1);      if P1^ = #0 then      {$ENDIF}        if n = ind then begin          Result:= '';          Exit;        end;        Inc(n);      repeat        {$IFDEF MSWINDOWS}        P := CharNext(P);        {$ELSE}        Inc(P);        {$ENDIF}      until not (P^ in [#1..' ']);    end;  end; end;

Единственное эта функция перестала понимать мультибайтовые строки, но они здесь тебе и не нужны.

Код

function GetParam(s:string; id:integer):string; var c:char; i:integer; cl: integer; d,s1:string; b:boolean; begin d:=s; b:=false; cl:=0; while not b and (d <> '') do begin  while d[1] = ' ' do Delete(d,1,1);  if d <> ''   then    begin     inc(cl);     if d[1] <> '"'      then       i:=Pos(' ', d);      else       begin        Delete(d, 1, 1);        i:=Pos('"', d);      end;     if i = 0      then        s1:=d      else       begin        s1:=Copy(d,1,i-1);        Delete(d,1,i);       end;     b:=(cl-1)=id;    end; end; if b then  Result:=s1 else  Result:=''; end;

Это сообщение отредактировал(а) Pakshin A. S. - 4.1.2005, 11:47

Pakshin A. S.всеравно не правильно попробуй обработать строку

Код

ShowMessage(GetParam2('Слово1 Слово2 Слово3 """Группа слов1""" Слово4', 3));

результат должен быть "Группа слов1", а у тебя пустота

Ну... человек не упоминал... Я работал исходя из примера, хотя сделать такую ситуация достаточно просто... потом напишу...

Код

var t:boolean; ...     begin       repeat        Delete(d, 1, 1);       until d[1] <> '"';       t:=(d[1]<>' ') and (d <> '');       i:=Pos('"', d);     end;    if i = 0     then       s1:=d     else      if t then      begin       s1:=Copy(d,1,i-1);       Delete(d,1,i);      end;    b:=(cl-1)=id;

Вроде так...
Добавлено @ 20:53
М-да... хотя бред...

Всем спасибо, Alex юзаю твою функцию...
Вот пример моей старой:

Код

function Params(Index: Integer; CommandLine: String): string; var  P: PChar;  Buffer: array[0..260] of Char;  function GetParamStr(P: PChar; var Param: string): PChar; var  i, Len: Integer;  Start, S, Q: PChar; begin  while True do  begin    while (P[0] <> #0) and (P[0] <= ' ') do      P := CharNext(P);    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;  end;  Len := 0;  Start := P;  while P[0] > ' ' do  begin    if P[0] = '"' then    begin      P := CharNext(P);      while (P[0] <> #0) and (P[0] <> '"') do      begin        Q := CharNext(P);        Inc(Len, Q - P);        P := Q;      end;      if P[0] <> #0 then        P := CharNext(P);    end    else    begin      Q := CharNext(P);      Inc(Len, Q - P);      P := Q;    end;  end;  SetLength(Param, Len);  P := Start;  S := Pointer(Param);  i := 0;  while P[0] > ' ' do  begin    if P[0] = '"' then    begin      P := CharNext(P);      while (P[0] <> #0) and (P[0] <> '"') do      begin        Q := CharNext(P);        while P < Q do        begin          S[i] := P^;          Inc(P);          Inc(i);        end;      end;      if P[0] <> #0 then P := CharNext(P);    end    else    begin      Q := CharNext(P);      while P < Q do      begin        S[i] := P^;        Inc(P);        Inc(i);      end;    end;  end;  Result := P; end; begin  CommandLine:=CommandLine+' ';  Result := '';  if Index = 0 then   begin    while CommandLine[1] = ' ' do     Delete(CommandLine, 1, 1);    Result:=Copy(CommandLine, 1, Pos(' ', CommandLine)-1);   end  else  begin    P := PChar(CommandLine);    while True do    begin      P := GetParamStr(P, Result);      if (Index = 0) or (Result = '') then Break;      Dec(Index);    end;  end; end;