Detecting URLs on typing

Return to index

Author

Message

Sergey Tkachenko

Posted: 03/29/2004 12:52:32

This code autodetects URLs in text.

When the user types space or Enter character, the code checks if the caret

is at the end of URL. If yes, it makes a hyperlink of it and set its tag.

It's assumed that you use RichViewActions

(http://www.trichview.com/resources/actions/): hypertext style is returned

by rvActionsResource.rvActionInsertHyperlink1.GetHyperlinkStyleNo(rve).

Otherwise create your own procedure for calculation of hypertext style.

function IsAddress(const str: String): Boolean;

var s: String;

begin

  // Checks for prefix.

  // For better results, it should check for lengths...

  s := AnsiLowerCase(str);

  Result :=

        (Pos('http://',   s)=1) or

        (Pos('ftp://',    s)=1) or

        (Pos('file://',   s)=1) or

        (Pos('gopher://', s)=1) or

        (Pos('mailto:', s)=1) or

        (Pos('https://',  s)=1) or

        (Pos('news:',     s)=1) or

        (Pos('telnet:',   s)=1) or

        (Pos('wais:',     s)=1) or

        (Pos('www.',      s)=1) or

        (Pos('ftp.',      s)=1);

end;

function IsEmail(const s: String): Boolean;

var p1, p2: Integer;

   pchr: PChar;

begin

  //'@' must exist and '.' must be after it. This is not a comprehensive

test,

  //but I think that it's ok

  Result := False;

  p1 := Pos('@', s);

  if p1=0 then exit;

  pchr := StrRScan(PChar(s),'.');

  if pchr = nil then exit;

  p2 := pchr - PChar(s)+1;

  if p1>p2 then exit;

  Result := True;

end;

function MakeURL(rve: TCustomRichViewEdit): Boolean;

var ItemNo, WordEnd, WordStart, CurStyleNo: Integer;

    s: String;

begin

  Result := False;

  rve := rve.TopLevelEditor;

  if rve.SelectionExists then

    exit;

  ItemNo := rve.CurItemNo;

  if rve.GetItemStyle(ItemNo)<0 then

    exit;

  WordEnd := rve.OffsetInCurItem;

  if WordEnd<=1 then

    exit;

  s := rve.GetItemTextA(ItemNo);

  WordStart := WordEnd-1;

  while (WordStart>1) and (s[WordStart-1]<>' ') do

    dec(WordStart);

  s := Copy(s, WordStart, WordEnd-WordStart);

  if IsEmail(s) or IsAddress(s) then begin

    CurStyleNo := rve.CurTextStyleNo;

    rve.SetSelectionBounds(ItemNo, WordStart, ItemNo, WordEnd);

rve.ApplyTextStyle(rvActionsResource.rvActionInsertHyperlink1.GetHyperlinkSt

yleNo(rve));

    rve.SetCurrentTag(Integer(StrNew(PChar(s))));

    rve.SetSelectionBounds(rve.CurItemNo, rve.OffsetInCurItem,

rve.CurItemNo, rve.OffsetInCurItem);

    rve.CurTextStyleNo := CurStyleNo;

    Result := True;

  end;

end;

procedure TForm3.RichViewEdit1KeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key in [VK_RETURN, VK_SPACE] then

    MakeURL(TCustomRichViewEdit(Sender));

end;