سورس لاگین کردن فیس بوک با دلفی

کد:
{ 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.