1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TForm1.Button1Click(Sender: TObject);
Var i:integer;
    Flag:boolean;
    s:string;
begin
  Flag:=true;
  s:=edit1.text;
  if length(s)=15 then
    begin
      for i:=1 to length(s) do
        begin
          case i of
            1..4,6..10,12..15 : if not(s[i] in ['1'..'9']) then flag:=false;
            5,11 : if s[i]<>'-' then flag:=false;
           else end; //of case
        end;
    end else Flag:=false;
  if flag then label1.caption:='ok' else label1.caption:='';
end;					

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:

{*****************************************************************}
{* This function implements a subset of regular expression based *}
{* search and is based on the translation of PattenMatch() API   *}
{* of common.c in MSDN Samples\VC98\sdk\sdktools\tlist           *}
{*****************************************************************}
{* MetaChars are  :                                              *}
{*            '*' : Zero or more chars.                          *}
{*            '?' : Any one char.                                *}
{*         [adgj] : Individual chars (inclusion).                *}
{*        [^adgj] : Individual chars (exclusion).                *}
{*          [a-d] : Range (inclusion).                           *}
{*         [^a-d] : Range (exclusion).                           *}
{*       [a-dg-j] : Multiple ranges (inclusion).                 *}
{*      [^a-dg-j] : Multiple ranges (exclusion).                 *}
{*  [ad-fhjnv-xz] : Mix of range & individual chars (inclusion). *}
{* [^ad-fhjnv-xz] : Mix of range & individual chars (exclusion). *}
{*****************************************************************}

unit MatchPtn;

interface

function MatchPattern(InpStr,Pattern :PChar) :Boolean;

implementation

function MatchPattern(InpStr,Pattern :PChar) :Boolean;
begin
  result := true;
  while (True) do begin
    case Pattern[0] of
      #0 :begin
            //End of pattern reached.
            Result := (InpStr[0] = #0); //TRUE if end of InpStr.
            Exit;
          end;

      '*':begin //Match zero or more occurances of any char.
            if (Pattern[1] = #0) then begin
              //Match any number of trailing chars.
              Result := True;
              Exit;
            end
            else
              Inc(Pattern);

            while (InpStr[0] <> #0) do begin
              //Try to match any substring of InpStr.
              if (MatchPattern(InpStr,Pattern)) then begin
                Result := True;
                Exit;
              end;

              //Continue testing next char...
              Inc(InpStr);
            end;
          end;

      '?':begin //Match any one char.
            if (InpStr[0] = #0) then begin
              Result := False;
              Exit;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;

      '[':begin //Match given set of chars.
            if (Pattern[1] in [#0,'[',']']) then begin
              //Invalid Set - So no match.
              Result := False;
              Exit;
            end;

            if (Pattern[1] = '^') then begin
              //Match for exclusion of given set...
              Inc(Pattern,2);
              Result := True;
              while (Pattern[0] <> ']') do begin
                if (Pattern[1] = '-') then begin
                  //Match char exclusion range.
                  if (InpStr[0] >= Pattern[0]) and (InpStr[0] <= Pattern[2]) then begin
                    //Given char failed set exclusion range.
                    Result := False; 
                    Break; 
                  end
                  else
                    Inc(Pattern,3);
                end
                else begin
                  //Match individual char exclusion.
                  if (InpStr[0] = Pattern[0]) then begin
                    //Given char failed set element exclusion.
                    Result := False;
                    Break;
                  end
                  else
                    Inc(Pattern);
                end;
              end;
            end
            else begin
              //Match for inclusion of given set...
              Inc(Pattern);
              Result := False;
              while (Pattern[0] <> ']') do begin
                if (Pattern[1] = '-') then begin
                  //Match char inclusion range.
                  if (InpStr[0] >= Pattern[0])and(InpStr[0] <= Pattern[2]) then begin
                    //Given char matched set range inclusion.
                    // Continue testing...
                    Result := True;
                    Break;
                  end
                  else
                    Inc(Pattern,3);
                end
                else begin
                  //Match individual char inclusion.
                  if (InpStr[0] = Pattern[0]) then begin
                    //Given char matched set element inclusion.
                    // Continue testing...
                    Result := True;
                    Break;
                  end
                  else
                    Inc(Pattern);
                end;
              end;
            end;

            if (Result) then begin
              //Match was found. Continue further.
              Inc(InpStr);
              //Position Pattern to char after "]"
              while (Pattern[0] <> ']')and(Pattern[0] <> #0) do
                Inc(Pattern);
              if (Pattern[0] = #0) then begin
                //Invalid Pattern - missing "]"
                Result := False;
                Exit;
              end
              else
                Inc(Pattern);
            end
            else
              Exit;
          end;

     else begin //Match given single char.
            if (InpStr[0] <> Pattern[0]) then begin
              Result := False;
              Break;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;
    end;
  end;
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TForm1.Edit2Change(Sender: TObject);
Var
  text: String;
begin
  text := Edit2.Text;
  
  Button1.Enabled := 
    PruefeZwischenzeichen (text) and PruefeZahlen (text, 1, 4) 
    and PruefeZahlen (text, 6, 5) and PruefeZahlen(text, 12, 4);

  if Edit2.Text=Edit1.Text then
    Button1.Enabled := false
end;					

1:
2:
3:
4:

Uses ... Masks;

 if MatchesMask( '123-456', '[0-9][0-9][0-9]-[0-9][0-9][0-9]' ) then
   ShowMessage( 'Ja' );