pr_wainwright
asked on
Verify e-mail address is valid
How do I verify an e-mail address typed by a user into an edit box is valid ?. i.e. of the correct format name@xxxxx.xxx
Thanks
Paul.
Thanks
Paul.
A quick and dirty one I use is:
if (Pos('@', Edit1.Text) = 0) or (Pos('.', Edit1.Text) = 0) then ShowMessage('Invalid E-Mail Address');
if (Pos('@', Edit1.Text) = 0) or (Pos('.', Edit1.Text) = 0) then ShowMessage('Invalid E-Mail Address');
I will try to come up with a e-mail verification funtion and will let you know!VSF
www.victory.hpg.com.br
This is not exactly what you need but I think it can help
function VerifyURL(S: string): Boolean;
const
BADCHARS = ';*<>{}[]|\()^!';
var
p, x, c, count, i: Integer;
begin
Result := False;
if (Length(S) > 5) and (S[Length(S)] <> '.') and (Pos(S, '..') = 0) then
begin
for i := Length(BADCHARS) downto 1 do
begin
if Pos(BADCHARS[i], S) > 0 then
begin
exit;
end;
end;
for i := 1 to Length(S) do
begin
if (Ord(S[i]) < 33) or (Ord(S[i]) > 126) then
begin
exit;
end;
end;
if ((Pos('www.',LowerCase(S)) = 1) and (Pos('.', Copy(S, 5, Length(s))) > 0) and (Length(S) > 7)) or ((Pos('news:', LowerCase(S)) = 1) and (Length(S) > 7) and (Pos('.', Copy(S, 5, Length(S))) > 0)) then
begin
end
else if ((Pos('mailto:', LowerCase(S)) = 1) and (Length(S) > 12) and (Pos('@', S) > 8) and (Pos('.', S) > 10) and (Pos('.', S) > (Pos('@', S) +1))) or ((Length(S) > 6) and (Pos('@', S) > 1) and (Pos('.', S) > 4) and (Pos('.', S) > (Pos('@', S) +1))) then
begin
Result := True;
Exit;
end
else if ((Pos('http://', LowerCase(S)) = 1) and (Length(S) > 10) and (Pos('.', S) > 8)) or ((Pos('ftp://', LowerCase(S)) = 1) and (Length(S) > 9) and (Pos('.', S) > 7)) then
begin
Result := True;
Exit;
end
else
begin
Result := True;
end;
for Count := 1 to 4 do
begin
p := Pos('.',S) - 1;
if p < 0 then
begin
p := Length(S);
end;
Val(Copy(S, 1, p), x, c);
if ((c <> 0) or (x < 0) or (x > 255) or (p>3)) then
begin
Result := False;
Break;
end;
Delete(S, 1, p + 1);
end;
if (S <> '') then
begin
Result := False;
end;
end;
end;
www.victory.hpg.com.br
This is not exactly what you need but I think it can help
function VerifyURL(S: string): Boolean;
const
BADCHARS = ';*<>{}[]|\()^!';
var
p, x, c, count, i: Integer;
begin
Result := False;
if (Length(S) > 5) and (S[Length(S)] <> '.') and (Pos(S, '..') = 0) then
begin
for i := Length(BADCHARS) downto 1 do
begin
if Pos(BADCHARS[i], S) > 0 then
begin
exit;
end;
end;
for i := 1 to Length(S) do
begin
if (Ord(S[i]) < 33) or (Ord(S[i]) > 126) then
begin
exit;
end;
end;
if ((Pos('www.',LowerCase(S))
begin
end
else if ((Pos('mailto:', LowerCase(S)) = 1) and (Length(S) > 12) and (Pos('@', S) > 8) and (Pos('.', S) > 10) and (Pos('.', S) > (Pos('@', S) +1))) or ((Length(S) > 6) and (Pos('@', S) > 1) and (Pos('.', S) > 4) and (Pos('.', S) > (Pos('@', S) +1))) then
begin
Result := True;
Exit;
end
else if ((Pos('http://', LowerCase(S)) = 1) and (Length(S) > 10) and (Pos('.', S) > 8)) or ((Pos('ftp://', LowerCase(S)) = 1) and (Length(S) > 9) and (Pos('.', S) > 7)) then
begin
Result := True;
Exit;
end
else
begin
Result := True;
end;
for Count := 1 to 4 do
begin
p := Pos('.',S) - 1;
if p < 0 then
begin
p := Length(S);
end;
Val(Copy(S, 1, p), x, c);
if ((c <> 0) or (x < 0) or (x > 255) or (p>3)) then
begin
Result := False;
Break;
end;
Delete(S, 1, p + 1);
end;
if (S <> '') then
begin
Result := False;
end;
end;
end;
ASKER
VSF,
Your function works fine for most email addresses but my company's email format is 'paul.wainwright@unilever. com' which is invalid. The first '.' makes the email invalid. How would i modify the code to accept this format ?. I have tried but can't get it to work properly !.
Thanks
Paul.
Your function works fine for most email addresses but my company's email format is 'paul.wainwright@unilever.
Thanks
Paul.
You could try something like this:
function IsEmailAddressInvalid(cons t S : string) : Boolean; // Returns True if Email Addy is Invalid
var
I : Integer;
Temp : string;
begin
Result := (Trim(S) = '') or
(Pos(' ', AnsiLowerCase(S)) > 0) or
(Pos('a', AnsiLowerCase(S)) > 0) or
(Pos('o', AnsiLowerCase(s)) > 0) or
(Pos('u', AnsiLowerCase(S)) > 0) or
(Pos('?', AnsiLowerCase(S)) > 0) or
(Pos('[', AnsiLowerCase(S)) > 0) or
(Pos(']', AnsiLowerCase(S)) > 0) or
(Pos('(', AnsiLowerCase(S)) > 0) or
(Pos(')', AnsiLowerCase(S)) > 0) or
(Pos(':', AnsiLowerCase(S)) > 0);
if Result then
Exit;
I := Pos('@', S);
Result := (I = 0) or (I = 1) or (I = Length(S));
if Result then
Exit;
Result := (Pos('@', Copy(S, I + 1, Length(S) - 1)) > 0);
if Result then
Exit;
Temp := Copy(S, I + 1, Length(S));
Result := Length(Temp) <= 1;
if Result then
Exit;
I := Pos('.', Temp);
Result := (I = 0) or (I = 1) or (I = Length(Temp));
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
if IsEmailAddressInvalid('pau l.wainwrig ht@unileve r.com') then
ShowMessage('Email Address is Invalid.')
else
ShowMessage('Email Address is valid.');
end;
function IsEmailAddressInvalid(cons
var
I : Integer;
Temp : string;
begin
Result := (Trim(S) = '') or
(Pos(' ', AnsiLowerCase(S)) > 0) or
(Pos('a', AnsiLowerCase(S)) > 0) or
(Pos('o', AnsiLowerCase(s)) > 0) or
(Pos('u', AnsiLowerCase(S)) > 0) or
(Pos('?', AnsiLowerCase(S)) > 0) or
(Pos('[', AnsiLowerCase(S)) > 0) or
(Pos(']', AnsiLowerCase(S)) > 0) or
(Pos('(', AnsiLowerCase(S)) > 0) or
(Pos(')', AnsiLowerCase(S)) > 0) or
(Pos(':', AnsiLowerCase(S)) > 0);
if Result then
Exit;
I := Pos('@', S);
Result := (I = 0) or (I = 1) or (I = Length(S));
if Result then
Exit;
Result := (Pos('@', Copy(S, I + 1, Length(S) - 1)) > 0);
if Result then
Exit;
Temp := Copy(S, I + 1, Length(S));
Result := Length(Temp) <= 1;
if Result then
Exit;
I := Pos('.', Temp);
Result := (I = 0) or (I = 1) or (I = Length(Temp));
end;
procedure TForm1.Button1Click(Sender
begin
if IsEmailAddressInvalid('pau
ShowMessage('Email Address is Invalid.')
else
ShowMessage('Email Address is valid.');
end;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Alan,
Your function is exactly what i require.
Thanks
Paul.
Your function is exactly what i require.
Thanks
Paul.
www.victory.hpg.com.br
This is not exactly what you need but I think it can help
function VerifyURL(S: string): Boolean;
const
BADCHARS = ';*<>{}[]|\()^!';
var
p, x, c, count, i: Integer;
begin
Result := False;
if (Length(S) > 5) and (S[Length(S)] <> '.') and (Pos(S, '..') = 0) then
begin
for i := Length(BADCHARS) downto 1 do
begin
if Pos(BADCHARS[i], S) > 0 then
begin
exit;
end;
end;
for i := 1 to Length(S) do
begin
if (Ord(S[i]) < 33) or (Ord(S[i]) > 126) then
begin
exit;
end;
end;
if ((Pos('www.',LowerCase(S))
begin
end
else if ((Pos('mailto:', LowerCase(S)) = 1) and (Length(S) > 12) and (Pos('@', S) > 8) and (Pos('.', S) > 10) and (Pos('.', S) > (Pos('@', S) +1))) or ((Length(S) > 6) and (Pos('@', S) > 1) and (Pos('.', S) > 4) and (Pos('.', S) > (Pos('@', S) +1))) then
begin
Result := True;
Exit;
end
else if ((Pos('http://', LowerCase(S)) = 1) and (Length(S) > 10) and (Pos('.', S) > 8)) or ((Pos('ftp://', LowerCase(S)) = 1) and (Length(S) > 9) and (Pos('.', S) > 7)) then
begin
Result := True;
Exit;
end
else
begin
Result := True;
end;
for Count := 1 to 4 do
begin
p := Pos('.',S) - 1;
if p < 0 then
begin
p := Length(S);
end;
Val(Copy(S, 1, p), x, c);
if ((c <> 0) or (x < 0) or (x > 255) or (p>3)) then
begin
Result := False;
Break;
end;
Delete(S, 1, p + 1);
end;
if (S <> '') then
begin
Result := False;
end;
end;
end;