Delphi Авторизация без ИЦ

Venzel · 10.06.2016, 23:07

Собственно авторизация для немэйл почт. Вроде работает

Код:

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,comobj,activex, ShellAPI;

....

procedure TForm3.Button1Click(Sender: TObject);
var
hwnd:thandle;
o,xmlparser:OleVariant;
s,_user,user,token2:string;
a1,a2:Integer;
begin
CoInitialize(0); ;
o:=CreateOleObject('Microsoft.XMLHTTP');
xmlparser:=CreateOleObject('Msxml2.DOMDocument');
o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=Auth', False);
o.setRequestHeader ('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader ('Content-Length',Length('<?xml version="1.0" encoding="UTF-8"?><Auth ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.Text+'"/>"'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><Auth ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.Text+'"/>');
xmlParser.loadXML(o.responsetext);
_user := copy (o.responsetext, (Length(o.responsetext)-10),8 );
//label2.Caption:=_user;

o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=AutoLogin', False);
o.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader('Content-Length', Length('<?xml version="1.0" encoding="UTF-8"?><AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>');
xmlParser.loadXML(o.responsetext);
token2:=copy(o.responsetext, (Length(o.responsetext)-67),64);
//label1.Caption:=token2;

o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=PersList', False);
o.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader('Content-Length', Length('<?xml version="1.0" encoding="UTF-8"?><PersList ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><PersList ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>');
xmlParser.loadXML(o.responsetext);
user:=copy(o.responsetext, (Length(o.responsetext)-22),9);
//label3.Caption:=user;

s:='startbypatcher user:'+pwidechar(user)+' _user:'+pwidechar(_user)+' token2:'+pwidechar(token2);
ShellExecute(hwnd,'open','elementclient.exe',pwidechar(s),'E:\GamesMailRu\Perfect World\element\',sw_shownormal);
end;

_Wolf_ · 19.09.2016, 17:59

Чутог доработать напильником и будет танк.
Предупреждаю исходник старый выложен только в ознакомительных целях.

Код:

unit uAuth;

interface
uses Windows, System.SysUtils, System.Classes, Vcl.Dialogs,
  Xml.XMLIntf, Xml.XMLDoc, Xml.xmldom,
  REST.Json, Data.DBXJSON,
  HTTPSend, Synacode, ssl_openssl;

const
  UserAgent='Downloader/4410';
  MimeType='application/x-www-form-urlencoded';
  MailRuDomains: array [0..3] of AnsiString = ('@mail.ru','@inbox.ru','@bk.ru','@list.ru');

type
  TLogingMgr = procedure (_Str: string) of object;
  TSelectDialog = procedure (_List: TStringList) of object;

  TAuthClass = class
  protected

  private
    FPassword: string;
    FLogin: string;
    FPersID: string;
    FTocken: string;
    FMpop: string;
    FErrorCode: Integer;

    FOnLogging: TLogingMgr;
    FOnSelectDialog: TSelectDialog;
    FDelay: Integer;
    procedure Parser(_Stream: TStream);
    procedure SetLogin(const Value: string);
    procedure SetPassword(const Value: string);
    // Авторизация под другим почтовым ящиком
    function Auth: Boolean;
    function AuthLogin: Boolean;
    function AuthPersList: Boolean;
    function GetPersList(_Stream: TStream): Boolean;
    // Авторизация на мэйлсру
    function AuthMailRu: Boolean; // Запрашиваем Токен для авторизации
    function AuthMailRuUserInfo: Boolean; // Имитирует получение персональных данных
    function AuthMailRuMrPage2: Boolean;
    function AuthMailRuCoockie: Boolean;
    function AuthMailRuAuth: Boolean;
    function AuthMailRuAuthLogin: Boolean;
    function AuthMailRuPersList: Boolean;

    procedure SetOnLogging(const Value: TLogingMgr);
    function GetOnLogging: TLogingMgr;
    procedure SetOnSelectDialog(const Value: TSelectDialog);
    function GetOnSelectDialog: TSelectDialog;
    function GetPersID: string;
    function GetTocken: string;
    procedure SetDelay(const Value: Integer);
    function GetDelay: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    // Login (EMail) для авторизации
    property Login: string read FLogin write SetLogin;
    property Password: string read FPassword write SetPassword;
    // Возвращает код ошибки (если 200 все ОК)
    function GetErrorCode: Integer;

    property Tocken: string read GetTocken;
    property PersID: string read GetPersID;

    // Логинизация
    property OnLogging: TLogingMgr read GetOnLogging write SetOnLogging;
    // Вызывает диалог выбора Аккаунтов
    property OnSelectDialog: TSelectDialog read GetOnSelectDialog write SetOnSelectDialog;
    // Задержка между запросами
    property Delay: Integer read GetDelay write SetDelay;

    function Connect: Boolean; //deprecated;
    function CheckAuth: Boolean;



    function GetCommandLauncher: string;

    // Относится ли логин к майл.ру
    function IsMailRu(Login: string): Boolean; overload;
    function IsMailRu: Boolean; overload;
  end;

var
  CommandLine: string;

implementation

{ TAuthClass }


function TAuthClass.Auth: Boolean;
var
  HTTP: THTTPSend;
  XML: IXMLDocument;
  Root: IXMLNode;
  Child: IXMLNode;
  Data: TStringStream;
begin
  Result:= False;
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  Xml:= TXMLDocument.Create(nil);
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:=UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
      Data.WriteString('<Auth ProjectId="61" SubProjectId="0" ShardId="0" Username="'+LowerCase(FLogin)+'" Password="'+Password+'"/>');
    HTTP.Document.LoadFromStream(Data);
    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/sz.php?hint=Auth') then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('Auth: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;

      if Assigned(FOnLogging) then
        FOnLogging('Auth: '+HTTP.ResultString);
      Xml.LoadFromStream(HTTP.Document);
      Xml.Active:= True;

      if Xml.IsEmptyDoc then Exit;

      Root:= Xml.DocumentElement;
      FPersID:= Root.Attributes['PersId'];
      Exit;

      if Assigned(FOnLogging) then
        FOnLogging('Auth: PersID= '+FPersID);
      Result:= True;
      Xml.Active:= False;
    end else raise Exception.Create('Произошла не предвиденная ошибка.'+#13#10+'Код ['+Inttostr(HTTP.ResultCode)+']'+HTTP.ResultString);
  finally
    HTTP.Free;
    Data.Free;
    XML:= nil;
  end;
end;

function TAuthClass.AuthLogin: Boolean;
var
  HTTP: THTTPSend;
  XML: IXMLDocument;
  Root: IXMLNode;
  Data: TStringStream;
begin
  Result:= False;
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  Xml:= TXMLDocument.Create(nil);
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:=UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
      Data.WriteString('<AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" Username="'+
                      LowerCase(FLogin)+'" Password="'+Password+'"/>');
    HTTP.Document.LoadFromStream(Data);

    if FErrorCode <> 200 then Exit;


    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/sz.php?hint=AutoLogin') then begin
      if Assigned(FOnLogging) then
        FOnLogging('AuthLogin: '+HTTP.ResultString);

      Xml.LoadFromStream(HTTP.Document);
      Xml.Active:= True;

      if Xml.IsEmptyDoc then Exit;

      Root:= Xml.DocumentElement;
      FTocken:= Root.Attributes['Key'];

      if Assigned(FOnLogging) then
        FOnLogging('AuthLogin: Tocken= '+FTocken);

      Result:= True;
      Xml.Active:= False;
    end else raise Exception.Create(HTTP.ResultString);
  finally
    HTTP.Free;
    Data.Free;
    XML:= nil;
  end;
end;

function TAuthClass.AuthMailRu: Boolean;
var
  HTTP: THTTPSend;
  Data: TStringStream;
  TS: TStringList;
  JObject: TJSONObject;
begin
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  TS:= TStringList.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:= UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('client_id=gamecenter.mail.ru&grant_type=password&username='+LowerCase(Login)+'&password='+Password);
    HTTP.Document.LoadFromStream(Data);
    if HTTP.HTTPMethod('POST','https://o2.mail.ru/token') then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRu: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
      TS.LoadFromStream(HTTP.Document);

      JObject:=TJSONObject.ParseJSONValue(TS.Text) as TJSONObject;

      if Assigned(JObject) then begin
        if JObject.Get(0).JsonString.Value = 'error' then begin
          if Assigned(FOnLogging) then
            FOnLogging(Format('AuthMailRu: JSON ERROR [%s] %s',[JObject.Get(1).JsonValue.Value, JObject.Get(JObject.Size-1).JsonValue.ToString]));
          FErrorCode:= 400;
          Exit;
        end;
        if JObject.Get(0).JsonString.Value = 'expires_in' then
          FTocken:= JObject.Get(JObject.Size-1).JsonValue.Value;
      end else begin
        if Assigned(FOnLogging) then
          FOnLogging('AuthMailRu: JSON ERROR Jsonobject not assigned!');
        FErrorCode:= 400;
      end;
    end;
  finally
    HTTP.Free;
    Data.Free;
  end;
end;

function TAuthClass.AuthMailRuAuth: Boolean;
var
  HTTP: THTTPSend;
  TS: TStringList;
  Data: TStringStream;
  Mpop: string;
begin
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  TS:= TStringList.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:= UserAgent;
    HTTP.MimeType:= MimeType;

    if FErrorCode <> 200 then Exit;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?><Auth Cookie="'+FMpop+'" ChannelId="0"/>');
    HTTP.Document.LoadFromStream(Data);

    if HTTP.HTTPMethod('POST', 'https://authdl.mail.ru/ec.php?hint=Auth') then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuAuth: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
      TS.LoadFromStream(HTTP.Document);
      TS.SaveToFile('AuthMailRuAuth.txt');
    end;
  finally
    HTTP.Free;
    Data.Free;
    TS.Free;
  end;
end;

function TAuthClass.AuthMailRuAuthLogin: Boolean;
var
  HTTP: THTTPSend;
  XML: IXMLDocument;
  Root: IXMLNode;
  Data: TStringStream;
begin
  Result:= False;
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  Xml:= TXMLDocument.Create(nil);
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:=UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
      Data.WriteString('<AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" Mpop="'+FMpop+'"/>');

    HTTP.Document.LoadFromStream(Data);

    if FErrorCode <> 200 then Exit;


    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/sz.php?hint=AutoLogin') then begin
      if HTTP.ResultCode <> 200 then begin

        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuAuth: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
      Xml.LoadFromStream(HTTP.Document);
      Xml.Active:= True;

      if Assigned(FOnLogging) then
        FOnLogging('AuthLogin: '+Xml.XML.Text);

      if Xml.IsEmptyDoc then Exit;

      Root:= Xml.DocumentElement;
      FPersID:= Root.Attributes['PersId'];
      FTocken:= Root.Attributes['Key'];

      if Assigned(FOnLogging) then
        FOnLogging('AuthLogin: Tocken= '+FTocken);

      Result:= True;
      Xml.Active:= False;
    end else raise Exception.Create(HTTP.ResultString);
  finally
    HTTP.Free;
    Data.Free;
    XML:= nil;
  end;
end;

function TAuthClass.AuthMailRuCoockie: Boolean;
var
  HTTP: THTTPSend;
  TS: TStringList;
  Mpop: string;
begin
  HTTP := THTTPSend.Create;
  TS:= TStringList.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:= UserAgent;
    HTTP.MimeType:= MimeType;

    if FErrorCode <> 200 then Exit;

    if HTTP.HTTPMethod('GET', FPersID) then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuCoockie: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
      Mpop:= HTTP.Cookies.Values['Mpop'];

      if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuCoockie: HTTP Coockie Mpop = %s',[Mpop]));
      FMpop:= Mpop;
    end;
  finally
    HTTP.Free;
    TS.Free;
  end;
end;

function TAuthClass.AuthMailRuMrPage2: Boolean;
var
  HTTP: THTTPSend;
  Data: TStringStream;
  XML: IXMLDocument;
  Root: IXMLNode;
begin
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  XML:= TXMLDocument.Create(nil);
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:= UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?><MrPage2 SessionKey="'+FTocken+'" Page="http://dl.mail.ru/robots.txt"/>');
    HTTP.Document.LoadFromStream(Data);

    if FErrorCode <> 200 then Exit;

    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/ec.php?hint=MrPage2') then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuMrPage2: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
      XML.LoadFromStream(HTTP.Document);
      XML.Active:= True;

      if XML.IsEmptyDoc then begin
        if Assigned(FOnLogging) then
          FOnLogging('AuthMailRuMrPage2: XML ERROR IsEmptyDoc ');
        FErrorCode:= 400;
        Exit;
      end;
      Root:= XML.DocumentElement;
      FPersID:= Root.Attributes['Location'];
      if Assigned(FOnLogging) then
          FOnLogging('AuthMailRuMrPage2: XML '+FPersID);
      XML.Active:= False;
    end;
  finally
    HTTP.Free;
    Data.Free;
    XML:= Nil;
  end;
end;

function TAuthClass.AuthMailRuPersList: Boolean;
var
  HTTP: THTTPSend;
  XML: IXMLDocument;
  Root: IXMLNode;
  TS: TStringList;
  Data: TStringStream;
  I: Int32;
begin
  Result:= False;
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  Xml:= TXMLDocument.Create(nil);
  TS:= TStringList.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:=UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
      Data.WriteString('<PersList ProjectId="61" SubProjectId="0" ShardId="0" Mpop="'+FMpop+'"/>');
    HTTP.Document.LoadFromStream(Data);

    if FErrorCode <> 200 then Exit;

    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/sz.php?hint=PersList') then begin
      if FErrorCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging('AuthMailRuPersList: '+HTTP.ResultString);
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;

      Xml.LoadFromStream(HTTP.Document);
      Xml.Active:= True;

      if Xml.IsEmptyDoc then Exit;
      Root:= Xml.DocumentElement;
      FPersID:= Root.Attributes['PersId'];
      if Assigned(FOnLogging) then
        FOnLogging('AuthPersList: PersId= '+FTocken);

      for I := 0 to Root.ChildNodes.Count-1 do begin
        TS.Add(Root.ChildNodes[i].Attributes['Title']+'='+Root.ChildNodes[i].Attributes['Id']);
      end;

      CommandLine:= GetCommandLauncher;

      if Assigned(FOnSelectDialog) then
        FOnSelectDialog(TS);
      Result:= True;
    end else raise Exception.Create(HTTP.ResultString);
  finally
    HTTP.Free;
    Data.Free;
    TS.Free;
    XML:= nil;
  end;
end;

function TAuthClass.AuthMailRuUserInfo: Boolean;
var
  HTTP: THTTPSend;
  Data: TStringStream;
  JObject: TJSONObject;
begin
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:= UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('client_id=gamecenter.mail.ru&access_token='+FTocken);
    HTTP.Document.LoadFromStream(Data);
    if HTTP.HTTPMethod('POST','https://o2.mail.ru/userinfo') then begin
      if HTTP.ResultCode <> 200 then begin
        if Assigned(FOnLogging) then
          FOnLogging(Format('AuthMailRuUserInfo: HTTP ERROR [%d] %s',[HTTP.ResultCode, HTTP.ResultString]));
        FErrorCode:= HTTP.ResultCode;
        Exit;
      end;
    end;
  finally
    HTTP.Free;
    Data.Free;
  end;
end;

function TAuthClass.AuthPersList: Boolean;
var
  HTTP: THTTPSend;
  XML: IXMLDocument;
  Root: IXMLNode;
  TS: TStringList;
  Data: TStringStream;
  I: Int32;
  Str: string;
begin
  Result:= False;
  HTTP := THTTPSend.Create;
  Data:= TStringStream.Create;
  Xml:= TXMLDocument.Create(nil);
  TS:= TStringList.Create;
  try
    HTTP.Protocol:='1.1';
    HTTP.UserAgent:=UserAgent;
    HTTP.MimeType:= MimeType;

    Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
      Data.WriteString('<PersList ProjectId="61" SubProjectId="0" ShardId="0" Username="'+
                      LowerCase(FLogin)+'" Password="'+Password+'"/>');
    HTTP.Document.LoadFromStream(Data);

    if FErrorCode <> 200 then Exit;

    if HTTP.HTTPMethod('POST','https://authdl.mail.ru/sz.php?hint=PersList') then begin
      if Assigned(FOnLogging) then
        FOnLogging('AuthPersList: '+HTTP.ResultString);

      Xml.LoadFromStream(HTTP.Document);
      Xml.Active:= True;

      if Xml.IsEmptyDoc then Exit;

      Root:= Xml.DocumentElement;
      Str:= Root.Attributes['PersId'];
      if Assigned(FOnLogging) then
        FOnLogging('AuthPersList: PersId= '+Str);

      for I := 0 to Root.ChildNodes.Count-1 do begin
        TS.Add(Root.ChildNodes[i].Attributes['Title']+'='+Root.ChildNodes[i].Attributes['Id']);
      end;

      CommandLine:= GetCommandLauncher;

      if Assigned(FOnSelectDialog) then
        FOnSelectDialog(TS);
      Result:= True;
    end else raise Exception.Create(HTTP.ResultString);
  finally
    HTTP.Free;
    Data.Free;
    TS.Free;
    XML:= nil;
  end;
end;

function TAuthClass.CheckAuth: Boolean;
var
  IsMail: Boolean;
begin
  IsMail:= IsMailRu;
  if IsMail then Result:= AuthMailRu
  else Result:= Auth;
end;

function TAuthClass.Connect: Boolean;
var
  IsMail: Boolean;
begin
  Result:= False;
  IsMail:= IsMailRu;
  case IsMail of
    True: begin
      AuthMailRu;
      Sleep(100);
      AuthMailRuUserInfo;
      Sleep(100);
      AuthMailRuMrPage2;
      Sleep(100);
      AuthMailRuCoockie;
      Sleep(100);
      AuthMailRuAuth;
      Sleep(1000);
      AuthMailRuAuthLogin;
      Sleep(1000);
      AuthMailRuPersList;
      Sleep(1000);
      Result:= True;
    end;
    False: begin
      Auth;
      Sleep(100);
      AuthLogin;
      Sleep(1000);
      AuthPersList;
      Sleep(1000);
      Result:= True;
    end;
  end;
end;

constructor TAuthClass.Create;
begin
  FErrorCode:= 200;
  FPassword:='';
  FLogin:='';
  FPersID:='';
  FTocken:='';
  FMpop:='';
  FDelay:= 1000;
end;

destructor TAuthClass.Destroy;
begin
  FPassword:='';
  FLogin:='';
  FPersID:='';
  FTocken:='';
  FMpop:='';
  inherited;
end;

function TAuthClass.GetCommandLauncher: string;
begin
  Result:=' startbypatcher user:%s _user:'+FPersID+' token2:'+FTocken;
end;

function TAuthClass.GetDelay: Integer;
begin
  Result:= FDelay;
end;

function TAuthClass.GetErrorCode: Integer;
begin
  Result:= FErrorCode;
end;

function TAuthClass.GetOnLogging: TLogingMgr;
begin
  Result:= FOnLogging;
end;

function TAuthClass.GetOnSelectDialog: TSelectDialog;
begin
  Result:= FOnSelectDialog;
end;

function TAuthClass.GetPersID: string;
begin
  Result:= FPersID;
end;

function TAuthClass.GetPersList(_Stream: TStream): Boolean;
var
  XML: IXMLDocument;
  Root, Node: IXMLNode;
  TS: TStringList;
  I: Integer;
begin
  Result:= False;
  if _Stream = nil then Exit;
  TS:= TStringList.Create;
  XML:= TXMLDocument.Create(nil);
  try
    XML.Active:= True;
    XML.LoadFromStream(_Stream);

    if XML.IsEmptyDoc then Exit;
    Root:= XML.DocumentElement;
    FPersID:= Root.Attributes['PersId'];

    if Root.ChildNodes.Count <= 0 then Exit;

    for I := 0 to Root.ChildNodes.Count-1 do begin
      Node:= Root.ChildNodes.Nodes[i];
      TS.Add(Node.Attributes['Title']+'='+ Node.Attributes['Id']);
    end;

    if Assigned(FOnLogging) then
      FOnLogging('GetPersList: Pers count: '+IntToStr(TS.Count));
    if (TS.Count>0) then
      if Assigned(FOnSelectDialog) then begin
        Result:= True;
        FOnSelectDialog(TS);
      end;
    XML.Active:= False;
  finally
    XML:= nil;
    TS.Free;
  end;
end;

function TAuthClass.GetTocken: string;
begin
  Result:= FTocken;
end;

function TAuthClass.IsMailRu: Boolean;
begin
  Result:= IsMailRu(FLogin);
end;

function TAuthClass.IsMailRu(Login: string): Boolean;
var
  I: Byte;
begin
  Result:= False;
  for I := 0 to Length(MailRuDomains)-1 do
    if Pos(MailRuDomains[i], Login) > 0 then
      Result:= True;
end;

procedure TAuthClass.Parser(_Stream: TStream);
begin

end;

procedure TAuthClass.SetDelay(const Value: Integer);
begin
  FDelay := Value;
end;

procedure TAuthClass.SetLogin(const Value: string);
begin
  FLogin := Value;
end;

procedure TAuthClass.SetOnLogging(const Value: TLogingMgr);
begin
  FOnLogging := Value;
end;

procedure TAuthClass.SetOnSelectDialog(const Value: TSelectDialog);
begin
  FOnSelectDialog := Value;
end;

procedure TAuthClass.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

end.

krysun · 19.09.2016, 19:50

Цитата:


	s:='startbypatcher user:'+pwidechar(user)+' _user:'+pwidechar(_user)+' token2:'+pwidechar(token2);

Вошел только изменив эту строчку на

Цитата:


	s:=' startbypatcher user:'+user+' token2:'+token2;

(С поста Venzel)

Код:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,comobj,activex, ShellAPI;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
hwnd:thandle;
o,xmlparser:OleVariant;
s,_user,user,token2:string;
a1,a2:Integer;
begin
CoInitialize(0); ;
o:=CreateOleObject('Microsoft.XMLHTTP');
xmlparser:=CreateOleObject('Msxml2.DOMDocument');
o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=Auth', False);
o.setRequestHeader ('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader ('Content-Length',Length('<?xml version="1.0" encoding="UTF-8"?><Auth ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.Text+'"/>"'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><Auth ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.Text+'"/>');
xmlParser.loadXML(o.responsetext);
_user := copy (o.responsetext, (Length(o.responsetext)-10),8 );

o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=AutoLogin', False);
o.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader('Content-Length', Length('<?xml version="1.0" encoding="UTF-8"?><AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>');
xmlParser.loadXML(o.responsetext);
token2:=copy(o.responsetext, (Length(o.responsetext)-67),64);

o.open ('POST', 'http://authdl.mail.ru/sz.php?hint=PersList', False);
o.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
o.setRequestHeader('Content-Length', Length('<?xml version="1.0" encoding="UTF-8"?><PersList ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>'));
o.setRequestHeader('User-Agent','Downloader/11620');
o.send ('<?xml version="1.0" encoding="UTF-8"?><PersList ProjectId="61" SubProjectId="0" ShardId="0" UserId="1" UserId2="2" Username="'+edit1.Text+'" Password="'+edit2.text+'"/>');
xmlParser.loadXML(o.responsetext);
user:=copy(o.responsetext, (Length(o.responsetext)-21),8);
s:=' startbypatcher user:'+user+' token2:'+token2;
ShellExecute(hwnd,'open','elementclient.exe',pwidechar(s),'f:\GamesMailRu\Perfect World\element\',sw_shownormal);
end;

end.

Delphi XE3

_Wolf_ · 20.09.2016, 10:11

Хех... я думал уже никому не интересно

Doakes1 · 24.07.2018, 17:29

Поделится кто рабочим способом авторизации на делфи?

Delphi Авторизация без ИЦ

Разработка ПО для Perfect World