Link to home
Start Free TrialLog in
Avatar of smartvanl5
smartvanl5

asked on

How to check valid email address ...

How to check valid email and existance of address using DNS ....

Avatar of HillGroover
HillGroover



This will validate an email address for you in accordance with RFC #822 "STANDARD FOR THE FORMAT OF ARPA INTERNET TEXT MESSAGES".

function isValidEmail(email: string): boolean;
  // Returns True if the email address is valid
  const
    // Valid characters in an "atom"
    atom_chars = [#33..#255] - ['(', ')', '<', '>', '@', ',', ';', ':', '\', '/', '"', '.', '[', ']', #127];
    // 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: integer;
    c: char;
  begin
    State := STATE_BEGIN;
    n := Length(email);
    i := 1;
    subdomains := 1;
    while (i <= n) do begin
      c := email[i];
      case State of
      STATE_BEGIN:
        if c in 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 (c in atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not (c in 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 c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if c in letters then
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then begin
          inc(subdomains);
          State := STATE_EXPECTING_SUBDOMAIN
        end else if c = '-' then
          State := STATE_HYPHEN
        else if not (c in letters_digits) then
          break;
      STATE_HYPHEN:
        if c in 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);
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if isValidEmail(edit1.text) then
      showmessage(‘Email is valid’)
   else showmessage(‘Email is not valid’);
end;

can't do anything about checking with DNS at the moment as iI don't have delphi at work :o(   I love my job, i do i do i do
not sure how to go about that right now either, will check and see if i can come up with anything.

HTH
ali
another function...

procedure TForm1.Button1Click(Sender: TObject);
 
  function IsEMail(EMail: string): Boolean;
  var
    s: string;
    ETpos: Integer;
  begin
    ETpos := pos('@', EMail);
    if ETpos > 1 then
    begin
      s := copy(EMail, ETpos + 1, Length(EMail));
      if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
        Result := true
      else
        Result := false;
    end
    else
      Result := false;
  end;
begin
  //Call example
  if IsEMail('pepe@yahoo.com') then ShowMessage('eMail Ok');
end;
with either example above the following should suffice for checking with DNS

(* This function creates a DOS Console and displays the output in Listbox1 *)
function RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
var
   start: TStartupInfo;
   procInfo: TProcessInformation;
   tmpName: string;
   tmp: Windows.THandle;
   tmpSec: TSecurityAttributes;
   res: TStringList;
   return: Cardinal;
begin
   Result := False;
   try
      { Set a temporary file }
      tmpName := 'Test.tmp';
      FillChar(tmpSec, SizeOf(tmpSec), #0);
      tmpSec.nLength := SizeOf(tmpSec);
      tmpSec.bInheritHandle := True;
      tmp := Windows.CreateFile(PChar(tmpName), Generic_Write, File_Share_Write, @tmpSec, Create_Always, File_Attribute_Normal, 0);
      try
         FillChar(start, SizeOf(start), #0);
         start.cb          := SizeOf(start);
         start.hStdOutput  := tmp;
         start.dwFlags     := StartF_UseStdHandles or StartF_UseShowWindow;
         start.wShowWindow := SW_HIDE;
         { Start the program }
         if CreateProcess(nil, PChar(_exeName + ' ' + _cmdLine), nil, nil, True, 0, nil, PChar(_dirName), start, procInfo) then
         begin
            SetPriorityClass(procInfo.hProcess, Idle_Priority_Class);
            WaitForSingleObject(procInfo.hProcess, Infinite);
            GetExitCodeProcess(procInfo.hProcess, return);
            Result := (return = 0);
            CloseHandle(procInfo.hThread);
            CloseHandle(procInfo.hProcess);
            Windows.CloseHandle(tmp);
            { Add the output }
            res := TStringList.Create;
               try
                  res.LoadFromFile(tmpName);
                  (* change the control the results are displayed in here *)
                  (* for instance "memo1.lines.addstrings(res)"           *)
                  Listbox1.Items.AddStrings(res);
               finally
                  res.Free;
               end;
            Windows.DeleteFile(PChar(tmpName));
         end
         else
         begin
            Application.MessageBox(PChar(SysErrorMessage(GetLastError())), 'RunCaptured Error', MB_OK);
         end;
      except
         Windows.CloseHandle(tmp);
         Windows.DeleteFile(PChar(tmpName));
         raise;
      end;
   finally
   end;
end;

function BreakApart(var BaseString: string; BreakString: string): string;
var
  EndOfCurrentString: Integer;
  TempStr, TempBaseString: string;
  Stringlist: TStringList;
  AllowEmptyString: boolean;
begin
  AllowEmptyString := false;
  StringList := TStringList.Create;
  StringList.Clear;
  TempBaseString := BaseString;
  repeat
     EndOfCurrentString := Pos(BreakString, TempBaseString);
     if EndOfCurrentString = 0 then
        TempStr := TempBaseString
     else
        TempStr := Copy(TempBaseString, 1, EndOfCurrentString - 1);

     if ((TempStr = '') and AllowEmptyString) or (TempStr <> '') then
        StringList.add(TempStr);

     TempBaseString := Copy(TempBaseString, EndOfCurrentString + length(BreakString), length(TempBaseString) - EndOfCurrentString);
  until EndOfCurrentString = 0;
  Result := TempBaseString;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   x, t: string;
begin
   if isValidEmail(Edit1.text) then
(* if IsEMail(Edit1.Text) then - if using ThoseBug's example *)
      begin
         t := Edit1.Text;
         x := breakapart(t, '@');
         Listbox1.Items.Clear;
         RunCaptured('C:\', 'nslookup.exe', x);
      end
   else ShowMessage('Email address doesn''t appear to be valid')
end;


i've uploaded a demo of my example to http://myweb.tiscali.co.uk/eterniti/Delphi/EmailValidator.zip

this will check if the domain name exists using nslookup.exe and display the results in a listbox, it can also hide the listbox to make it more user friendly.

ali
Avatar of smartvanl5

ASKER

HillGroover,

Thanks for the example, The EmailValidator Application just validating domain only.

Is there any other way to validate email.

Thanks & Regards,
ASKER CERTIFIED SOLUTION
Avatar of HillGroover
HillGroover

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial