powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поиск в строке по маске ?
11 сообщений из 11, страница 1 из 1
Поиск в строке по маске ?
    #32253837
Sync
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Нужна функция которая бы возвращала true или false в зависимости от присутствия искомой подстроки в строке, но с учетом маски, т.е. усовершенствованная функция pos.
Т.е. символ [*] - заменяет несколько любых символов.
Есть ли в делфи готовая функция или может кто уже сталкивался с подобной задачкой и написал уже такую функцию ?
Так как пока идея разложить искомую подстроку на строки до встречи * и запихнуть их в массив и циклом проверять двигаясь с 1 по последний символ в строке вызывая поочередно pos для каждой подстроки и обрезая начало строки до найденной текущей подстроки.
Но ведь мой вариант громоздкий, не оптимизированный, может можно как то красивее сделать это ?
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32253845
Фотография Luchkin Dmitry
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
могу дать на клиппере старое творение. переписывать влом.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
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
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32254006
Rostyk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
JEDI code library ,JslStrings.pas

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
// 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;


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

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
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;
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32254170
Sync
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Прошу прощения за задержку с ответом, интернета не было.
Я вроде перевел с клипера на делфи правильно ли я cделал ничего не упустил и не перепутал с elseif-ми ?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
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 прописать нужно ?
Код на паскале вроде работает, но как то когда тестировал с [?] и [*], то не срабатывал ни код переведенный с клипера ни этот паскалевский, хотя потом вроде на похожих примерах срабатывал. Вот и не знаю я, что то с тестовыми данными перепутал или код не до конца рабочий.
Нужно погонять еще в разных сочетаниях, потестировать, может я просто с шаблоном ошибся.
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32254519
Rostyk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AnsiStrRecSize,AnsiCaseMap,AnsiReOffset - константы.
Дай мыло, перешлю весь файл JslString.pas, разберёшся.
А лучше скачай себе Jedi library http://projectjedi.sourceforge.net/
Есть всё на все случаи жизни (с исходниками), хотя много компонентов дублируются.
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32255301
Sync
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
>>Rostyk
Спасибо, JslString.pas уже есть, разобрался.
Но почему то асемблерный вариант пробуксовывает на некоторых комбинациях, а паскалевский и клиперовский на тех же нет, вот пример:
строка:
abc12345
подстрока:
*bc*34*
а вот подстроку:
*bc*23* находят уже все три процедуры.
В общем у асемблерной похоже есть недоработки, надеюсь что у оставшихся двух их все же нет и на всех вариантах они правильно срабатывают.
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32255343
Фотография Luchkin Dmitry
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну... вообще-то клипперная ф-я с 91 года в действующей до сих пор коммерческой программе работает...
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #32255586
Rostyk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Автор честно написал:
Код: plaintext
// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) 
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Поиск в строке по маске ?
    #39787041
Have
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Luchkin Dmitry,

Поясните пожалуйста что делает процедура subStr и что такое .F. и .T. (я просто не знаю Delphi а код нужен) нужно решить подобную задачу только мне надо вывести найденную подстроку.
P.S. В остальном вроде разобрался.
P.P.S. Заранее спасибо.
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #39787053
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
HavesubStr и что такое .F. и .T.substr - это SubString - copy.
.t. и .f. - это True/False на клиппере.
...
Рейтинг: 0 / 0
Поиск в строке по маске ?
    #39787630
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вообще в Дельфи есть готовая функция, правда слегка поломатая, как говорят

http://pages.cs.wisc.edu/~rkennedy/mask
http://www.delphigroups.info/2/76/416835.html
...
Рейтинг: 0 / 0
11 сообщений из 11, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поиск в строке по маске ?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]