find tlf nr

unit Unit1;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
NOTHING='';
NULL=#0;
vbcrlf=#13+#10;
tNumbs=['0'..'9'];

function pLen(p:pChar):int64;
begin result:=int64(p);
if p<>nil then while p^<>NULL do inc(p);
result:=int64(p)-result
end;

function pFindByMask(p,pMask:pChar;aRslt:tStringList):boolean;
var pP,mP:pChar;i,aLen,aMaskLen:longInt;bl:boolean;s:string;
begin result:=false;
aLen:=pLen(p);aMaskLen:=pLen(pMask);
if (aMaskLen<1) or (aLen<aMaskLen) then exit;
while aLen>aMaskLen do begin pP:=p;mP:=pMask;bl:=true;
  for i:=1 to aMaskLen do begin
  case mP^ of
    'x','X':if not (pP^ in tNumbs) then begin bl:=false;break end;
  else
    if pP^<>mP^ then begin bl:=false;break end;
  end;inc(pP);inc(mP)
  end;
  if bl then begin result:=true;
  setLength(s,aMaskLen);system.move(p^,pointer(s)^,aMaskLen);aRslt.add(s)
  end;dec(aLen);inc(p)
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var s:string;sl:tStringList;
begin
sl:=tStringList.create;

//EKSEMPEL 1
s:='Navn 1, Adresse 1, +45 29000000, '+vbcrlf
  +'Navn 2, Adresse 2, +45 31000000, '+vbcrlf
  +'Navn 3, Adresse 3, +45 29 00 00 00, '+vbcrlf
  +'Navn 4, Adresse 4, +45 3100 0000, '+vbcrlf;

sl.add('EKSEMPEL');
pFindByMask(pointer(s),'+xx xxxxxxxx',sl);
pFindByMask(pointer(s),'+xx xx xx xx xx',sl);
pFindByMask(pointer(s),'+xx xxxx xxxx',sl);
sl.add(NOTHING);

memo1.text:=sl.text;
sl.free
end;

end.