Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Поиск в строке по маске ?  [new]
Sync
Guest
Нужна функция которая бы возвращала true или false в зависимости от присутствия искомой подстроки в строке, но с учетом маски, т.е. усовершенствованная функция pos.
Т.е. символ [*] - заменяет несколько любых символов.
Есть ли в делфи готовая функция или может кто уже сталкивался с подобной задачкой и написал уже такую функцию ?
Так как пока идея разложить искомую подстроку на строки до встречи * и запихнуть их в массив и циклом проверять двигаясь с 1 по последний символ в строке вызывая поочередно pos для каждой подстроки и обрезая начало строки до найденной текущей подстроки.
Но ведь мой вариант громоздкий, не оптимизированный, может можно как то красивее сделать это ?
2 сен 03, 15:49    [323704]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Luchkin Dmitry
Member

Откуда: Новосибирск -> Ангарск
Сообщений: 1919
могу дать на клиппере старое творение. переписывать влом.

procedure compMask(cStr, cMask)
local ns:= 1, nm:= 1, lres, nsstar, nmstar, lstar:= .F., cs, cm

cStr:= lowLine(cStr); cMask:= lowLine(cMask)
while (ns <= len(cStr)).and.(nm <= len(cMask))
if ((cs:= subStr(cStr, ns, 1)) == (cm:= subStr(cMask, nm, 1))).or. ;
(cm == '?')
ns++; nm++
elseif cm == '*'
nmstar:= nm; lstar:= .T.
if ++nm > len(cMask); ns:= len(cStr)+1
else
cm:= subStr(cMask, nm, 1)
while (ns<=len(cStr)).and.(subStr(cStr,ns,1)!=cm); ns++; end
nsstar:= ns
end
elseif lstar; nm:= nmstar; ns:= ++nsstar
else; exit
end
end
lres:= (ns > len(cStr)).and.((nm > len(cMask)).or.;
(subStr(cMask, nm, 1) == '*'))
return lres
2 сен 03, 15:54    [323713]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Rostyk
Member

Откуда:
Сообщений: 350
JEDI code library ,JslStrings.pas


// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*)

function StrMatch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
asm
// make sure that strings are not null

TEST EAX, EAX
JZ @@SubstrIsNull

TEST EDX, EDX
JZ @@StrIsNull

// limit index to satisfy 1 <= index, and dec it

DEC ECX
JL @@IndexIsSmall

// EBX will hold the case table, ESI pointer to Str, EDI pointer
// to Substr and EBP # of chars in Substr to compare

PUSH EBX
PUSH ESI
PUSH EDI
PUSH EBP

// set the AnsiString pointers

MOV ESI, EDX
MOV EDI, EAX

// save the Index in EDX

MOV EDX, ECX

// save the address of Str to compute the result

PUSH ESI

// temporary get the length of Substr and Str

MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length
MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length

// dec the length of Substr because the first char is brought out of it

DEC EBX
JS @@NotFound

// #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2

SUB ECX, EBX
JLE @@NotFound

SUB ECX, EDX
JLE @@NotFound

// # of chars in Substr to compare

MOV EBP, EBX

// point Str to Index'th char

ADD ESI, EDX

// load case map into EBX, and clear EAX & ECX

LEA EBX, AnsiCaseMap
XOR EAX, EAX
XOR ECX, ECX

// bring the first char out of the Substr and point Substr to the next char

MOV CL, [EDI]
INC EDI

// lower case it

MOV CL, [EBX + ECX]

@@FindNext:

// get the current char from Str into al

MOV AL, [ESI]
INC ESI

// check the end of AnsiString

TEST AL, AL
JZ @@NotFound


CMP CL, '
*' // Wild Card?
JE @@Compare

CMP CL, '
?' // Wild Card?
JE @@Compare

// lower case current char

MOV AL, [EBX + EAX]

// check if the current char matches the primary search char,
// if not continue searching

CMP AL, CL
JNE @@FindNext

@@Compare:

// # of chars in Substr to compare }

MOV EDX, EBP

@@CompareNext:

// dec loop counter and check if we reached the end. If yes then we found it

DEC EDX
JL @@Found

// get the chars from Str and Substr, if they are equal then continue comparing

MOV AL, [EDI + EDX] // char from Substr

CMP AL, '
*' // wild card?
JE @@CompareNext

CMP AL, '
?' // wild card?
JE @@CompareNext

CMP AL, [ESI + EDX] // equal to PChar(Str)^ ?
JE @@CompareNext

MOV AL, [EBX + EAX + AnsiReOffset] // reverse case?
CMP AL, [ESI + EDX]
JNE @@FindNext // if still no, go back to the main loop

// if they matched, continue comparing

JMP @@CompareNext

@@Found:
// we found it, calculate the result

MOV EAX, ESI
POP ESI
SUB EAX, ESI

POP EBP
POP EDI
POP ESI
POP EBX
RET

@@NotFound:

// not found it, clear the result

XOR EAX, EAX
POP ESI
POP EBP
POP EDI
POP ESI
POP EBX
RET

@@IndexIsSmall:
@@StrIsNull:

// clear the result

XOR EAX, EAX

@@SubstrIsNull:
@@Exit:
end;


Оттуда же, но не проверял:


function StrMatches(const Substr, S: AnsiString; const Index: Integer): Boolean;
var
StringPtr: PChar;
PatternPtr: PChar;
StringRes: PChar;
PatternRes: PChar;

begin
Result := False;
StringPtr := PChar(@S[Index]);
PatternPtr := PChar(SubStr);
StringRes := nil;
PatternRes := nil;

if (S='') or (SubStr='') then
Exit;

repeat
repeat
case PatternPtr^ of
#0:
begin
Result := StringPtr^ = #0;
if Result or (StringRes = nil) or (PatternRes = nil) then
Exit;

StringPtr := StringRes;
PatternPtr := PatternRes;
Break;
end;
'*':
begin
Inc(PatternPtr);
PatternRes := PatternPtr;
Break;
end;
'?':
begin
if StringPtr^ = #0 then
Exit;
Inc(StringPtr);
Inc(PatternPtr);
end;
else
begin
if StringPtr^ = #0 then
Exit;
if StringPtr^ <> PatternPtr^ then
begin
if (StringRes = nil) or (PatternRes = nil) then
Exit;
StringPtr := StringRes;
PatternPtr := PatternRes;
Break;
end
else
begin
Inc(StringPtr);
Inc(PatternPtr);
end;
end;
end;
until False;

repeat
case PatternPtr^ of
#0:
begin
Result := True;
Exit;
end;
'*':
begin
Inc(PatternPtr);
PatternRes := PatternPtr;
end;
'?':
begin
if StringPtr^ = #0 then
Exit;
Inc(StringPtr);
Inc(PatternPtr);
end;
else
begin
repeat
if StringPtr^ = #0 then
Exit;
if StringPtr^ = PatternPtr^ then
Break;
Inc(StringPtr);
until False;
Inc(StringPtr);
StringRes := StringPtr;
Inc(PatternPtr);
Break;
end;
end;
until False;
until False;
end;
2 сен 03, 17:47    [323937]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Sync
Guest
Прошу прощения за задержку с ответом, интернета не было.
Я вроде перевел с клипера на делфи правильно ли я cделал ничего не упустил и не перепутал с elseif-ми ?

function compMask(cStr, cMask:string):boolean;
var
nmstar, nsstar, ns, nm : integer;
lres, lstar : boolean;
cs, cm : string;

begin
compMask := false;
ns := 1;
nm := 1;
lstar := False;
cStr := AnsiLowerCase(cStr);
cMask := AnsiLowerCase(cMask);

while (ns <= length(cStr)) and (nm <= length(cMask)) do
begin
cs := copy(cStr, ns, 1);
cm := copy(cMask, nm, 1);
if (cs=cm) or (cm='?') then
begin
ns := ns + 1;
nm := nm + 1;
end else
if cm = '*' then
begin
nmstar := nm;
lstar := True;
nm := nm + 1;
if nm > length(cMask) then
begin
ns := length(cStr) + 1;
end else
begin
cm := copy(cMask, nm, 1);
while (ns<=length(cStr)) and (copy(cStr,ns,1)<>cm) do
begin
ns := ns+1;
end;
nsstar := ns;
end;
end
else if lstar then
begin
nm := nmstar;
nsstar := nsstar + 1;
ns := nsstar;
end else exit;
end;
lres := (ns>length(cStr)) and ((nm>length(cMask)) or (copy(cMask, nm, 1) = '*'));
compMask := lres;
end;



>>Rostyk
Код на асемблере в 5 делфи не компилируется, говорит неизвестный идентификатор AnsiStrRecSize,AnsiCaseMap,AnsiReOffset
Может какой uses прописать нужно ?
Код на паскале вроде работает, но как то когда тестировал с [?] и [*], то не срабатывал ни код переведенный с клипера ни этот паскалевский, хотя потом вроде на похожих примерах срабатывал. Вот и не знаю я, что то с тестовыми данными перепутал или код не до конца рабочий.
Нужно погонять еще в разных сочетаниях, потестировать, может я просто с шаблоном ошибся.
3 сен 03, 03:08    [324215]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Rostyk
Member

Откуда:
Сообщений: 350
AnsiStrRecSize,AnsiCaseMap,AnsiReOffset - константы.
Дай мыло, перешлю весь файл JslString.pas, разберёшся.
А лучше скачай себе Jedi library http://projectjedi.sourceforge.net/
Есть всё на все случаи жизни (с исходниками), хотя много компонентов дублируются.
3 сен 03, 12:20    [324678]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Sync
Guest
>>Rostyk
Спасибо, JslString.pas уже есть, разобрался.
Но почему то асемблерный вариант пробуксовывает на некоторых комбинациях, а паскалевский и клиперовский на тех же нет, вот пример:
строка:
abc12345
подстрока:
*bc*34*
а вот подстроку:
*bc*23* находят уже все три процедуры.
В общем у асемблерной похоже есть недоработки, надеюсь что у оставшихся двух их все же нет и на всех вариантах они правильно срабатывают.
4 сен 03, 02:14    [325704]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Luchkin Dmitry
Member

Откуда: Новосибирск -> Ангарск
Сообщений: 1919
ну... вообще-то клипперная ф-я с 91 года в действующей до сих пор коммерческой программе работает...
4 сен 03, 06:40    [325751]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Rostyk
Member

Откуда:
Сообщений: 350
Автор честно написал:
// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) 
4 сен 03, 11:16    [326051]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Поиск в строке по маске ?  [new]
Have
Member

Откуда:
Сообщений: 1
Luchkin Dmitry,

Поясните пожалуйста что делает процедура subStr и что такое .F. и .T. (я просто не знаю Delphi а код нужен) нужно решить подобную задачу только мне надо вывести найденную подстроку.
P.S. В остальном вроде разобрался.
P.P.S. Заранее спасибо.
15 мар 19, 21:50    [21834352]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
YuRock
Member

Откуда: Донецк
Сообщений: 4046
Have
subStr и что такое .F. и .T.
substr - это SubString - copy.
.t. и .f. - это True/False на клиппере.
15 мар 19, 22:38    [21834381]     Ответить | Цитировать Сообщить модератору
 Re: Поиск в строке по маске ?  [new]
Arioch
Member

Откуда:
Сообщений: 11066
вообще в Дельфи есть готовая функция, правда слегка поломатая, как говорят

http://pages.cs.wisc.edu/~rkennedy/mask
http://www.delphigroups.info/2/76/416835.html
18 мар 19, 11:30    [21835716]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить