Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поиск в строке по маске ? / 11 сообщений из 11, страница 1 из 1
02.09.2003, 15:49
    #32253837
Sync
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
Нужна функция которая бы возвращала true или false в зависимости от присутствия искомой подстроки в строке, но с учетом маски, т.е. усовершенствованная функция pos.
Т.е. символ [*] - заменяет несколько любых символов.
Есть ли в делфи готовая функция или может кто уже сталкивался с подобной задачкой и написал уже такую функцию ?
Так как пока идея разложить искомую подстроку на строки до встречи * и запихнуть их в массив и циклом проверять двигаясь с 1 по последний символ в строке вызывая поочередно pos для каждой подстроки и обрезая начало строки до найденной текущей подстроки.
Но ведь мой вариант громоздкий, не оптимизированный, может можно как то красивее сделать это ?
...
Рейтинг: 0 / 0
02.09.2003, 15:54
    #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
02.09.2003, 17:47
    #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
03.09.2003, 03:08
    #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
03.09.2003, 12:20
    #32254519
Rostyk
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
AnsiStrRecSize,AnsiCaseMap,AnsiReOffset - константы.
Дай мыло, перешлю весь файл JslString.pas, разберёшся.
А лучше скачай себе Jedi library http://projectjedi.sourceforge.net/
Есть всё на все случаи жизни (с исходниками), хотя много компонентов дублируются.
...
Рейтинг: 0 / 0
04.09.2003, 02:14
    #32255301
Sync
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
>>Rostyk
Спасибо, JslString.pas уже есть, разобрался.
Но почему то асемблерный вариант пробуксовывает на некоторых комбинациях, а паскалевский и клиперовский на тех же нет, вот пример:
строка:
abc12345
подстрока:
*bc*34*
а вот подстроку:
*bc*23* находят уже все три процедуры.
В общем у асемблерной похоже есть недоработки, надеюсь что у оставшихся двух их все же нет и на всех вариантах они правильно срабатывают.
...
Рейтинг: 0 / 0
04.09.2003, 06:40
    #32255343
Luchkin Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
ну... вообще-то клипперная ф-я с 91 года в действующей до сих пор коммерческой программе работает...
...
Рейтинг: 0 / 0
04.09.2003, 11:16
    #32255586
Rostyk
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
Автор честно написал:
Код: plaintext
// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) 
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
15.03.2019, 21:50
    #39787041
Have
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Поиск в строке по маске ?
Luchkin Dmitry,

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

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


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