1. 首页
  2. 文章中心
  3. Delphi IdHttp控件

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

78 阅读 0 评论
我是靠谱客的博主 负责皮卡丘，最近开发中收集的这篇文章主要介绍在delphi程序中实现QQ用户的Web登陆并获取个人信息，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

// 2011年后，使用Post应该不能登陆qq了。个人见解。。。 委屈 

{ 
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. 
{
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.

view plaincopy to clipboardprint?
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

最后

以上就是负责皮卡丘为你收集整理的在delphi程序中实现QQ用户的Web登陆并获取个人信息的全部内容，希望文章能够帮你解决在delphi程序中实现QQ用户的Web登陆并获取个人信息所遇到的程序开发问题。

如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。

本图文内容来源于网友提供，作为学习参考使用，或来自网络收集整理，版权属于原作者所有。
点赞(52)

相关文章

IT兄弟连 JavaWeb教程 使用AJAX发送GET请求并获取响应
IT兄弟连 JavaWeb教程 使用AJAX发送GET请求并获取响应
QQ登录功能实现过程和原理
QQ登录功能实现过程和原理
android 仿qq单点登录,QQ 的快速登录原理（BS、CS 混合的单点登录）
android 仿qq单点登录,QQ 的快速登录原理（BS、CS 混合的单点登录）
Ajax发送get请求Ajax发送get请求
Ajax发送get请求Ajax发送get请求
在delphi程序中实现QQ用户的Web登陆并获取个人信息
在delphi程序中实现QQ用户的Web登陆并获取个人信息
Ajax中get请求和post请求的区别
Ajax中get请求和post请求的区别
使用XMLHttpRequest发送网络请求
使用XMLHttpRequest发送网络请求
ajax总结
ajax总结

评论列表共有 0 条评论

立即
投稿
返回
顶部