Авторизация на Mail.ru

Исходники делфи, готовые программы/приложения и т.д.
Ответить
Аватара пользователя
glGizma
Site Admin
Сообщения: 182
Зарегистрирован: Ср сен 27, 2017 2:20 pm

Авторизация на Mail.ru

Сообщение glGizma » Сб янв 19, 2019 3:12 am

Код: Выделить всё

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdCookieManager, idCookie, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, StdCtrls, ComCtrls, ExtCtrls, JPEG, XPMan,
  IdAntiFreezeBase, IdAntiFreeze;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    XPManifest1: TXPManifest;
    Label2: TLabel;
    IdAntiFreeze1: TIdAntiFreeze;
    Shape1: TShape;
    Label3: TLabel;
    Image3: TImage;
    Label4: TLabel;
    Label5: TLabel;
    Bevel1: TBevel;
    Image4: TImage;
    Label6: TLabel;
    Edit1: TEdit;
    Label7: TLabel;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    Button2: TButton;
    Button3: TButton;
    Label8: TLabel;
    Label9: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure IdCookieManager1NewCookie(ASender: TObject;
      ACookie: TIdCookieRFC2109; var VAccept: Boolean);
    procedure Button3Click(Sender: TObject);
    procedure IdHTTP1Connected(Sender: TObject);
    procedure IdHTTP1Disconnected(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure GetDataPage;
  end;

var
  Form1: TForm1;
  FConnected: Boolean;

implementation

{$R *.dfm}

function Pars(TextIn, Text, TextOut: string): string;
var
  TempStr: string;
begin
  Result := '';
  TempStr := Text;
  TempStr := Copy(TempStr, Pos(TextIn, TempStr) +7, Length(TempStr));
  Delete(TempStr, Pos(TextOut, TempStr), Length(TempStr));
  Result := TempStr;
end;

function ValidText(URL,Text: string): boolean;
var
  Str, Send : string;
  P : integer;
begin
  Str := Text;
  Send := Form1.IdHTTP1.Get(URL);
  P  := Pos(Str, Send);
  if P > 0 then
   result := true
  else
   result := false;
end;

function GetImageJpeg(IdHTTP: TIdHTTP; URL: string; DrawToImage: TImage): TJpegImage;
var
  MemoryStream: TMemoryStream;
  Img: TJpegImage;
begin
  MemoryStream := TMemoryStream.Create;
  Img := TJpegImage.Create;
  try
    IdHTTP.Get(URL, MemoryStream);
    MemoryStream.Position := 0;
    Img.LoadFromStream(MemoryStream);
    DrawToImage.Picture.Graphic := Img;
    DrawToImage.Repaint;
  finally
    MemoryStream.Free;
    Result := Img;
    Img.Free;
  end;
end;

function MailLogIn(Login,Password: string): boolean;
var
  PostData: TStringList;
  PageData: TStringList;
  Domain: string;
begin
  result := false;
  PostData := TStringList.Create;
  PageData := TStringList.Create;
  try
    // Set settings
    Form1.IdHTTP1.Request.Host := 'http://mail.ru';
    Form1.IdHTTP1.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.12) Gecko/20101026 Firefox/3.6.12';
    Form1.IdHTTP1.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    Form1.IdHTTP1.Request.AcceptLanguage := 'ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3';
    //Form1.IdHTTP1.Request.AcceptEncoding := 'gzip,deflate';
    Form1.IdHTTP1.Request.AcceptCharSet := 'windows-1251,utf-8;q=0.7,*;q=0.7';
    Form1.IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
    Form1.IdHTTP1.Request.ContentLength := 112;
    Form1.IdHTTP1.AllowCookies := True;
    Form1.IdHTTP1.HandleRedirects := True;
    // Send post
    PostData.Add('page=');
    PostData.Add('post=');
    PostData.Add('login_form=');
    PostData.Add('Login='+Form1.Edit1.Text);
    Domain := Form1.ComboBox1.Text;
    Delete(Domain,1,1);
    PostData.Add('Domain='+Domain);
    PostData.Add('Password='+Form1.Edit2.Text);
    Form1.IdHTTP1.Post('http://win.mail.ru/cgi-bin/auth',PostData);
    // Get My World page
    PageData.Text := Form1.IdHTTP1.Get('http://my.mail.ru/');
    if ValidText('http://my.mail.ru/','logout') then result := true;
  finally
    PostData.Free;
    PageData.Free;
  end;
end;

procedure MailLogOut;
begin
  Form1.IdHTTP1.Get('http://win.mail.ru/cgi-bin/logout');
end;

procedure TForm1.GetDataPage;
var
  PostData: TStringList;
  PageData: TStringList;
  TempStr: string;
begin
  if FConnected = true then
  begin
    PostData := TStringList.Create;
    PageData := TStringList.Create;
    try
      PageData.Text := IdHTTP1.Get('http://my.mail.ru/mail/'+Edit1.Text+'/');
      // Оценки
      if ValidText('http://my.mail.ru/mail/'+Edit1.Text+'/','оценка">') then begin
      TempStr := Pars('оценка">',PageData.Text,'</a>');
      Delete(TempStr,1,1);
      Label1.Caption := TempStr;
      end else Label1.Caption := '0';
      // Оценки +10
      if ValidText('http://my.mail.ru/mail/'+Edit1.Text+'/','оценок +10">') then begin
      TempStr := Pars('оценок +10">',PageData.Text,'</a>');
      Delete(TempStr,1,5);
      Label2.Caption := TempStr;
      end else Label2.Caption := '0';
      // Имя и Фамилия
      TempStr := Pars('Hblack"',PageData.Text,'</h1>');
      Delete(TempStr,1,1);
      Label3.Caption := TempStr;
      // Страна и город
      TempStr := Pars('<a class="mf_black mf_tdn" title="',PageData.Text,'" href');
      Delete(TempStr,1,27);
      Label4.Caption := TempStr;
      // День рождения
      if ValidText('http://my.mail.ru/mail/'+Edit1.Text+'/info','<dd>День рождения:</dd><dt>') then begin
      PageData.Text := IdHTTP1.Get('http://my.mail.ru/mail/'+Edit1.Text+'/info');
      TempStr := Pars('<dd>День рождения:</dd><dt>',PageData.Text,' (<a');
      Delete(TempStr,1,20);
      Label5.Caption := TempStr;
      TempStr := Pars('http://horo.mail.ru/zodiac/sign.html?',PageData.Text,'</a>');
      Delete(TempStr,1,50);
      Label5.Caption := Label5.Caption + ', ' + TempStr;
      TempStr := Pars('</a>), ',PageData.Text,'&nbsp;');
      Label5.Caption := Label5.Caption + ', ' + TempStr;
      TempStr := Pars(TempStr+'&nbsp;',PageData.Text,'</dt>');
      Delete(TempStr,1,1);
      Label5.Caption := Label5.Caption + ' ' + TempStr;
      end else Label5.Caption := 'Скрыто';
      // Последний визит
      PageData.Text := IdHTTP1.Get('http://my.mail.ru/mail/'+Edit1.Text+'/info');
      TempStr := Pars('<dd>Последний визит:</dd><dt>',PageData.Text,'</dt>');
      Delete(TempStr,1,22);
      Label9.Caption := 'Последний визит: '+TempStr;
      // Аватарка
      PageData.Text := IdHTTP1.Get('http://my.mail.ru/mail/'+Edit1.Text+'/');
      TempStr := Pars('http://avt.foto.mail.ru/mail/'+Edit1.Text+'/',PageData.Text,');');
      Delete(TempStr,1,23+Length(Edit1.Text));
      if ValidText('http://my.mail.ru/mail/'+Edit1.Text+'/','http://avt.foto.mail.ru/mail/'+Edit1.Text+'/'+TempStr) then begin
      GetImageJpeg(IdHTTP1,'http://avt.foto.mail.ru/mail/'+Edit1.Text+'/'+TempStr,Image2);
      end;
    finally
      PostData.Free;
      PageData.Free;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  Edit1.Enabled := False;
  Edit2.Enabled := False;
  ComboBox1.Enabled := False;
  Label8.Font.Color := $00453829;
  if MailLogIn(Edit1.Text,Edit2.Text) then
  begin
    Button1.Enabled := False;
    Edit1.Enabled := False;
    Edit2.Enabled := False;
    ComboBox1.Enabled := False;
    FConnected := True;
    GetDataPage;
    Label8.Caption := 'Статус: Вход выполнен.';
    Image4.Visible := True;
    Button3.Enabled := True;
  end else begin
    Button3.Enabled := False;
    Button1.Enabled := True;
    Edit1.Enabled := True;
    Edit2.Enabled := True;
    ComboBox1.Enabled := True;
    Label8.Font.Color := $001F22EA;
    FConnected := False;
    Image4.Visible := False;
    Label8.Caption := 'Статус: Логин или пароль не верны.';
  end;
end;

procedure TForm1.IdCookieManager1NewCookie(ASender: TObject;
  ACookie: TIdCookieRFC2109; var VAccept: Boolean);
begin
  VAccept := true;
  if ACookie.Path = '' then
   ACookie.Path := '/';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  MailLogOut;
  Button1.Enabled := True;
  Button3.Enabled := False;
  Image4.Visible := False;
  Edit1.Enabled := True;
  Edit2.Enabled := True;
  ComboBox1.Enabled := True;
  IdHTTP1.Disconnect;
end;

procedure TForm1.IdHTTP1Connected(Sender: TObject);
begin
  Label8.Caption := 'Статус: Загрузка...';
end;

procedure TForm1.IdHTTP1Disconnected(Sender: TObject);
begin
  Label8.Caption := 'Статус: Готово';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.

Вложения
authorization-mail.ru.zip
(59.65 КБ) 99 скачиваний
Splash2.jpg
Splash2.jpg (55.52 КБ) 2351 просмотр

Ответить