Сравнение строк типа like (как в access)
Подскажите как сравнить в delphi строчки, таким образом, как написано в заголовке.
Другими словами надо проверить входит ли одна строка в другую.
Другими словами надо проверить входит ли одна строка в другую.
pos(substr,str);
если подстрока есть - выдает позицию начала подстроки.
если подстрока есть - выдает позицию начала подстроки.
Можно еще воспользоваться регулярными выражениями (получится полностью "как like"). Компонент для этого дела берем здесь: http://www.regexpstudio.com/RegExpStudio.html
Я тут взял и написал для своей задачи процедуру которая умеет определять соответствие по Маске. * -- любое количество любых символов. Даже если символов нет, то тоже все отлично.? -- точно один любой символ. Если надо в маске прописать * или ?, чтобы она воспринималась как * или ?, то надо писать пару. Есть недостаток. Если надо написать поиск скажем Тескт_Любой символ_?да, то будет воспринято процедурой Текст?_любой символ_да. Ну и по звездочке то же самое.
Вот текст процедуры:
Пример: Like('*.do?*', 'Файл.doc') даст истину,
Like('*.do?*', 'Файл.docx') - истина,
Like('*.do?', 'Файл.docx') - лож. И т.д.
Вот текст процедуры:
Код:
Function Like(StrLike, Str : String) : Boolean;
Var PEach, pOne, i, k, Sl : Integer;
Frst : Boolean;
StrArray : Array of String;
Begin
SetLength(StrArray, 0);
i := 1;
k := 0;
SL := Length(StrLike);
While i <= SL do
Begin
Case StrLike[i] of
'*' : Begin
If (i < SL) and (StrLike[i + 1] = '*') Then
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + '*';
i := i + 1;
End else
If (i = SL) Or (StrLike[i + 1] <> '*') Then
Begin
If k < Length(StrArray) Then
Begin
inc(k);
End;
SetLength(StrArray, k + 1);
StrArray[k] := '*';
Inc(k);
End;
End;
'?' : Begin
If (i < SL) and (StrLike[i + 1] = '?') Then
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + '?';
i := i + 1;
End else
If (i = SL) Or (StrLike[i + 1] <> '?') Then
Begin
If k < Length(StrArray) Then
Begin
inc(k);
End;
SetLength(StrArray, k + 1);
StrArray[k] := '?';
Inc(k);
End;
End;
Else
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + StrLike[i];
End;
End;
i := i + 1;
End;
Result := True;
Frst := True;
i := 0;
While i < Length(StrArray) Do
Begin
If StrArray[i] = '?' Then
Begin
Delete(Str, 1, 1);
Frst := True;
End else
If StrArray[i] = '*' Then
Begin
Frst := False;
If i = Length(StrArray) - 1 Then
Begin
Str := '';
End else
Begin
k := i;
While (k < Length(StrArray)) and ((StrArray[k] = '*') or (StrArray[k] = '?')) Do
k := k + 1;
If k >= Length(StrArray) Then
Str := '' else
Begin
i := k - 1;
End;
End;
End else
Begin
pOne := Pos(StrArray[i], Str);
If Frst and (pOne = 1) Then
Begin
Delete(Str, 1, Length(StrArray[i]));
End else
If (not FRST) and (pOne <> 0) Then
Begin
Delete(Str, 1, pOne + Length(StrArray[i]) - 1);
End;
End;
i := i + 1;
End;
Result := Str = '';
End;
Var PEach, pOne, i, k, Sl : Integer;
Frst : Boolean;
StrArray : Array of String;
Begin
SetLength(StrArray, 0);
i := 1;
k := 0;
SL := Length(StrLike);
While i <= SL do
Begin
Case StrLike[i] of
'*' : Begin
If (i < SL) and (StrLike[i + 1] = '*') Then
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + '*';
i := i + 1;
End else
If (i = SL) Or (StrLike[i + 1] <> '*') Then
Begin
If k < Length(StrArray) Then
Begin
inc(k);
End;
SetLength(StrArray, k + 1);
StrArray[k] := '*';
Inc(k);
End;
End;
'?' : Begin
If (i < SL) and (StrLike[i + 1] = '?') Then
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + '?';
i := i + 1;
End else
If (i = SL) Or (StrLike[i + 1] <> '?') Then
Begin
If k < Length(StrArray) Then
Begin
inc(k);
End;
SetLength(StrArray, k + 1);
StrArray[k] := '?';
Inc(k);
End;
End;
Else
Begin
If k >= length(StrArray) Then
Begin
SetLength(StrArray, k + 1);
End;
StrArray[k] := StrArray[k] + StrLike[i];
End;
End;
i := i + 1;
End;
Result := True;
Frst := True;
i := 0;
While i < Length(StrArray) Do
Begin
If StrArray[i] = '?' Then
Begin
Delete(Str, 1, 1);
Frst := True;
End else
If StrArray[i] = '*' Then
Begin
Frst := False;
If i = Length(StrArray) - 1 Then
Begin
Str := '';
End else
Begin
k := i;
While (k < Length(StrArray)) and ((StrArray[k] = '*') or (StrArray[k] = '?')) Do
k := k + 1;
If k >= Length(StrArray) Then
Str := '' else
Begin
i := k - 1;
End;
End;
End else
Begin
pOne := Pos(StrArray[i], Str);
If Frst and (pOne = 1) Then
Begin
Delete(Str, 1, Length(StrArray[i]));
End else
If (not FRST) and (pOne <> 0) Then
Begin
Delete(Str, 1, pOne + Length(StrArray[i]) - 1);
End;
End;
i := i + 1;
End;
Result := Str = '';
End;
Like('*.do?*', 'Файл.docx') - истина,
Like('*.do?', 'Файл.docx') - лож. И т.д.
У нас на сайте очень просто заказать проститутку Москвы нужно лишь позвонить ей и она приедет к вам для незабываемого отдыха.
Цитата: Milka Ivanova
У нас на сайте очень просто заказать проститутку Москвы нужно лишь позвонить ей и она приедет к вам для незабываемого отдыха.
А она принесет тулы для секса и какой-нить HEX дамп для "расковыривания" или надо со своими?