[Amin_Mansouri]

کد:

{ U_FacebookSdk

  Author: abhe
  Description: Facebook Login Sdk
  Credits:  Dreamcode, Meong
  Reference: http://www.facebook.com
  Website: http://ic0de.org
  History: Login Facebook
}

unit U_FacebookSdk;

interface

uses
windows, sysutils, classes, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;

Type
  TFacebook = class
  private
    Fhttp : TIdHTTP;
    Fhandler : TIdSSLIOHandlerSocketOpenSSL;
    FCookieManager : TIdCookieManager;
    FCookies : TStringlist;
    Femail,
    Fpass : string;
    procedure Setcookies;
    procedure Extractcookie(cookie:string; var name,value:string);
    procedure Savecookies;
    procedure Updatecookies;
    Function ValidateLogin(Response:String):boolean;
  public
    constructor Create(email,password:string);
    Destructor Destroy; override;
    Function Login:Boolean;
  end;

Function FacebookLogin(Email,Password:string):boolean;
implementation

const
first ='http://www.facebook.com/index.php';
loginurl = 'https://login.facebook.com/login.php?login_attempt=1';
home = 'http://www.facebook.com/home.php';

constructor TFacebook.Create(email: string; password: string);
begin
  inherited create;
  Femail := email;
  Fpass := password;
  Fhttp := TIdHTTP.Create(nil);
  Fhandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  FCookieManager := TIdCookieManager.Create(nil);
  Fhttp.CookieManager := FCookieManager;
  Fhttp.IOHandler := Fhandler;
  Fhttp.HandleRedirects := True;
  FCookies := TStringlist.Create;
end;

Destructor TFacebook.Destroy;
begin
  Fhttp.Disconnect;
  if assigned(Fhttp) then Fhttp.Free;
  if assigned(FCookieManager) then FCookieManager.Free;
  if assigned(Fhandler) then Fhandler.Free;
  FCookies.Free;
  inherited Destroy;
end;

Procedure TFacebook.Setcookies;
var
j:integer; s:string;
count:integer;
begin
  count:=FCookies.count;
  s:='';
  for j:=1 to count do begin
    FCookieManager.AddCookie(FCookies[j-1],Fhttp.url.Host);
    s:=s+'; '+FCookies[j-1];
  end;
  if (s<>'') then begin
    delete(s,1,2);
    Fhttp.Request.CustomHeaders.Values['Cookie']:=s;
  end;
end;

Procedure TFacebook.Extractcookie(cookie:string; var name,value:string);
var i,k:integer;
begin
  i:=pos('=',cookie);
  k:=pos(';',cookie);
  if k=0 then k:=length(cookie);
  if i>0 then begin
    name:=copy(cookie,1,i-1);
    value:=copy(cookie,i+1,k-i-1);
  end else begin
    name:='';
    value:='';
  end;
end;

Procedure TFacebook.Savecookies;
var
j,count:integer;
name,value:String;
begin
  count:=FCookieManager.CookieCollection.count;
  for j:=1 to count do begin
    extractcookie(FCookieManager.CookieCollection.Items[j-1].CookieText,name,value);
    FCookies.Values[name]:=value;
  end;
end;

Procedure TFacebook.Updatecookies;
var
_cookies:tstringlist;
i:integer;
name,value:string;
begin
  _Cookies := TStringList.Create;
  Fhttp.Response.RawHeaders.Extract('Set-cookie', _Cookies);
  for i := 0 to _Cookies.Count - 1 do begin
    extractcookie(_Cookies[i],name,value);
    FCookies.Values[name]:=value;
  end;
  _cookies.free;
end;

{  procedure saveit(name:string;value:Ansistring);
  begin
    with tfilestream.create(name,fmcreate) do
    try
      write(pansichar(value)^,length(value));
    finally
      free;
    end;
  end;   }

Function TFacebook.ValidateLogin(Response:String):boolean;
begin
  result := (pos('http://www.facebook.com/editaccount.php',Response) <> 0);
end;

Function TFacebook.Login;
var
Params: TStringList;
html: string;
begin
  result := false;
  Params := TStringList.Create;
  try
    Fhttp.Get(first);// first get; get first cookie(s)
    savecookies;
    setCookies;
    //here what we post in login page
    Params.Values['charset_test'] := '&euro;,&acute;,€,´,?,?,?';
    Params.Values['lsd'] := '2cPHB';
    Params.Values['return_session'] := '0';
    Params.Values['legacy_return'] := '1';
    Params.Values['display'] := '';
    Params.Values['session_key_only'] := '0';
    Params.Values['trynum'] := '1';
    Params.Values['charset_test'] := '&euro;,&acute;,€,´,?,?,?';
    Params.Values['lsd'] := '2cPHB';
    Params.Values['email'] := Femail;
    Params.Values['pass'] := Fpass;
    Params.Values['persistent'] := '1';
    Params.Values['login'] := 'login';
    Fhttp.Request.Referer:=first;
    Fhttp.HandleRedirects := false;
    try
      Fhttp.Post(loginurl, Params);// now do the log in
    except
      on e: EIdHTTPProtocolException do
      begin
        if (e.ErrorCode div 100)=3 then
        begin
          updatecookies;
          setCookies;
          html := Fhttp.Get(home);
          result := ValidateLogin(html);
        end;
      end;
    end;
  finally
    Params.Free;
  end;
end;

Function FacebookLogin(Email,Password:string):boolean;
var
facebook : TFacebook;
begin
  facebook := TFacebook.Create(Email,Password);
  try
    result := Facebook.Login;
  finally
    facebook.Free;
  end;
end;

end.