Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 06.08.2011, 17:12
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,560
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию Код - Проверка существования Email

Код:
uses WinSock;

function CheckDomain(Domain: string): Boolean;
var
 Error: DWORD;
 HostEntry: PHostEnt;
 Data: WSAData;
 Address: In_Addr;
begin
 Result:=false;
 Error:=WSAStartup(MakeWord(1, 1), Data);
 if Error=0 then
  begin
   HostEntry:=GetHostByName(PChar(Domain));
   Result:=GetLastError=0;
  end;
 WSACleanup();
end;

function CheckEmailAddr(Addr: string): Boolean;
var
 p,i: integer;
 User, Domain: string;
begin
 Result:=false;
 Addr:=AnsiLowerCase(Addr);
 P:=Pos('@', Addr);
 if P=0
 then Exit;
 User:=Copy(Addr,1,P-1);
 Domain:=Copy(Addr, P+1, Length(Addr)-P);
 for i:=1 to Length(User) do
  if not (User[i] in ['a'..'z', '0'..'9', '.', '-', '_'])
  then Exit;
  Result:=CheckDomain('www.'+Domain);
 if not Result
 then Result:=CheckDomain(Domain);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if CheckEmailAddr(Edit1.Text)=true
 then ShowMessage('E-mail существует!')
 else ShowMessage('E-mail НЕ существует!');
end;
Ответить с цитированием
  #2  
Старый 06.08.2011, 21:07
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Я думаю не прокатит (но можно проверить). У меня имеется на Мэйле адрес на который эти удоды потеряли пароль, восстанавливать я не стал. И что покажет?
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #3  
Старый 06.08.2011, 21:46
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Лампочка

Тут покажет что существует, короче этот код правду не покажет (мэйл на все запросы отвечает утвердительно), надо делать специально под каждый сервис почтовый и то еще останутся ограничения, ну если конечно Вы будете пакетно проверять.


ЗЫ
У меня есть программа, которая проверяет все это дело и заточена под все основные сервисы, если интересно, подкину огрызок кода от майла.
Ответить с цитированием
  #4  
Старый 06.08.2011, 22:05
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Подкинь, любопытно посмотреть.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #5  
Старый 07.08.2011, 01:03
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
По умолчанию

Код:
function TForm1.ValidMailRuEmailStatus(EMail: String): Boolean;
var
  ASource: TIdMultiPartFormDataStream;
  S { , M, N } : String;
  I, I2: Integer;
begin
  LOG(EMail);
  //
  IdHTTP1.HandleRedirects := FALSE; // Обяз-но!
  IdHTTP1.AllowCookies := FALSE;
  IdHTTP1.ReadTimeout := 10000; // !!!!!!!!
  IdHTTP1.ConnectTimeout := 10000; // !!!!!!!!!!
  //
  ASource := TIdMultiPartFormDataStream.Create;
  try
    ASource.AddFormField('action', 'login');
    ASource.AddFormField('Username', GetLogin(EMail));
    ASource.AddFormField('Domain', GetDomain(EMail));
    // GetValue обновить и использовать
    // showmessage(GetValue('', EMail, '', '@', I));
    // showmessage(GetValue('', EMail, '@', '', I));
    try
      S := IdHTTP1.Post('http://e.mail.ru/cgi-bin/passremind', ASource
        { , ms } );
    except
      // LOG('ValidWhoIsEmailStatus: POST To "'+EMail+'" Failed');
    end;
  finally
    ASource.Free;
  end;
  LOG(IdHTTP1.ResponseText);
  if idHTTP1.Connected then
  IdHTTP1.Disconnect;
  // LOG(idHTTP1.ResponseText);
  // memo1.Lines.Add(S);
  I := PosNew('Пользователь отсутствует', S);
  {if I = 0 then
  LOG('User Exists') else
  LOG('User NOT Exists');}
  I2 := PosNew('Не существует такого пользователя', S, I);
  RESULT := (I = 0) and (I2 = 0);
  //Sleep(500);
end;
Ответить с цитированием
  #6  
Старый 07.08.2011, 02:22
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Спасибо, посмотрю.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:49.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter