10-19-2011، 03:21 PM
کد:
{ 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'] := '€,´,€,´,?,?,?';
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'] := '€,´,€,´,?,?,?';
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.