PDA

Просмотр полной версии : [Программа] Delphi Авторизация без ИЦ

Venzel
10.06.2016, 23:07
Собственно авторизация для немэйл почт. Вроде работает/dgs

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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader ('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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',pwide char(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,
[Ссылки могут видеть только зарегистрированные и активированные пользователи] Synacode, ssl_openssl;

const
UserAgent='Downloader/4410';
MimeType='application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]';
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
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
XML: IXMLDocument;
Root: IXMLNode;
Child: IXMLNode;
Data: TStringStream;
begin
Result:= False;
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
Xml:= TXMLDocument.Create(nil);
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
Data.WriteString('<Auth ProjectId="61" SubProjectId="0" ShardId="0" Username="'+LowerCase(FLogin)+'" Password="'+Password+'"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);
if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('Auth: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;

if Assigned(FOnLogging) then
FOnLogging('Auth: '+[Ссылки могут видеть только зарегистрированные и активированные пользователи]);
Xml.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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([Ссылки могут видеть только зарегистрированные и активированные пользователи])+']'+[Ссылки могут видеть только зарегистрированные и активированные пользователи]);
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
XML:= nil;
end;
end;

function TAuthClass.AuthLogin: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
XML: IXMLDocument;
Root: IXMLNode;
Data: TStringStream;
begin
Result:= False;
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
Xml:= TXMLDocument.Create(nil);
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
Data.WriteString('<AutoLogin ProjectId="61" SubProjectId="0" ShardId="0" Username="'+
LowerCase(FLogin)+'" Password="'+Password+'"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if FErrorCode <> 200 then Exit;


if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if Assigned(FOnLogging) then
FOnLogging('AuthLogin: '+[Ссылки могут видеть только зарегистрированные и активированные пользователи]);

Xml.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
XML:= nil;
end;
end;

function TAuthClass.AuthMailRu: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data: TStringStream;
TS: TStringList;
JObject: TJSONObject;
begin
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
TS:= TStringList.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи] UserAgent;
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('client_id=gamecenter.mail.ru&grant_type=password&username='+LowerCase(Login)+'&password='+Password);
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);
if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRu: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
TS.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);

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
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
end;
end;

function TAuthClass.AuthMailRuAuth: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
TS: TStringList;
Data: TStringStream;
Mpop: string;
begin
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
TS:= TStringList.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи] UserAgent;
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

if FErrorCode <> 200 then Exit;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?><Auth Cookie="'+FMpop+'" ChannelId="0"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuAuth: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
TS.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
TS.SaveToFile('AuthMailRuAuth.txt');
end;
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
TS.Free;
end;
end;

function TAuthClass.AuthMailRuAuthLogin: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
XML: IXMLDocument;
Root: IXMLNode;
Data: TStringStream;
begin
Result:= False;
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
Xml:= TXMLDocument.Create(nil);
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

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

[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if FErrorCode <> 200 then Exit;


if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin

if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuAuth: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
Xml.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
XML:= nil;
end;
end;

function TAuthClass.AuthMailRuCoockie: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
TS: TStringList;
Mpop: string;
begin
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
TS:= TStringList.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи] UserAgent;
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

if FErrorCode <> 200 then Exit;

if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('GET', FPersID) then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuCoockie: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
Mpop:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]['Mpop'];

if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuCoockie: HTTP Coockie Mpop = %s',[Mpop]));
FMpop:= Mpop;
end;
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
TS.Free;
end;
end;

function TAuthClass.AuthMailRuMrPage2: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data: TStringStream;
XML: IXMLDocument;
Root: IXMLNode;
begin
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
XML:= TXMLDocument.Create(nil);
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи] UserAgent;
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?><MrPage2 SessionKey="'+FTocken+'" Page="[Ссылки могут видеть только зарегистрированные и активированные пользователи]"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if FErrorCode <> 200 then Exit;

if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuMrPage2: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
XML.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
XML:= Nil;
end;
end;

function TAuthClass.AuthMailRuPersList: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
XML: IXMLDocument;
Root: IXMLNode;
TS: TStringList;
Data: TStringStream;
I: Int32;
begin
Result:= False;
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
Xml:= TXMLDocument.Create(nil);
TS:= TStringList.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
Data.WriteString('<PersList ProjectId="61" SubProjectId="0" ShardId="0" Mpop="'+FMpop+'"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if FErrorCode <> 200 then Exit;

if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if FErrorCode <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging('AuthMailRuPersList: '+[Ссылки могут видеть только зарегистрированные и активированные пользователи]);
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;

Xml.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
TS.Free;
XML:= nil;
end;
end;

function TAuthClass.AuthMailRuUserInfo: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data: TStringStream;
JObject: TJSONObject;
begin
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи] UserAgent;
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('client_id=gamecenter.mail.ru&access_token='+FTocken);
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);
if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if [Ссылки могут видеть только зарегистрированные и активированные пользователи] <> 200 then begin
if Assigned(FOnLogging) then
FOnLogging(Format('AuthMailRuUserInfo: HTTP ERROR [%d] %s',[[Ссылки могут видеть только зарегистрированные и активированные пользователи] [Ссылки могут видеть только зарегистрированные и активированные пользователи]]));
FErrorCode:= [Ссылки могут видеть только зарегистрированные и активированные пользователи]
Exit;
end;
end;
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data.Free;
end;
end;

function TAuthClass.AuthPersList: Boolean;
var
[Ссылки могут видеть только зарегистрированные и активированные пользователи] T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
XML: IXMLDocument;
Root: IXMLNode;
TS: TStringList;
Data: TStringStream;
I: Int32;
Str: string;
begin
Result:= False;
HTTP := T[Ссылки могут видеть только зарегистрированные и активированные пользователи]
Data:= TStringStream.Create;
Xml:= TXMLDocument.Create(nil);
TS:= TStringList.Create;
try
[Ссылки могут видеть только зарегистрированные и активированные пользователи]'1.1';
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
[Ссылки могут видеть только зарегистрированные и активированные пользователи] MimeType;

Data.WriteString('<?xml version="1.0" encoding="UTF-8"?>');
Data.WriteString('<PersList ProjectId="61" SubProjectId="0" ShardId="0" Username="'+
LowerCase(FLogin)+'" Password="'+Password+'"/>');
[Ссылки могут видеть только зарегистрированные и активированные пользователи](Data);

if FErrorCode <> 200 then Exit;

if [Ссылки могут видеть только зарегистрированные и активированные пользователи]('POST','[Ссылки могут видеть только зарегистрированные и активированные пользователи]') then begin
if Assigned(FOnLogging) then
FOnLogging('AuthPersList: '+[Ссылки могут видеть только зарегистрированные и активированные пользователи]);

Xml.LoadFromStream([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
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([Ссылки могут видеть только зарегистрированные и активированные пользователи]);
finally
[Ссылки могут видеть только зарегистрированные и активированные пользователи]
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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader ('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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', '[Ссылки могут видеть только зарегистрированные и активированные пользователи]', False);
o.setRequestHeader('Content-Type', 'application/x-[Ссылки могут видеть только зарегистрированные и активированные пользователи]');
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',pwide char(s),'f:\GamesMailRu\Perfect World\element\',sw_shownormal);
end;

end.

Delphi XE3
_Wolf_
20.09.2016, 10:11
Хех... я думал уже никому не интересно ;)
Doakes1
24.07.2018, 17:29
Поделится кто рабочим способом авторизации на делфи?