Dobra to niech będzie podam, może komuś się przyda. Ale nie polecam się sugerować za bardzo tym kodem do facebooka, bo każda strona potrzebuje na ogół innych danych oraz inaczej może przebiegać logowanie. Problem w tym, że facebook przez zalogowaniem wymaga jeszcze odpowiednich ciasteczek i żeby je mieć trzeba odwiedzić pobierając najpierw stronę logowania. Poniższy kod wykonuje się w wątku i pochodzi z mojej aplikacji do pobierania zdjęć z galerii własnych znajomych. Początkowo chcialem pisać aplikację z użyciem API FaceBooka, ale nie zdalo to rezultatów, bo nie mogłem pobrać łatwo listy znajomych. Wycwaniłem się więc - nazwijmy to tak :) I pobrałem tymczasowy token potrzebny do pobierania listy znajomych w postaci pliku podobnego do xmla czy tam csv, z kodu strony dla developerów dostępnej po zalogowaniu. Można na niej zobaczyć jak wyglądają takie pliki tekstowe. Poniżej wycinki najważniejszego kodu, bo będąc zalogowanym, pobieranie danych o galerii użytkownika i później fotkach to już zwykle tylko pobieranie oraz parsowanie strony wyrażeniami regularnymi. Najprostrze dane z pomiędzy dwóch tagów występujące tylko raz są wyciągane przy użyciu funkcji SimpleParse, której autorem jest Misiekd i kiedyś podesłal mi to w innym kodzie. Natomiast SynHttp to oczywiście THttpSend, a zmienne FUrl i podobne są typu string. Mam nadzieję, że na coś się to Tobie przyda. Ale zrób z WireSharkiem jak pisałem i przeanalizuj pakiety do metody POST kiedy połączenie nie jest szyfrowane po zmianie kodu html na dysku. Wiem też, że pobranie adresu do przekierowania można zrobić inaczej, ale ja zrobilem to w pętli tak jak widać poniżej i już tak się przyzwyczaiłem.
//...
const
Base_Url = 'http://www.facebook.com/';
Base_Url_SSL = 'https://www.facebook.com/';
Graph_Url_SSL = 'https://graph.facebook.com/';
//...
const
Redir_C = 'Location: ';
Default_MimeType = 'application/x-www-form-urlencoded';
ColorsArray : array[boolean] of TColor = (clInactiveBorder, clWindow);
Opera_UserAgent = 'Opera/9.80 (Windows NT 5.1; U; pl) Presto/2.7.62 Version/11.01';
//...
function SimpleParse(StrBegin, StrEnd, Str : string) : string;
var
B, E : integer;
begin
Result := '';
if StrBegin = '' then
begin
B := 1;
end
else
begin
B := Pos(StrBegin, Str);
end;
if B > 0 then
begin
Str := Copy(Str, B + Length(StrBegin), MaxInt);
if StrEnd = '' then
begin
E := Length(Str) + 1;
end
else
begin
E := Pos(StrEnd, Str);
end;
if E > 0 then
begin
Result := Copy(Str, 1, E - 1);
end;
end;
end;
//...
procedure TMainForm.LoginBtnClick(Sender : TObject);
begin
AlreadyLogged := True;
AUser := UserEmailEdit.Text;
APass := PasswordEdit.Text;
SetLVControlsAvailable(False, True);
if SynHttp = nil then
begin
SynHttp := THttpSend.Create;
with SynHttp do
begin
KeepAlive := True;
Protocol := '1.1';
MimeType := Default_MimeType;
UserAgent := Opera_UserAgent;
end;
end;
LoginThr := TLoginThr.Create(False);
end;
// ...
function TMainForm.Logon(UserEmail, UserPassword : string) : boolean;
const
Developers_Url = 'https://developers.facebook.com';
ACharset_Test = '%E2%82%AC%2C%C2%B4%2C%E2%82%AC%2C%C2%B4%2C%E6%B0%B4%2C%D0%94%2C%D0%84';
Error_Text1 = 'Nieprawidłowy adres e-mail';
Error_Text2 = 'Nieprawidłowa nazwa użytkownika';
Error_Text3 = 'Wprowadzone hasło jest nieprawidłowe';
Error_Text4 = 'Wykryto wielokrotne próby zalogowania się do Twojego konta';
var
RedirUrl : string;
I, RedirPos : integer;
begin
Result := False;
with SynHttp do
begin
Headers.Clear;
Document.Clear;
FUrl := Base_Url_SSL + 'index.php';
HTTPMethod('GET', FUrl);
Headers.Clear;
FUrl := Base_Url_SSL + 'login.php?login_attempt=1';
FStrData := 'charset_test=' + ACharset_Test + '&locale=pl_PL' +
'&email=' + UserEMail + '&pass=' + UserPassword +
'&default_persistent=0&charset_test=' + ACharset_Test;
Document.Write(PChar(FStrData)^, Length(FStrData));
HTTPMethod('POST', FUrl);
SetLength(FPage, Document.Size);
Document.Read(PChar(FPage)^, Length(FPage));
FPage := UTF8ToAnsi(FPage);
if Pos(Error_Text1, FPage) > 0 then
begin
AlreadyLogged := Result;
SetFocusToEditFields(UserEmailEdit);
MessageBox(Application.Handle, PChar(Error_Text1 + '!'),
PChar(Application.Title), MB_ICONERROR + MB_OK);
Exit;
end;
if Pos(Error_Text2, FPage) > 0 then
begin
AlreadyLogged := Result;
SetFocusToEditFields(UserEmailEdit);
MessageBox(Application.Handle, PChar(Error_Text2 + '!'),
PChar(Application.Title), MB_ICONERROR + MB_OK);
Exit;
end;
if Pos(Error_Text3, FPage) > 0 then
begin
AlreadyLogged := Result;
SetFocusToEditFields(PasswordEdit);
MessageBox(Application.Handle, PChar(Error_Text3 + '!'),
PChar(Application.Title), MB_ICONERROR + MB_OK);
Exit;
end;
if Pos(Error_Text4, FPage) > 0 then
begin
MessageBox(Application.Handle, PChar(Error_Text4 + '!' + #13#10 +
'Zaloguj się do konta tymczasowo przez przeglądarkę WWW.'),
PChar(Application.Title), MB_ICONERROR + MB_OK);
Exit;
end;
while (ResultCode = 301) or (ResultCode = 302) do
begin
for I := 0 to Headers.Count - 1 do
begin
RedirPos := Pos(Redir_C, Headers[I]);
if RedirPos > 0 then
begin
RedirUrl := Copy(Headers[I], RedirPos + Length(Redir_C), MaxInt);
if Pos(':443/', RedirUrl) > 0 then
begin
RedirUrl := StringReplace(RedirUrl, ':443/', '/', []);
RedirUrl := StringReplace(RedirUrl, 'http://', 'https://', []);
end;
Headers.Clear;
HTTPMethod('GET', RedirUrl);
Break;
end;
end;
end;
FUrl := Developers_Url + '/docs/reference/api';
Headers.Clear;
HTTPMethod('GET', FUrl);
while (ResultCode = 301) or (ResultCode = 302) do
begin
for I := 0 to Headers.Count - 1 do
begin
RedirPos := Pos(Redir_C, Headers[I]);
if RedirPos > 0 then
begin
RedirUrl := Copy(Headers[I], RedirPos + Length(Redir_C), MaxInt);
if Pos('http://', RedirUrl) = 0 then
begin
RedirUrl := Developers_Url + RedirUrl;
end;
Headers.Clear;
HTTPMethod('GET', RedirUrl);
Break;
end;
end;
end;
SetLength(FPage, Document.Size);
Document.Read(PChar(FPage)^, Length(FPage));
FAcessToken := SimpleParse('?access_token=', '">', FPage);
Result := True;
end;
end;
//...