Можно ли прочесть скриптом из текста в юникоде, отдельное слово?
что-то вроде пишут "Продам хай 76", а скрипт реагировал только на слово "хай" или "76"?
Пытался написать что-то в этом роде... не работает, вот решил у вас спросить)
Код:
begin
if fromserver and (connectname=Name) and (pck[1]=#$4A) and (ReadS(10)=Name) then
begin
j:=26;
for i:=1 to listcount do begin
text:=ReadS(j);
if (text='стоп') then
begin
Say(text);
end;
end;
j:=(j+2);
end;
end;
// стандартная дельфи функция, возвращает позицию i слова 'строка' в строке s
s:='Это тестовая строка для поиска слова';
i:= pos('строка',s); // pos - регистрозависимая фун-я!
//---------------------------------------------
// тоже самое что и Pos, но поиск идет с конца строки
function LastPos(SearchStr, Str: string): Integer;
var
i: Integer;
TempStr: string;
begin
Result := Pos(SearchStr, Str);
if Result = 0 then Exit;
if (Length(Str) > 0) and (Length(SearchStr) > 0) then
begin
for i := Length(Str) + Length(SearchStr) - 1 downto Result do
begin
TempStr := Copy(Str, i, Length(Str));
if Pos(SearchStr, TempStr) > 0 then
begin
Result := i;
break;
end;
end;
end;
end;
//---------------------------------------------
// Ищет следующее вхождение строки с определенной позиции
function NextPos(SearchStr, Str: string; Position: Integer): Integer;
begin
Delete(Str, 1, Position - 1);
Result := Pos(SearchStr, upperCase(Str));
if Result = 0 then Exit;
if (Length(Str) > 0) and (Length(SearchStr) > 0) then
Result := Result + Position + 1;
end;
//---------------------------------------------
function NextPosRel(SearchStr, Str: string; Position: Integer): Integer;
begin
Delete(Str, 1, Position - 1);
Result := Pos(SearchStr, UpperCase(Str)) - 1;
end;
//---------------------------------------------
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
begin
while Pos(SearchStr, Str) <> 0 do
begin
Insert(ReplaceStr, Str, Pos(SearchStr, Str));
Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
end;
Result := Str;
end;
А еще"встроенные" AnsiStrRScan, AnsiPos т.д.
А вот то, что тебе так нужно:
PHP код:
{ алгоритм Бойера-Мура
>> алгоритм поиска подстроки в строке
Зависимости: SysUtils
Автор: ALex2)
Copyright: 2)
Дата: 1 февраля 2003 г.
***************************************************** }
function BMSearch(StartPos: Integer; const S, P: string): Integer;
type
TBMTable = array[0..255] of Integer;
var
Pos, lp, i: Integer;
BMT: TBMTable;
begin
for i := 0 to 255 do
BMT[i] := Length(P);
for i := Length(P) downto 1 do
if BMT[Byte(P[i])] = Length(P) then
BMT[Byte(P[i])] := Length(P) - i;
lp := Length(P);
Pos := StartPos + lp - 1;
while Pos <= Length(S) do
if P[lp] <> S[Pos] then
Pos := Pos + BMT[Byte(S[Pos])]
else if lp = 1 then
begin
Result := Pos;
Exit;
end
else
for i := lp - 1 downto 1 do
if P[i] <> S[Pos - lp + i] then
begin
Inc(Pos);
Break;
end
else if i = 1 then
begin
Result := Pos - lp + 1;
Exit;
end;
Result := 0;
end;
{
ф-ия возвращает первое вхождение подстроки в строку
работает быстро
}
Пример использования:
BMSearch(1, 'dsade', 'de')
// в данном примере ф-ия возвратит число 4
// 1 - это позиция с которой ищем подстроку в строке
__________________
Free инет хранилище 2.3 Гб сейчас и до 8 гб с прямыми ссылками рефферал
Последний раз редактировалось Xen, 24.05.2010 в 13:26.
s:='Это тестовая строка для поиска слова';
i:= pos('строка',s); // pos - регистрозависимая фун-я!
//---------------------------------------------
function LastPos(SearchStr, Str: string): Integer;
var
i: Integer;
TempStr: string;
begin
Result := Pos(SearchStr, Str);
if Result = 0 then Exit;
if (Length(Str) > 0) and (Length(SearchStr) > 0) then
begin
for i := Length(Str) + Length(SearchStr) - 1 downto Result do
begin
TempStr := Copy(Str, i, Length(Str));
if Pos(SearchStr, TempStr) > 0 then
begin
Result := i;
break;
end;
end;
end;
end;
//---------------------------------------------
function NextPos(SearchStr, Str: string; Position: Integer): Integer;
begin
Delete(Str, 1, Position - 1);
Result := Pos(SearchStr, upperCase(Str));
if Result = 0 then Exit;
if (Length(Str) > 0) and (Length(SearchStr) > 0) then
Result := Result + Position + 1;
end;
//---------------------------------------------
function NextPosRel(SearchStr, Str: string; Position: Integer): Integer;
begin
Delete(Str, 1, Position - 1);
Result := Pos(SearchStr, UpperCase(Str)) - 1;
end;
//---------------------------------------------
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
begin
while Pos(SearchStr, Str) <> 0 do
begin
Insert(ReplaceStr, Str, Pos(SearchStr, Str));
Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
end;
Result := Str;
end;