不登陆获取qq头像 实例源码

【实例简介】原理是

以GET方式访问

http://ptlogin2.qq.com/getface?appid=1006102&uin=QQ号码&imgtype=尺寸

尺寸一共分为四等：

• 2：70*70
• 3：175* 175
• 4：247*247
• 5：高清原始头像（不存在高清头像则返回等级为2级的头像）

返回内容如下：

pt.setHeader({"QQ号码":"http:\/\/q4.qlogo.cn\/g?b=qq&k=JEPicUxtymH7VlzGlehNdxA&s=40&t=1384608689"});

里面的URL就是头像的真正地址。

第二步

把上一步获取到的URL里的转义符处理一下，然后直接访问就可以了。

http://q4.qlogo.cn/g?b=qq&k=JEPicUxtymH7VlzGlehNdxA&s=40&t=1384608689

【核心代码】

VERSION 5.00
Begin VB.Form FormMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "QQ头像获取"
   ClientHeight    =   6540
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   7230
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "FormMain.frx":0000
   LinkTopic       =   "FormMain"
   MaxButton       =   0   'False
   ScaleHeight     =   436
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   482
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox Combo1 
      Height          =   360
      ItemData        =   "FormMain.frx":000C
      Left            =   1560
      List            =   "FormMain.frx":001C
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   960
      Width           =   2655
   End
   Begin VB.CommandButton Command1 
      Caption         =   "读取"
      Default         =   -1  'True
      Height          =   495
      Left            =   4320
      TabIndex        =   2
      Top             =   360
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   1560
      TabIndex        =   1
      Text            =   "2788808483"
      Top             =   360
      Width           =   2655
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "更多细节请访问月球猫博客 www.u2nn.com"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   375
      Left            =   0
      TabIndex        =   5
      Top             =   6120
      Width           =   7335
   End
   Begin VB.Label Label2 
      Height          =   375
      Left            =   1560
      TabIndex        =   4
      Top             =   5400
      Width           =   4335
   End
   Begin VB.Image Picture1 
      Height          =   3855
      Left            =   1560
      Stretch         =   -1  'True
      Top             =   1440
      Width           =   4335
   End
   Begin VB.Label Label1 
      Caption         =   "QQ号码："
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   2055
   End
End
Attribute VB_Name = "FormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 更多细节请访问月球猫博客 http://www.u2nn.com

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents httpRequest As WinHttpRequest
Attribute httpRequest.VB_VarHelpID = -1

Dim state As Long

Private Sub Command1_Click()
    Dim qq As String
    qq = Text1.Text
    
    Dim level As Long
    level = Val(Combo1.Text)
    
    Set Picture1.Picture = Nothing
    
    If Len(qq) > 0 Then
        If IsNumeric(qq) Then
            beginFindHead qq, level
            Exit Sub
        End If
    End If
    
    Me.Caption = "内容输入错误！"
End Sub

Private Sub Form_Load()
    Set httpRequest = New WinHttpRequest
    Combo1.ListIndex = 0
End Sub

Sub beginFindHead(ByVal qq As String, ByVal level As Long)
    httpRequest.Abort
    httpRequest.Open "GET", "http://ptlogin2.qq.com/getface?appid=1006102&imgtype=" & level & "&uin=" & qq, True
    httpRequest.Send
    state = 1
    Me.Caption = "正在获取头像地址..."
End Sub

Sub beginLoadHead(ByVal url As String)
    If Len(url) = 0 Then
        Exit Sub
    End If
    httpRequest.Abort
    httpRequest.Open "GET", url, True
    httpRequest.Send
    state = 2
    Me.Caption = "拉取头像..."
End Sub

Private Sub Form_Unload(Cancel As Integer)
    httpRequest.Abort
    Set httpRequest = Nothing
End Sub


Private Sub httpRequest_OnResponseFinished()
    If httpRequest.Status = 200 Then
        If state = 1 Then
            Dim ret As String
            ret = StrConv(httpRequest.ResponseBody, vbUnicode)
            
            Dim param() As String
            param = Split(ret, """")
            
            Dim headUrl As String
            headUrl = Replace((param(3)), "\/", "/")
            beginLoadHead headUrl
            Me.Caption = ""
        ElseIf state = 2 Then
            Set Picture1.Picture = PictureFromBits(httpRequest.ResponseBody)
            Me.Caption = "完毕！"
            Label2.Caption = "图像信息：宽 " & CLng(Picture1.Picture.Width / Screen.TwipsPerPixelX) & "， 高 " & CLng(Picture1.Picture.Height / Screen.TwipsPerPixelY)
        End If
    End If
End Sub

Private Sub Label3_Click()
    ShellExecute 0, "open", "http://www.u2nn.com", "", "", 1
End Sub