Андрей Сорокин
дата публикации 20-03-2000 00:00

---

Версия для печати

"Look for a white shirt and a white apron," said the head which had
been put together, speaking in a rather faint voice. "I'm the cook."
L. Frank Baum, The Emerald City of Oz

• Детектор лжи
• Персонального www-робота - каждому !
• Господин Оформитель
• Панацея ?

Прим.

• Если для Вас приведенные примеры выражений выглядят как древнеегипетские письмена, то ознакомьтесь с описанием их синтаксиса в любой книге о Perl или на http://regexpstudio.com/RU/TRegExpr/Help/RegExp_Syntax.html.
  Они гораздо проще чем кажутся !
• Для компиляции этих примеров достаточно добавить regexpr.pas в список файлов проекта и вписать 'uses regexpr;' в юниты, где Вы используете регулярные выражения.

 p := Pos ('@', email);
 if (p > 1) and (p < length (email))
  then ...

if ExecRegExpr ('[\w\d\-\.]+@[\w\d\-]+(\.[\w\d\-]+)+', email) 
 then ... gotcha! ...

 const
  Mask1 = '^(?i)M*(D?C{0,3}|C[DM])(L?X{0,3}|X[LC])(V?I{0,3}|I[VX])$';
  ...
  if not ExecRegExpr (Mask1, DBEdit1.Text) then begin
    ... show error message ...
    DBEdit1.SetFocus;
   end;

К оглавлению

procedure TForm1.BitBtn1Click(Sender: TObject);
 const
  Template = '(?i)Официальный курс ЦБ по доллару'
   + '.*Дата\s*Курс\s*Курс пок.\s*Курс прод. [^<\d]*'
   + '(\d?\d)/(\d?\d)/(\d\d)\s*[\d.]+\s*([\d.]+)';
 begin
  NMHTTP1.Get ('http://win.www.citycat.ru/finance/finmarket/_CBR/');
  with TRegExpr.Create do try
     Expression := Template;
     if Exec (NMHTTP1.Body) then begin
       Label1.Caption := Format ('Курс на %s.%s.%s: %s',
         [Match [2], Match [1], Match [3], Match [4]]);
      end;
    finally Free;
   end;
 end;

procedure ExtractPhones (const AText : string; APhones : TStrings);
 begin
  with TRegExpr.Create do try
     Expression := '(\+\d *)?(\((\d+)\) *)?(\d+(-\d*)*)'; 
     if Exec (AText) then
      REPEAT
        if Match [3] = '812'
         then APhones.Add (Match [4])
      UNTIL not ExecNext;
    finally Free;
   end;
 end;

К оглавлению

type
 TDecorateURLsFlags = (
  // Включаемые в видимую часть гипер-ссылки поля
  durlProto, // Протокол ('ftp://' или 'http://')
  durlAddr,  // IP-адрес или символическое имя домена
  durlPort,  // номер порта (например ':8080')
  durlPath,  // путь (unix-формат)
  durlBMark, // объект внутри страницы (напрмер '#bookmark')
  durlParam  // параметры запроса (например '?ID=13&User=Pupkin')
  );
 TDecorateURLsFlagSet = set of TDecorateURLsFlags;

function DecorateURLs (const AText : string; AFlags : TDecorateURLsFlagSet = [durlAddr,
durlPath]) : string;
 const
  URLTemplate =
   '(?i)' // регистро-независимый режим
   + '('
   + '(FTP|HTTP)://' // Протокол
   + '|www\.)' // Позволяет отловить ссылки указанные без 'http://'
   + '([\w\d\-]+(\.[\w\d\-]+)+)' // IP-адрес или символическое имя домена
   + '(:\d\d?\d?\d?\d?)?' // номер порта
   + '(((/[%+\w\d\-\\\.]*)+)*)' // путь (unix-формат)
   + '(\?[^\s=&]+=[^\s=&]+(&[^\s=&]+=[^\s=&]+)*)?' // параметры запроса
   + '(#[\w\d\-%+]+)?'; // объект внутри страницы
 var
  PrevPos : integer;
  s, Proto, Addr, HRef : string;
 begin
  Result := '';
  PrevPos := 1;
  with TRegExpr.Create do try
     Expression := URLTemplate;
     if Exec (AText) then
      REPEAT
        s := '';
        if CompareText (Match [1], 'www.') = 0 then begin
           Proto := 'http://';
           Addr := Match [1] + Match [3];
           HRef := Proto + Match [0];
          end
         else begin
           Proto := Match [1];
           Addr := Match [3];
           HRef := Match [0];
          end;
        if durlProto in AFlags
         then s := s + Proto; // Match [1] + '://';
        if durlAddr in AFlags
         then s := s + Addr; // Match [2];
        if durlPort in AFlags
         then s := s + Match [5];
        if durlPath in AFlags
         then s := s + Match [6];
        if durlParam in AFlags
         then s := s + Match [9];
        if durlBMark in AFlags
         then s := s + Match [11];
        Result := Result + System.Copy (AText, PrevPos,
         MatchPos [0] - PrevPos) + '<a href="' + HRef + '">' + s + '</a>';
        PrevPos := MatchPos [0] + MatchLen [0];
      UNTIL not ExecNext;
     Result := Result + System.Copy (AText, PrevPos, MaxInt); // Tail
    finally Free;
   end;
 end; { of function DecorateURLs -------------------------------}

К оглавлению

К оглавлению

Успехов !

Андрей Сорокин
Специально для Королевства «Delphi»