Suceh nach MailAdressen in Strings

[Sascha_OW]

Hallo,

ich habe folgendes Problem:

ich habe einen String in der ein Text steht in der Mail Adressen drinstehen. Diese Mail Adressen muss ich jetzt rausbekommen.

Delphi-Quellcode:

procedure TForm1.Button3Click(Sender: TObject);
var i,f,x,y :integer;
    zeile, buchstabe:string;
    suchen :boolean;
    wort:string;
begin
   For f := 1 to Memo2.lines.Count -1 do begin
      zeile := Memo2.lines[f];
      For i := 1 to length(zeile) do begin
         buchstabe := zeile[i];
         If buchstabe = '@' then begin
           x := i;
         end;
         While suchen do begin
           For y := x downto 1 do begin
              mail(zeile[y]);
              wort := wort + zeile[y];
           end;
         end;
      end;
   end;
end;

Die Function Mail auch noch:

Delphi-Quellcode:

function mail (text:char): boolean;
 var test : integer;
begin
 If ((ord(text) <=122) and (ord(text) >=65)) or (ord(text) = 95) or (ord(text) = 150) or (ord(text) = 45) then begin
    result := true;
  end else result := false;

end;

so weit habe ich das bis jetzt gemacht nur leider geht das nicht, könnt ihr mir sagen wo bei denkt fehler sit

[sh17]

Delphi-Quellcode:

 While suchen do begin 
           For y := x downto 1 do begin 
              mail(zeile[y]); 
              wort := wort + zeile[y]; 
           end; 
         end;

wenn [e-mail] in der liste stehen würde, kommt bei dir nur

@hci raus.

Du musst vom @ (x) ausgehenden nach links und nach rechts bis zum nächsten Leerzeichen

[Sascha_OW]

So jetzt ein neuer Anlauf habe den Quelltext geändertu nd es will trotzdem nicht

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,URLMon, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button2: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Button3: TButton;
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  posi :integer;
implementation

{$R *.dfm}


function mail (text:char): boolean;
 var test : integer;
begin
 If ((ord(text) <=122) and (ord(text) >=65)) or (ord(text) = 95) or (ord(text) = 150) or (ord(text) = 45) then begin
    result := true;
  end else result := false;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
URLDownloadtofile(nil, PChar(Edit1.Text), PChar('c:\hp1.txt'), 0, nil);
  Memo1.Lines.LoadFromFile('c:\hp1.txt')  ;
  Button2.click;
  button3.Click;
  DeleteFile('C:\hp1.txt');
except
ShowMessage ('Kann Quelltext der Seite nicht Downloaden');
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var zeile, buchstabe : string;
    i,f :integer;
begin
  For f := 0 to Memo1.lines.count -1 do begin
    zeile := Memo1.Lines[f];
    For i := 1 to length(Zeile) do begin
      buchstabe := Zeile[i];
      If buchstabe = '@' then begin
        Memo2.lines.add (zeile);
      end;
    end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,f,x,a,e,y :integer;
    Zeile, buchstabe, anfang, ende, wort :string;
begin
    a := 0;
    e := 0;
    For f := 0 to Memo2.lines.count -1 do begin
      zeile := Memo2.lines[f];
      For i := 1 to Length(zeile) do begin
        buchstabe := zeile[i];
        If buchstabe = '@' then begin
           a := i;
           e := i;
           While (anfang = '>') or (anfang=':') do begin
              a := a -1;
              anfang := zeile[a];
           end;
           While ende = '<' do begin
             inc(e);
             ende := zeile[e];
           end;
           For y := a +3 to e -1 do begin
             wort := wort + zeile[y];
           end;
           Memo3.lines.add (wort);
           wort := '';
           anfang := '';
           ende := '';
        end;
      end;
    end;
    end;

[sh17]

1. Fängt eine Mail-Addresse bei Die mir einem > an und hört mit einem < auf?
2. in der While-Schleife musst Du auf ungleich testen
3. Du musst auf die String-Grenzen prüfen

Delphi-Quellcode:

 While (anfang <> '>') and (anfang <> ':') do 
begin 
  a := a -1; 
  if a < 1 then break;
  anfang := zeile[a]; 
end; 
While ende <> '<' do 
begin 
  inc(e); 
  if e >= Length(zeile[e]) then break;
  ende := zeile[e]; 
end;

[marabu]

Hallo Sascha,

wenn du einen Parser für ein bestimmtes Format einer mail Adresse brauchst, dann solltest du zuerst das Format beschreiben. Wenn du allerdings einen Universal-Parser brauchst, wie er von einem mail harvester benötigt wird um Adress-Datenbanken für Spammer aufzubauen, dann werden es noch erheblich mehr Code Zeilen werden müssen - oder du verwendest regular expressions.

Freundliche Grüße vom marabu

[Sascha_OW]

Also das Format ist HTML.

Also warum ich das mache ich klar. Ich habe ein Gästebuch und aus dem will ich die Adressen rausbekommen:

Code entfernt und als Anhang an das Posting gehängt

[edit=Sharky]Siehe nächstes Posting. Mfg, Sharky[/edit]

[Sharky]

Hai Sascha,

hänge solch langen Code bitte als Anhang an dein Posting. Bei solch überlangen "Dingern" scrollt man sich sonst die Flossen wund.
Danke.