smartvanl5
asked on
How to check valid email address ...
How to check valid email and existance of address using DNS ....
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;
procedure TForm1.Button1Click(Sender
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(t mpName), 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(procIn fo.hProces s, Infinite);
GetExitCodeProcess(procInf o.hProcess , return);
Result := (return = 0);
CloseHandle(procInfo.hThre ad);
CloseHandle(procInfo.hProc ess);
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(re s)" *)
Listbox1.Items.AddStrings( res);
finally
res.Free;
end;
Windows.DeleteFile(PChar(t mpName));
end
else
begin
Application.MessageBox(PCh ar(SysErro rMessage(G etLastErro r())), 'RunCaptured Error', MB_OK);
end;
except
Windows.CloseHandle(tmp);
Windows.DeleteFile(PChar(t mpName));
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
(* 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(t
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.
WaitForSingleObject(procIn
GetExitCodeProcess(procInf
Result := (return = 0);
CloseHandle(procInfo.hThre
CloseHandle(procInfo.hProc
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(re
Listbox1.Items.AddStrings(
finally
res.Free;
end;
Windows.DeleteFile(PChar(t
end
else
begin
Application.MessageBox(PCh
end;
except
Windows.CloseHandle(tmp);
Windows.DeleteFile(PChar(t
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
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
ASKER
HillGroover,
Thanks for the example, The EmailValidator Application just validating domain only.
Is there any other way to validate email.
Thanks & Regards,
Thanks for the example, The EmailValidator Application just validating domain only.
Is there any other way to validate email.
Thanks & Regards,
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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