Требуется процедура парсера емэйлов!

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Tip.the.besT, 9 Sep 2011.

  1. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    300
    Likes Received:
    9
    Reputations:
    4
    Я уже пару часов четно пытаюсь написать сам, ничего не выходит уж слишком много нужно предусмотреть. В доказательство выше сказаного ниже выложил код в последней вариации, программа вообще зависает! Дак вот, что я хотел спросить, может есть уже готовые процедуры парсинга емэйлов с HTML страницы? :confused:
    Code:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        Button1: TButton;
        Memo2: TMemo;
        Label1: TLabel;
        Memo3: TMemo;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
    mail:Tstringlist;
    i,z,x,v:integer;
    s:string;
    begin
    i:=1;
     z:=0;
    
    while     memo1.Lines.Count>=i     do 
    begin
    
    if pos('@', memo1.Lines[i])>1 then // парсим все строки с значком "@"
    begin
    memo2.Lines.Add(memo1.Lines[i]);
    end;
    i:=i+1;
    end;
    
    
    i:=0;
    
    
    end;
    
    
    procedure TForm1.Button2Click(Sender: TObject);
     var
    mail:Tstringlist;
    i,z,x,v:integer;
    s:string;
    begin
    for i :=0 to memo2.Lines.Count do //убираем все коменты
    begin
    s:=memo2.Lines[i];
    if pos('<!--',s)<>0 then
    begin
    memo2.Lines.Delete(i);
    end;
    if pos('--!>',s)<>0 then
    begin
    memo2.Lines.Delete(i);
    end;
    
    end;
    
    for i:=0 to memo2.Lines.Count do
    begin
    s:= memo2.Lines[i];
    
    while pos('<',s)>0 do // все теги со страницы
    begin
    x:=0;
    z:=0;
    z:=pos('<',s);
    x:=pos('>',s);
    if x<>z then
    begin
    v:=x-z+1;
    delete(s,z,v);
    end;
    end;
    
    memo3.Lines.Add(s);
    
    end;
    
    end;
    
    end.
    
     
  2. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    621
    Likes Received:
    49
    Reputations:
    5
    Тебе подойдут регуярные выражения
    http://3.bp.blogspot.com/_dS8cdXcqCug/SLPuFJMVhoI/AAAAAAAAAAs/VUpYAby4EGo/s1600-h/regular_expressions_cheat_sheet.png

    тут вот уже даже готовое выражение есть.
     
  3. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    300
    Likes Received:
    9
    Reputations:
    4
    Это какой - то модуль для delphi, и как это всё использовать?что - то я не понял...
     
  4. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    300
    Likes Received:
    9
    Reputations:
    4
    про регулярные выражения я читаю, а есть у кого мысли как реализовать посредством pos, delete, сору, length?
     
  5. Kandi

    Kandi Member

    Joined:
    18 Nov 2009
    Messages:
    366
    Likes Received:
    16
    Reputations:
    0
    Можно спросить, НАХ*Я ???
    Если регулярными вытащить можно просто раз плюнуть!!!
    Code:
    var
    RegExp : TRegExpr;
    begin
    RegExp.Exepssion := 'Здесь регулярка на мейл'; //в гугле одни только примеры с ними
    if RegExp.Exec(Здесь строка например HTML код который ты получид) then
    begin
    repeat
    Memo1.lines.append(RegExp.Match[1]); // здесь уже либо 0 либо 1
    until not RegExp.ExecNext;
    end;
    Модуль TRegExpr - можно забрать здесь так же почитать там неплохо объясняется
    _http://forum.vingrad.ru/articles/topic-213075.html
     
    #5 Kandi, 9 Sep 2011
    Last edited: 9 Sep 2011
  6. Tip.the.besT

    Tip.the.besT Member

    Joined:
    24 Jun 2009
    Messages:
    300
    Likes Received:
    9
    Reputations:
    4
    Кстати да, я буквально недавно читал, что он нагружает проц.
    Пото му, что создаёт новый обхект для каждого вычисления и убивает его после окончания.
    Кстати я как раз эту статью и читаю.
     
  7. Kandi

    Kandi Member

    Joined:
    18 Nov 2009
    Messages:
    366
    Likes Received:
    16
    Reputations:
    0
    Ну тогда надо assembler использовать для программирования если у вас дома первая ЭВМ.

    P.S. хочу сообщить на дворе 21 ВЕК
     
  8. greki_hoy

    greki_hoy Member

    Joined:
    4 Mar 2010
    Messages:
    326
    Likes Received:
    57
    Reputations:
    41
    у меня сохранились данные с профилировки утилиты тоже с регулярками связана
    6,51 секунды за 2.126.031 вызов это время требуемое на матчинг всех
    имен экспорта/импорта из exe dll файлов (всего их 15.754 (dll/exe) маппится это обход всего диска) основной затык в функции которая первая обращается
    к памяти только что отмапленного файла 222,61 секунды на рисунке это ParseImport
    а сам маппинг бесплатный почти 54,58 это вместе с открытием и маппингом
    [​IMG]
     
  9. shadowrun

    shadowrun Banned

    Joined:
    29 Aug 2010
    Messages:
    857
    Likes Received:
    171
    Reputations:
    84
    Ищешь индекс символа @, копируешь слово от первого пробела перед этим словом и первого после слова, ну или место пробела может быть #13.
     
  10. fiery xray

    fiery xray New Member

    Joined:
    11 Jul 2011
    Messages:
    7
    Likes Received:
    2
    Reputations:
    3
    ну так можно найти в слове символ '@', найти последнюю точку '.' и вытащить всё, что между ними. рег. выражение делает то же самое, только оно в одну строчку записывается
     
  11. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    186
    Likes Received:
    148
    Reputations:
    45
    писалось когда то для вот этого XSpryt , но там все было заточено под свои типы и работу с памятью, собственно сам алгоритм парсинга работает, для метода в лоб нормально. Перекидала под Ваши нужды.

    Процедура
    PHP:
    //Процедура заносит все e-mail из строки
    procedure get_mail(list: TStrings; const strstring); cdecl;
    var
      
    ln_str integer// длинна строки
      
    s_f,s_einteger// начало и конец e-mail
      
    i,j    integer// вспомогательные
    begin
      ln_str 
    := length(str);
      if (
    ln_str <> 0then
      begin
        
    for i:=0 to ln_str do
        
    begin
           
    if str[i] = chr($40then
           begin
             s_f
    :=1;
             
    s_e:=1;

             for 
    j:=i-1 downto 0 do
             if 
    not (str[jin ['a'..'z''A'..'Z''0'..'9''_''-''.']) then
             
    if s_f=1 then s_f:=j+1;

             for 
    j:=i+1 to length(str) do
             if 
    not (str[jin ['a'..'z''A'..'Z''0'..'9''_''-''.']) then
             
    if s_e=1 then s_e:=j;

             
    // !!! WARNING ;-) тут внимательнее
             
    list.addcopy(str,s_f,s_e-s_f) );
           
    end;
         
    end;
      
    end;
    end;

    //Использование:
    get_mail(memo1.lines,'sj dr.ao@huizm.for.gov ahaqr iu/=?:*¹ami.ger@t.i_i.ru??ôhr ur');
     
    #11 Flame of Soul, 14 Sep 2011
    Last edited: 14 Sep 2011
  12. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    372
    Likes Received:
    51
    Reputations:
    7
    Сомнительный код, да и вообще сама функция немног неверно работает. И зачем такая деректива вызова?
     
  13. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    372
    Likes Received:
    51
    Reputations:
    7
    Вот так корректнее :
    Code:
    function ParseEmails(Const Emails : TStrings; Const Text : PString) : Boolean;
    Var i, s, e : Cardinal;
      function PassageSymbol(dx : Shortint) : Cardinal;
      Begin
          {$WARNINGS OFF}
          Result := i;
          while (Result+dx > 1) and (Result+dx <= Length(Text^)) and
                (Text^[Result+dx] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) do
            Result := Result + dx;
           {$WARNINGS ON}
      end;
    Begin
        Result := Length(Text^) <> 0;
        if not Result then
          Exit;
        i := 1;
        while i <= Length(Text^) do
          if Text^[i] = '@' then
          Begin
              s := PassageSymbol(-1);
              e := PassageSymbol(1);
              if (s = i) or (e = i) then
              Begin
                  Inc(i);
                  Continue;
              end;
              Emails.Add(Copy(Text^, s, e - s + 1));
              i := e + 1;
          end else
            Inc(i);
    end;
     
    1 person likes this.
  14. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    186
    Likes Received:
    148
    Reputations:
    45
    а вот захотела я так, ибо функция у меня лично находится в (dll,so,dylib - собственно на экспорте строго указываю, собственно как и в хиддерах потом, правильно так видимо. в данном случае оно не так уж и важно) Я выше упоминала, что у меня все реализовано на динамических массивах, а этот код просто быстрый порт под нужды ТС. Ну кто будет в динамическую библиотеку передавать TStrings ?? ну бред же, в общем директива там никчему за не надобностью. Просто отголоски портирования.

    По поводу сомнительности кода:
    ln_str := length(str); - чтобы не определять длину каждый раз

    if (ln_str <> 0) then begin - а вот это было действительно лишним.

    Но собственно, спасибо Вам за указание безолаберности кода, правильно, нечего расслабляться. Однако не примите за критику, хотела бы обратить Ваше внимание вот на что:

    1. Length(Text^) - зачем столько раз определять длину.
    2. отключение и игнорирование варнингов не гуд, пусть даже тут это ни чем не грозит.
    3. использование в подфункции типа [ShortInt с диапозоном -128 +128] однако по RFC 3696 мы можем пролететь на проверке с таким типом. Но это просто либо упущено из виду либо не знание спецификации, что собственно не критично. Вот ниже выдержка от туда, так что мой совет расширить диапозон, для стабильности функции.
    PHP:
    function ParseEmails(Const Emails TStrings; Const Text PString): longint;
    var 
    i,s,e,longint;
      function 
    Fringe(plongintdx smallint): longint;
      
    begin
        Result 
    := p;
          while (
    Result+dx 1) and (Result+dx <= l) and
                (
    Text^[Result+dxin ['a'..'z''A'..'Z''0'..'9''_''-''.']) do
                
    Result := Result dx;
      
    end;
    Begin
      result 
    := 0;
      
    := Length(Text^);
      if (
    l=0then exit;
      
    := 1;
      while 
    <= do
        if 
    Text^[i] = '@' then
        begin
          s 
    := Fringe(i,-1);
          
    := Fringe(i,1);
          if (
    i) or (ithen
          begin
            inc
    (i);
            continue;
          
    end;
          
    Emails.Add(Copy(Text^, s1));
          
    inc(result);
          
    := 1;
        
    end else inc(i);
    end;
     
    #14 Flame of Soul, 16 Sep 2011
    Last edited: 16 Sep 2011
  15. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    372
    Likes Received:
    51
    Reputations:
    7
    Не люблю плодить переменные, функция малюсенькая - особо много не прибавит добавление переменной.
    В том то и дело, что Length возвращает Int, а я использую UInt. Вообще не ясно почему решили использовать в Length знаковое целое, т.к. она не может выдать отрицательный результат. Предупреждения в таких местах нужно убирать, если нереально за диапазоны выйти. Я скорее более важные предупреждения увижу если таких тьма не будет вылезать.
    Ну да, не подумал, я думаю это не критично.
     
  16. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    372
    Likes Received:
    51
    Reputations:
    7
    Ну смотри, если использовать Const Text : String; то вся строка будет скопированна при вызове функции, а если использовать Var Text : String; то будет передан как бэ указатель, но это не кошерно, т.к. я ее изменять не буду, и из-за этого я частенько использую указатель, хотя сама по себе переменная String в Delphi является указателем. Может просто по не знанию тонкостей так делаю, даже если мне и разъяснят - все равно буду через указатели делать.
    Ну да, я видно тут не прав, раньше в циклах тоже использовал заранее рассчитанные данные, потом забил, т.к. профиту не много, а так пишешь на лету и как то не задумываешься если маленькая функция, вообще ее не плохо было бы еще inline сделать.
     
  17. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    372
    Likes Received:
    51
    Reputations:
    7
    Щас проверил - не копируется строка, ну и ладно.
     
Loading...