{ 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

发表于 @ 2009年04月16日　10:41:00 | 评论( loading... ) | 编辑| 举报| 收藏

旧一篇:整理的两个图像处理函数 | 新一篇:创建多层目录函数