Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Delphi RegExpression Hilfe - E-Mail prüfen (https://www.delphipraxis.net/210839-regexpression-hilfe-e-mail-pruefen.html)

NoGAD 20. Jun 2022 10:56

RegExpression Hilfe - E-Mail prüfen
 
Hallo,

von BenBe habe ich eine funktionierende Maske für RegExp gefunden: https://entwickler-ecke.de/viewtopic...2767c07#340654.

Code:
[\w\d][\w\d\-]+@((\w[\w\d\-]*[\w\d]\.)+\w{2,3}|\d{1,9}|\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})
Leider weiß ich nicht, wie ich diese umbauen kann, damit auch (seit längerer Zeit existierende) 1-stellige Domains oder Umlaut-Domains mit erfasst werden.

Mir wäre sehr geholfen, wenn ich erklärt bekäme, wo in dem Code steht, dass test@12.de gültig, aber test@1.de ungültig ist.

LG Mathias :-)


Nach Tests auf https://regex101.com/ habe ich entdeckt, dass folgende Stellen dafür verantwortlich waren:

[\w\d][\w\d\-]+@((\w[\w\d\-]*[\w\d]\.)+\w{2,3}|\d{1,9}|\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3 })

Die Länge hat sich somit erledigt.

Aber wie kann ich jetzt noch Umlautdomains zulassen?

Ist dies hier korrekt?

Code:
[\w\d\_äÄöÖüÜß-]+@(([\w\d\_äÄöÖüÜß-]*[\w\d]\.)+\w{2,3}|\d{1,9}|\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})

himitsu 20. Jun 2022 12:16

AW: RegExpression Hilfe - E-Mail prüfen
 
Bei Google suchenRegEx RFC 2822
https://stackoverflow.com/questions/...2address-regex
https://regex101.com/library/DPiLbv?...OINTS&page=256
...
aber
https://blog.bmarwell.de/2013/05/04/...ex-prufen.html

NoGAD 20. Jun 2022 12:45

AW: RegExpression Hilfe - E-Mail prüfen
 
Hallo himitsu.

danke für die Links. Die Prüfung auf ein @ in der E-Mail-Adresse erscheint mir, trotz des letzten Links, dennoch zu profan.

Der zweite Link deckt keine Umlaute ab. Es gibt die Domains ö.de, ü.de und ü.de Hier könnten (theoretisch) auch E-Mails empfangen werden.

Mit der modifizierten RegExp, von BenBe, komme ich gut klar.

Hab vielen Dank und eine schöne Woche :-)

LG Mathias

himitsu 20. Jun 2022 13:32

AW: RegExpression Hilfe - E-Mail prüfen
 
In der Domain sind niemals umlaute ... in der URL ist es codiert

flüge.de
xn--flge-1ra.de

abcöäüßŵðë不用谢.de
xn--abc-7kay7b8a7b3c03fu452cmcxd0owc.de


Allerdings gilt das ACE nur für die Domain.
Der Name vor dem @ und alles hinter der Domain (also ab .de und der Pfad, Dateiname und die ?Parameter und der #Anker) haben jeweils eigene/andere Codierungen.

NoGAD 20. Jun 2022 13:53

AW: RegExpression Hilfe - E-Mail prüfen
 
Ach, warum ist das immer alles so kompliziert..

Dann nehme ich die Umlaute wieder raus, bis ich Lust habe, diese Kodierung einzubauen.

Ich danke Dir herzlich!

LG

mjustin 20. Jun 2022 14:56

AW: RegExpression Hilfe - E-Mail prüfen
 
Aus https://stackoverflow.com/a/44674038/80901

Zitat:

"^([\p{L}-_\.]+){1,64}@([\p{L}-_\.]+){2,255}.[a-z]{2,}$"
Damit sind internationale Domänen erlaubt.

Der reguläre Ausdruck wird nur bei der Eingabe z.B. in einem Edit-Feld verwendet. Bei der Erstellung der Mail muss diese noch gemäß den Standards kodiert werden, aber dass ist Aufgabe der E-Mail-Komponente, und für den Anwender der die Mail-Adresse eingibt, "unsichtbar".

Nachtrag: obiger Ausdruck unterstützt auch die "neuen" Domänen mit nur 2 oder mehr als 3 Zeichen, durch den Ausdruck "{2,}"

Code für die Domänen-Kodierung: https://stackoverflow.com/questions/...ic-domain-name

Stevie 20. Jun 2022 15:17

AW: RegExpression Hilfe - E-Mail prüfen
 
Ich werfe mal diese SO Antwort in den Raum

Rolf Frei 20. Jun 2022 15:19

AW: RegExpression Hilfe - E-Mail prüfen
 
Zitat:

Zitat von NoGAD (Beitrag 1507527)
Ach, warum ist das immer alles so kompliziert..

Dann nehme ich die Umlaute wieder raus, bis ich Lust habe, diese Kodierung einzubauen.

Ich danke Dir herzlich!

LG

Diese Codierung nennt sich Punycode. Hier habe ich dir eine Klasse, die du nutzen kannst. Habe nicht nachgeschaut ob es da in aktuellen Delphies schon sowas in den System Units gibt. Einfach vor dem Regex, deinen E-Mail per Punycode Encode codieren und dann diesen String überprüfen. Habe da zur Einfachheit noch eine Funktion gemacht (RF_PunyEncodeMailAddr), die du nutzen kannst, ohne das Objekt selber erstellen zu müssen. Ausserdem habe ich noch eine Funktion zum Üperprüfen der E-Mail angehängt (RF_ValidEmail), die ohne Regex auskommt und deutlich schneller ist.

Delphi-Quellcode:
  punycode_email := RF_PunyEncodeMailAddr('Joerg.Mueller@müller.de');
  if not RF_ValidEMail(punycode_email) then
    raise Exception.Create('E-Mail ungültig');
Bitte beachte, das Umlaute nur in der Domäne gültig sind und die Adresse davor keine Umlaute enthalten darf.


Delphi-Quellcode:
// Punycode Konvertierung
//
// Punycode: A Bootstring encoding of Unicode for Internationalized Domain Names in Applications (IDNA)
// http://www.rfc-editor.org/rfc/rfc3492.txt
//
// Delphi-Unit von Daniel Mitte (2005)
// Original-Code von http://www.activevb.de
//
// Beispiel:
// pc := TPunyClass.Create;
// e := pc.Encode('müller'); // Verschlüsselt 'müller' zu 'mller-kva'
// d := pc.Decode(e); // Entschlüsselt 'mller-kva' zu 'müller'
// pc.Free;

type
  TPunyClass = class
  private
    function GetMinCodePoint(const n: Longint; const data: WideString): Longint;
    function IsBasic(c: WideString; const n: Longint): Boolean;
    function Adapt(const delta, numpoints: Longint; const firsttime: Boolean): Longint;
    function Digit2Codepoint(const d: Longint): Longint;
    function Codepoint2Digit(const c: Longint): Longint;
    function UInt(i: Longint): Longint;
    function Asc(s: WideString): Longint;
    function AscW(s: WideString): Longint;
    function PosRev(sub, text: WideString): Longint;
  public
    function Encode(const input: WideString): WideString;
    function Decode(const input: WideString): WideString;
  end;


type
  TMyArrayOfString = array of string;

procedure GTL_StringExplode(var a: TMyArrayOfString; const Border, S: string);
var
  aStr: string;
  anIdx: Integer;
  aPos: integer;
begin
  anIdx := 0;
  aStr := S + Border;
  repeat
    SetLength(a, anIdx+1);
    aPos := Pos(Border, aStr);
    a[anIdx] := Copy(aStr, 0, aPos - 1);
    Delete(aStr, 1, Length(a[anIdx] + Border));
    Inc(anIdx);
  until aStr = '';
end;


function RF_PunyEncodeMailAddr(const AEMail: string): string;
var
  aStrings: TMyArrayOfString;
  aPunyStr: string;
  anIdx: integer;
begin
  Result := '';
  anIdx := Pos('@', AEMail);

  Result := Copy(AEMail, 1, anIdx-1);
  if anIdx > 0 then
    Result := Result +'@';
  aPunyStr := Copy(AEMail, anIdx+1, 255);

  GTL_StringExplode(aStrings, '.', aPunyStr);

  with TPunyClass.Create do
  try
    for anIdx := Low(aStrings) to High(aStrings) do
    begin
      aPunyStr := Encode(aStrings[anIdx]);
      if aPunyStr <> aStrings[anIdx] then
        aPunyStr := 'xn--' + aPunyStr;
      if anIdx > Low(aStrings) then
        aPunyStr := '.' + aPunyStr;
      Result := Result + aPunyStr;
    end;
  finally
    Free;
  end;
end;



const
  BASE: Longint = 36;
  TMIN: Longint = 1;
  TMAX: Longint = 26;
  SKEW: Longint = 38;
  DAMP: Longint = 700;
  INITIAL_BIAS: Longint = 72;
  INITIAL_N: Longint = 128;
  Delimiter: WideString = '-';
  MAX_INT: Longint = 2147483647;

function TPunyClass.Encode(const input: WideString): WideString;
var
  n, delta, bias, b, l, h, q, m, k, t: Longint;
  text, output, c: WideString;
  first: Boolean;

begin
  text := input;
  output := '';

  try
    n := INITIAL_N;
    bias := INITIAL_BIAS;
    b := 0;

    for l := 1 to Length(text) do
    begin
      c := Copy(text, l, 1);

      if IsBasic(c, INITIAL_N) = True then
      begin
        output := output + c;
        b := b + 1;
      end;
    end;

    if Length(output) < Length(text) then
      if Length(output) > 0 then output := output + Delimiter;

    h := b;
    delta := 0;

    while h < Length(text) do
    begin
      m := GetMinCodePoint(n, text);
      delta := delta + UInt(m - n) * (h + 1);

      n := m;

      for l := 1 to Length(text) do
      begin
        c := Copy(text, l, 1);
        if IsBasic(c, n) = True then delta := delta + 1
        else if UInt(AscW(c)) = n then
        begin
          q := delta;

          k := BASE;
          while k <= MAX_INT do
          begin
            if k <= (bias + TMIN) then t := TMIN
            else if k >= (bias + TMAX) then t := TMAX
            else t := k - bias;

            if q < t then break;

            output := output + Chr(Digit2Codepoint(t + ((q - t) Mod (BASE - t))));
            q := (q - t) div (BASE - t);

            k := k + BASE;
          end;

          output := output + Chr(Digit2Codepoint(q));
          first := False;
          if h = b then first := True;
          bias := Adapt(delta, h + 1, first);
          delta := 0;
          h := h + 1;
        end;
      end;

      delta := delta + 1;
      n := n + 1;
    end;
  except
    output := input;
  end;

  Result := output;
end;

function TPunyClass.Decode(const input: WideString): WideString;
var
  n, i, bias, l, ps, oldi, w, k, t: Longint;
  digit: Byte;
  text, output, c: WideString;
  first: Boolean;

begin
  text := input;
  output := '';

  try
    n := INITIAL_N;
    bias := INITIAL_BIAS;
    i := 0;

    ps := PosRev(Delimiter, text);

    if ps > 0 then
    begin
      for l := 1 to (ps - 1) do
      begin
        c := Copy(text, l, 1);

        if IsBasic(c, INITIAL_N) = True then output := output + c
        else
        begin
          Result := '';
          Exit;
        end;
      end;
    end;

    ps := ps + 1;

    while ps <= Length(text) do
    begin
      oldi := i;
      w := 1;

      k := BASE;
      while ((k <= MAX_INT) and (ps <= Length(text))) do
      begin
        c := Copy(text, ps, 1);
        ps := ps + 1;

        digit := Codepoint2Digit(Asc(c));
        if ((digit >= BASE) or (digit > ((MAX_INT - i) / w))) then
        begin
          Result := '';
          Exit;
        end;

        i := i + digit * w;

        if k <= bias then t := TMIN
        else if k >= (bias + TMAX) then t := TMAX
        else t := k - bias;

        if digit < t then break;

        if w > (maxint / (base - t)) then
        begin
          Result := '';
          Exit;
        end;

        w := w * (BASE - t);

        k := k + BASE;
      end;

      first := False;
      if oldi = 0 then first := True;
      bias := Adapt(i - oldi, Length(output) + 1, first);

      if (i / (Length(output) + 1)) > (MAX_INT - n) then
      begin
        Result := '';
        Exit;
      end;

      n := n + i div (Length(output) + 1);
      i := i mod (Length(output) + 1);

      if IsBasic(WideChar(n), INITIAL_N) = True then
      begin
        Result := '';
        Exit;
      end;

      output := Copy(output, 1, i) + WideChar(n) + Copy(output, i + 1, Length(output) - (i + 1) + 1);
      i := i + 1;
    end;
  except
    output := input;
  end;

  Result := output;
end;

function TPunyClass.GetMinCodePoint(const n: Longint; const data: WideString): Longint;
var
  t, a, res: Longint;

begin
  res := 2147483647;

  for t := 1 to Length(data) do
  begin
    a := UInt(AscW(Copy(data, t, 1)));
    if ((a >= n) and (a < res)) then res := a;
  end;

  Result := res;
end;

function TPunyClass.IsBasic(c: WideString; const n: Longint): Boolean;
begin
  Result := False;
  if UInt(AscW(c)) < n then Result := True;
end;

function TPunyClass.Adapt(const delta, numpoints: Longint; const firsttime: Boolean): Longint;
var
  k, dt: Longint;

begin
  dt := delta;

  if firsttime = True then dt := dt div DAMP
  else dt := dt div 2;

  dt := dt + (dt div numpoints);
  k := 0;

  while dt > (((BASE - TMIN) * TMAX) div 2) do
  begin
    dt := dt div (BASE - TMIN);
    k := k + BASE;
  end;

  Result := k + (((BASE - TMIN + 1) * dt) div (dt + SKEW));
end;

function TPunyClass.Digit2Codepoint(const d: Longint): Longint;
begin
  Result := 0;

  if d < 26 then Result := d + 97
  else if d < 36 then Result := d - 26 + 48;
end;

function TPunyClass.Codepoint2Digit(const c: Longint): Longint;
begin
  Result := BASE;

  if (c - 48) < 10 then Result := c - 22
  else if (c - 65) < 26 then Result := c - 65
  else if (c - 97) < 26 then Result := c - 97;
end;

function TPunyClass.UInt(i: Longint): Longint;
begin
  Result := i;
  if i < 0 then Result := 65536 + i;
end;

function TPunyClass.Asc(s: WideString): Longint;
var
  c: WideChar;

begin
  Result := 0;

  if Length(s) > 0 then
  begin
    c := s[1];
    Result := Word(c);
  end;
end;

function TPunyClass.AscW(s: WideString): Longint;
var
  c: WideChar;

begin
  Result := 0;

  if Length(s) > 0 then
  begin
    c := s[1];
    Result := Longint(c);
  end;
end;

function TPunyClass.PosRev(sub, text: WideString): Longint;
var
  p: Longint;
  s: WideString;

begin
  Result := 0;

  s := '';
  for p := 1 to Length(text) do s := s + Copy(text, Length(text) - p + 1, 1);

  p := Pos(sub, s);
  if p > 0 then Result := Length(s) - p + 1;
end;

// End of Punny Code
///////////////////////////////////


function RF_ValidEMail(AEMail: string): Boolean;
// Returns True if the email address is valid for RFC 2822
// Author: Ernesto D'Spirito / modified R.Frei
const
  // Valid characters in an "atom"
  atom_chars = ['A'..'Z', 'a'..'z', '0'..'9', '!', '#', '$', '%', '&', '''', '*', '+',
    '-', '/', '=', '?', '^', '_', '`', '(', '|', ')', '~'];

  // Valid characters in a "quoted-string"
  quoted_string_chars = [#0..#255] - ['"', #13, '\'];
  // Valid characters in a subdomain
  letters = ['A'..'Z', 'a'..'z'];
  letters_digits = ['0'..'9', 'A'..'Z', 'a'..'z'];
  subdomain_chars = ['-', '0'..'9', 'A'..'Z', 'a'..'z'];
type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  i, n, subdomains, LastSubDomSep: Integer;
  c: Char;
begin
  AEMail := RF_PunyEncodeMailAddr(AEMail);
  State := STATE_BEGIN;
  n := Length(AEMail);
  i := 1;
  LastSubDomSep := 0;
  subdomains := 1;
  while (i <= n) do
  begin
    c := AEMail[i];
    case State of
      STATE_BEGIN:
        if CharInSet(c, atom_chars) then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_ATOM:
        if c = '@' then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else if not CharInSet(c, atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not CharInSet(c, quoted_string_chars) then
          break;
      STATE_QCHAR:
        State := STATE_QTEXT;
      STATE_QUOTE:
        if c = '@' then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else
          break;
      STATE_LOCAL_PERIOD:
        if CharInSet(c, atom_chars) then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if CharInSet(c, letters_digits) then // rf. Orignal nur letters. 8488.ch wäre aber dann falsch?!
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then
        begin
          Inc(subdomains);
          LastSubDomSep := i;
          State := STATE_EXPECTING_SUBDOMAIN
        end
        else if c = '-' then
          State := STATE_HYPHEN
        else if not CharInSet(c, letters_digits) then
          break;
      STATE_HYPHEN:
        if CharInSet(c, letters_digits) then
          State := STATE_SUBDOMAIN
        else if c <> '-' then
          break;
    end;
    Inc(i);
  end;
  if i <= n then
    Result := False
  else
    Result := (State = STATE_SUBDOMAIN) and (subdomains >= 2) and (n - LastSubDomSep >= 2);
end;

Stevie 20. Jun 2022 15:29

AW: RegExpression Hilfe - E-Mail prüfen
 
Zitat:

Zitat von Rolf Frei (Beitrag 1507539)
Habe nicht nachgeschaut ob es da in aktuellen Delphies schon sowas in den System Units gibt.

TURI.IDNAToUnicode
TURI.UnicodeToIDNA

Der schöne Günther 20. Jun 2022 17:26

AW: RegExpression Hilfe - E-Mail prüfen
 
Liste der Anhänge anzeigen (Anzahl: 1)
Ich liebe das immer wenn Masken meine gültige Email-Adresse (enthält ein Plus-Zeichen) ablehnen weil jemand das irgendwie vorab "prüfen" musste.


Alle Zeitangaben in WEZ +1. Es ist jetzt 23:31 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz