Поиск по строке

[kettanaito]

Легкий вопрос, но все же: как найти все присущие в строке подстроки и записать индекс (начало) каждой.

Т.е. если мы имеем строку "Франция - прекрасная страна. Именно Франция бла-бла-бла". В результате должны получить к-ство найденных: 2, позиции найденных 1,37 (идеально было бы записать их в массив и получать индекс по нумерованию).

Можно через RichEdit, не принципиально.

[Аватар]

см функцию PosEx

[NetSpace]

const ns='Франция';
var str:string;//это ваша строка
     i,cnt:=0; 
     p:array[1..10000]of Integer;//массив позиций нужного слова
i:=0;
cnt:=0
while i<=(Length(str)-Length(ns)) do
begin
   i:=i+1;
   if(Pos('Франция',str)<>0)then
   begin
      cnt:=cnt+1;
      array[cnt]:=i;
   end;
end;

[Аватар]

NetSpace не сработает

  s:='Франция - прекрасная страна. Именно Франция бла-бла-бла';
  i:=1;
  j:=PosEx('ФРАНЦИЯ',AnsiUpperCase(s),1);
  while j>0 do begin
    //здесь записываем в массив j
    i:=j+Length('ФРАНЦИЯ');
    j:=PosEx('ФРАНЦИЯ',AnsiUpperCase(s),i);
  end;

[_Troy]

var
  i: integer;
  result: array of word;
  s1, s2: String;
begin
  s1 := 'Франция - прекрасная страна. Именно Франция бла-бла-бла';
  s2 := 'Франция';
  while i <> 0 do
  begin
    i := Pos(s2, s1);
    if i > 0 then
    begin
      SetLength(result, length(result) + 1);
      result[length(result) - 1] := i + (length(s2) * (length(result) - 1));
      delete(s1, i, length(s2));
      i := -1;
    end;
  end;
end.

элементы result содержат позиции вхождения в исходную строку, т.е. 1 и 37

[_Troy]

Аватар, твой способ получше будет. Эх, жаль не знал про PosEx...

[kettanaito]

Пример Аватара хорош, но так и не разобрался с записью результатов в массив. При попытке это сделать вылетает ошибка (да и результаты идут пустые, т.е. нули).

Пример _Troy возвращает нужный индекс (но и один лишний ноль в качестве найденного индекса) и так же не записывается в массив.

[_Troy]

Сообщение от kettanaito

Пример Аватара хорош, но так и не разобрался с записью результатов в массив. При попытке это сделать вылетает ошибка (да и результаты идут пустые, т.е. нули).

Пример _Troy возвращает нужный индекс (но и один лишний ноль в качестве найденного индекса) и так же не записывается в массив.

Чего у тебя не записывает? Как мой пример, так и пример Аватар, работают отлично. И как мой вариант не пишет в массив, когда там явно указано как он записывает? И откуда у тебя вообще ноль взялся?

Вот для проверки

for i := 0 to high(result) do
   ListBox1.items.add(IntToStr(result[i]));

Индексы, именно для твоего примера, равны: 1, 37

Вот пример Аватар

var
  result: array of Integer;
begin
  s := 'Франция - прекрасная страна. Именно Франция бла-бла-бла';
  i := 1;
  j := PosEx('ФРАНЦИЯ', AnsiUpperCase(s), 1);
  while j > 0 do 
  begin
    //здесь записываем в массив j
    SetLength(result, Length(result) + 1);
    result[Length(result) -1 ] := j;
    i := j + Length('ФРАНЦИЯ');
    j := PosEx('ФРАНЦИЯ', AnsiUpperCase(s), i);
  end;
end;

[Serge_Bliznykov]

kettanaito
пример Аватар вполне себе хорош.
Не вижу в нём проблем.
Давайте свой код, как Вы его модернизировали так, чтобы он в массив писал.. (я на 99.99% уверен, что именно в этом у Вас "косяк").

[Lesha]

uses StrUtils;

{ ... }

function Pos_Ultimate(const substr, str: string; var codes: Array of Integer):integer;
var p:integer;
begin
  result:=0;
  if length(str)>0 then begin
    p:=pos(substr,str);
    while p>0 do begin
     codes[result]:=p;
     p:=PosEx(substr,str, codes[result]+1);
     inc(result);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var cod: array of Integer; count,i: integer; s:string;
begin
  SetLength(cod,100);
  count:=Pos_Ultimate('Франция',
    'Франция - прекрасная страна. Именно Франция бла-бла-бла',
    cod);
  if (count=0) then
    ShowMessage('Нет совпадений')
  else begin
    s:='';
    for i := 0 to count - 1 do
      s:=s+inttostr(cod[i])+', ';
    ShowMessage(s);
  end;
end;