在delphi程序中实现QQ用户的Web登陆并获取个人信息

{
code by siow http://blog.csdn.net/siow ver 0.2 2009-04-16
修正了分组信息与好友信息获取不到的bug
ver 0.1 2009-04-15
初步实现QQ账号的Web登陆，个人信息和头像的获取
}
unit Unit1;
interface
{.$DEFINE ID10}
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, StdCtrls,jpeg,IdHashMessageDigest,IdHash,StrUtils;
type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
Image1: TImage;
btn2: TButton;
edt1: TEdit;
edt2: TEdit;
edt3: TEdit;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
btn1: TButton;
mmo1: TMemo;
Edit1: TEdit;
img1: TImage;
btn3: TButton;
btn5: TButton;
btn6: TButton;
procedure FormCreate(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure btn5Click(Sender: TObject);
procedure btn6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

end;
var
Form1: TForm1;
cookie:string;
implementation
{$R *.dfm}
//提取字符串
function SubString(html,Cstr_L,Cstr_R:string):string;
var
sPosB,sPosE:integer;
Lwhtml,LwCstr_L,LwCstr_R:string;
begin
Result:='';
if trim(html)='' then exit;
Lwhtml:=LowerCase(html);
LwCstr_L :=LowerCase(Cstr_L);
LwCstr_R :=LowerCase(Cstr_R);
sPosB:=Pos(LwCstr_L,Lwhtml)+Length(LwCstr_L);
sPosE:=PosEx(LwCstr_R,Lwhtml,sPosB);
if (sPosB<sPosE) and (sPosE>0) then
Result:=copy(html,sPosB,sPosE-sPosB);
end;
function HashStr2BinStr(Hash:string):string;
var
buf:array[0..63] of Char;
i:Integer;
begin
Result:='';
FillChar(buf,SizeOf(buf),0);
SetLength(Result,Round(Length(Hash)/2));
FillChar(Result[1],Length(Result),0);
HexToBin(PChar(Hash),buf,SizeOf(buf));
for i:=0 to Round(Length(Hash)/2)-1 do
Result[i+1]:=buf[i];
end;
function Fmd5(str:string):string;
var
md5 : TIdHashMessageDigest5;
longWordRec : T4x4LongWordRecord;
begin
md5 := TIdHashMessageDigest5.Create;
try
{$IFDEF ID10}
Result:=md5.HashStringAsHex(str);
{$ELSE}
longWordRec:=md5.HashValue(str);
Result:=md5.AsHex(longWordRec);
{$ENDIF}
finally
md5.Free;
end;
end;
function md5_3(str:string):string;
begin
Result:=Fmd5(str);
Result:=HashStr2BinStr(Result);
Result:=Fmd5(Result);
Result:=HashStr2BinStr(Result);
Result:=Fmd5(Result);
end;
function preprocess(pass,verifycode:string):string;
begin
Result:=Fmd5(md5_3(pass)+UpperCase(verifycode));
end;
function GetVerifyPic(IdHTTP:TIdHTTP;Img:TImage):boolean;
var
ms:TMemoryStream;
pic:TJPEGImage;
begin
Result:=False;
try
ms:=TMemoryStream.Create;
try
IdHTTP.Get('http://ptlogin2.qq.com/getimage',ms);
ms.Position:=0;
pic:=TJPEGImage.Create;
try
pic.LoadFromStream(ms);
Img.Picture.Assign(pic);
finally
pic.Free;
end;
cookie:=SubString(IdHTTP.Response.RawHeaders.Text,'Set-Cookie: verifysession=',';');
cookie:='Cookie: verifysession='+cookie+';';
IdHTTP.Request.CustomHeaders.Clear;
IdHTTP.Request.CustomHeaders.Add(cookie);
finally
ms.Free;
end;
Result:=true;
except
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetVerifyPic(idhttp1,Image1);
end;
procedure TForm1.btn2Click(Sender: TObject);
var
Params:TStrings;
url:string;
tmp:string;
ms:TMemoryStream;
bmp:TBitmap;
begin
Params :=TStringList.Create;
try
Params.Append('u='+edt1.Text);
Params.Append('p='+preprocess(edt2.Text,edt3.Text));
Params.Append('verifycode='+edt3.Text);
Params.Append('u1=http://my.qq.com');
Params.Append('aid=8000203');
try
url := 'http://ptlogin2.qq.com/login';
IdHTTP1.HandleRedirects:=False;
tmp:=idhttp1.Post(url,Params);
except
end;
finally
Params.Free;
end;
tmp:=SubString(IdHTTP1.Response.RawHeaders.Text,'Set-Cookie: pt2gguin=',';');
cookie:=cookie+' pt2gguin='+tmp+';';
tmp:=SubString(IdHTTP1.Response.RawHeaders.Text,'Set-Cookie: uin=',';');
cookie:=cookie+' uin='+tmp+';';
tmp:=SubString(IdHTTP1.Response.RawHeaders.Text,'Set-Cookie: skey=',';');
cookie:=cookie+' skey='+tmp+';';
tmp:=SubString(IdHTTP1.Response.RawHeaders.Text,'Set-Cookie: ptcz=',';');
cookie:=cookie+' ptcz='+tmp+';';
IdHTTP1.Request.CustomHeaders.Clear;
IdHTTP1.Request.CustomHeaders.Add(cookie);
tmp:=Utf8ToAnsi(idhttp1.Get('http://my.qq.com'));
mmo1.Text:=tmp;
tmp:=Utf8ToAnsi(idhttp1.Get('http://city.qzone.qq.com/pingcity.php'));
mmo1.Text:=tmp;
tmp:=SubString(IdHTTP1.Response.RawHeaders.Text,'Set-Cookie: qzone_city_key=',';');
cookie:=cookie+' qzone_city_key='+tmp+';';
IdHTTP1.Request.CustomHeaders.Clear;
IdHTTP1.Request.CustomHeaders.Add(cookie);
tmp:=Utf8ToAnsi(IdHTTP1.Get('http://my.qq.com/my_login_info.php'));
mmo1.Text:=tmp;
ms:=TMemoryStream.Create;
try
IdHTTP1.Get('http://my.qq.com/qq_face.php',ms);
bmp:=TBitmap.Create;
try
ms.Position:=0;
bmp.LoadFromStream(ms);
img1.Picture.Assign(bmp);
finally
bmp.Free;
end;
finally
ms.Free;
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
mmo1.Text:= Utf8ToAnsi(idhttp1.Get(Edit1.Text));
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
GetVerifyPic(idhttp1,Image1);
end;
procedure TForm1.btn5Click(Sender: TObject);
begin
//获取用户分组
mmo1.Text:=Utf8ToAnsi(idhttp1.Get('http://users.qzone.qq.com/cgi-bin/tfriend/friend_getgroupinfo.cgi?uin='+edt1.Text));
end;
procedure TForm1.btn6Click(Sender: TObject);
begin
//获取好友信息
mmo1.Text:= idhttp1.Get('http://show.qq.com/cgi-bin/qqshow_user_friendgroup');
end;
end.

object Form1: TForm1
Left = 253
Top = 129
Width = 596
Height = 480
Caption = 'Ver 0.2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 4
Top = 88
Width = 129
Height = 57
end
object lbl1: TLabel
Left = 8
Top = 8
Width = 28
Height = 13
Caption = 'QQ'#21495
end
object lbl2: TLabel
Left = 8
Top = 40
Width = 24
Height = 13
Caption = #23494#30721
end
object lbl3: TLabel
Left = 8
Top = 64
Width = 36
Height = 13
Caption = #39564#35777#30721
end
object img1: TImage
Left = 32
Top = 192
Width = 105
Height = 105
end
object btn2: TButton
Left = 64
Top = 152
Width = 75
Height = 25
Caption = #30331#38470
TabOrder = 0
OnClick = btn2Click
end
object edt1: TEdit
Left = 64
Top = 8
Width = 121
Height = 21
TabOrder = 1
end
object edt2: TEdit
Left = 64
Top = 32
Width = 121
Height = 21
PasswordChar = '*'
TabOrder = 2
end
object edt3: TEdit
Left = 64
Top = 56
Width = 121
Height = 21
TabOrder = 3
end
object btn1: TButton
Left = 472
Top = 8
Width = 57
Height = 25
Caption = 'GetUrl'
TabOrder = 4
OnClick = btn1Click
end
object mmo1: TMemo
Left = 192
Top = 40
Width = 297
Height = 409
Lines.Strings = (
'mmo1')
TabOrder = 5
end
object Edit1: TEdit
Left = 192
Top = 8
Width = 273
Height = 21
TabOrder = 6
end
object btn3: TButton
Left = 136
Top = 104
Width = 49
Height = 25
Caption = #30475#19981#28165
TabOrder = 7
OnClick = btn3Click
end
object btn5: TButton
Left = 496
Top = 40
Width = 75
Height = 25
Caption = #33719#21462#20998#32452
TabOrder = 8
OnClick = btn5Click
end
object btn6: TButton
Left = 496
Top = 72
Width = 75
Height = 25
Caption = #33719#21462#22909#21451
TabOrder = 9
OnClick = btn6Click
end
object IdHTTP1: TIdHTTP
MaxLineAction = maException
ReadTimeout = 0
AllowCookies = True
ProxyParams.BasicAuthentication = False
ProxyParams.ProxyPort = 0
Request.ContentLength = -1
Request.ContentRangeEnd = 0
Request.ContentRangeStart = 0
Request.ContentType = 'text/html'
Request.Accept = 'text/html, */*'
Request.BasicAuthentication = False
Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
HTTPOptions = [hoForceEncodeParams]
Left = 464
Top = 72
end
end