QQ登陆代码

系统教程830 更新时间：2026-04-05 17:28:52

2023年12月6日发(作者：)

QQ登陆代码

HTML文件中放置QQ登陆按钮

文件内容如下：

<%

Dim qc, url

Session("Code")=""

Session("Openid")=""

Session("Access_Token")=""

SET qc = New QqConnet

Session("State")=ndNum()

url = horization_Code()

ct(url)

Set qc=Nothing

%>

内容如下：

<%

'==================================

'=类名称：QqConnet

'=功能：QQ登录 For ASP

'=作者：㊣FireFox㊣

'=Q Q: 63572063

'=日期：2012-01-02

'==================================

'转载时请保留以上内容！！

Class QqConnet

Private QQ_OAUTH_CONSUMER_KEY

Private QQ_OAUTH_CONSUMER_SECRET

Private QQ_CALLBACK_URL

Private QQ_SCOPE

Private oDic,aKeys,access_token,TimeLine,boundary

'销毁对象

Private Sub Class_Terminate()

Set oDic = Nothing

End Sub

Private Sub Class_Initialize

QQ_OAUTH_CONSUMER_KEY = " "'APP ID

QQ_OAUTH_CONSUMER_SECRET = " "'APP KEY

QQ_CALLBACK_URL = " "'REDIRECT_URI

QQ_SCOPE ="get_user_info" '授权项例如：QQ_SCOPE=get_user_info,list_album,upload_pic,do_like,add_t

'不传则默认请求对接口get_user_info进行授权。

'建议控制授权项的数量，只传入必要的接口名称，因为授权项越多，用户越可能拒绝进行任何授权。

TimeLine= DateDiff("s","01/01/1970 08:00:00",Now()) 'oauth_timestamp

boundary="------------------"&TimeLine

Set oDic = Object("nary")

End Sub

Property Get APP_ID()

APP_ID = QQ_OAUTH_CONSUMER_KEY

End Property

'生成Session("State")数据.

Public Function MakeRandNum()

Randomize

Dim width : width = 6 '随机数长度,默认6位

width = 10 ^ (width - 1)

MakeRandNum = Int((width*10 - width) * Rnd() + width)

End Function

Private Function CheckXml()

Dim oxml,Getxmlhttp

On Error Resume Next

oxml=array("P","XMLHTTP.6.0","XMLHTTP.5.0","XMLHTTP.4.0","XMLHTTP.3.0","XMLHTTP","P.6.0","P.5.

For i=0 to ubound(oxml)

Set Getxmlhttp = Object(oxml(i))

If Err Then

CheckXml = False

Else

CheckXml = oxml(i) :Exit Function

End if

'Get方法请求url,获取请求内容

Private Function RequestUrl(url)

Set XmlObj = Object(CheckXml)

"GET",url, false

If tate=4 Then

RequestUrl = seText

Else

("xmlhttp请求超时！")

()

End If

Set XmlObj = nothing

End Function

'Post方法请求url,获取请求内容

Private Function RequestUrl_post(url,data)

Set XmlObj = Object(CheckXml())

"POST", url, false

uestheader "POST"," /t/add_t HTTP/1.1"

uestheader "Host"," "

uestheader "content-length ",len(data)

uestHeader "Content-Type "," application/x-www-form-urlencoded "

uestheader "Connection"," Keep-Alive"

uestheader "Cache-Control"," no-cache"

(data) If tate=4 Then

RequestUrl_post = seText

Else

("xmlhttp请求超时！")

()

End If

Set XmlObj = nothing

End Function

Private Function CheckData(data,str)

If Instr(data,str)>0 Then

CheckData = True

Else

CheckData = False

End If

End Function

'生成登录地址

Public Function GetAuthorization_Code()

Dim url, params

url = "/oauth2.0/authorize"

params = "client_id=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&redirect_uri=" & QQ_CALLBACK_URL

params = params & "&response_type=code"

params = params & "&scope="&QQ_SCOPE

params = params & "&state="&Session("State")

url = url & "?" & params

GetAuthorization_Code = (url)

End Function

'获取 access_token

Public Function GetAccess_Token()

Dim url, params,Temp

Url="/oauth2.0/token"

params = "client_id=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&client_secret=" & QQ_OAUTH_CONSUMER_SECRET

params = params & "&redirect_uri=" & QQ_CALLBACK_URL

params = params & "&grant_type=authorization_code"

params = params & "&code="&Session("Code")

url = Url & "?" & params

Temp=RequestUrl(url)

If CheckData(Temp,"access_token=") = True Then

GetAccess_Token=CutStr(Temp,"access_token=","&")

Else

("获取 Access_Token 时发生错误，错误代码："&CutStr(Temp,"{""error"":",","))

()

End If

End Function

Sub setSession(str)

Dim ary1

ary1 = Split(Replace(str,"=","&"),"&")

If ubound(ary1) > 1 Then

Session("access_token") = ary1(1)

Session("expires_in") = ary1(3)

Session("refresh_token") = ary1(5)

End If

End Sub

'检测是否合法登录！

Public Function CheckLogin()

Dim Code,mState

Code=Trim(tring("code"))

If Code<>"" Then

CheckLogin = True

Session("Code")=Code

Else

CheckLogin = False

End If

End Function

'获取openid

Public Function Getopenid()

Dim url, params,Temp

url = "/oauth2.0/me"

params = "access_token="&Session("Access_Token")

url = Url & "?" & params

Temp=RequestUrl(url)

If Instr(Temp,"openid")>0 Then

set obj = getjson(CutStr(Temp,"(",")"))

if isobject(obj) Then

Getopenid=

End If

set obj = Nothing

Else

set obj = getjson(CutStr(Temp,"(",")"))

if isobject(obj) Then

ret =

msg = _description

End If

set obj = Nothing

("获取 openid 时发生错误，错误代码："&ret&" , 错误描述："&msg)

()

End If

End Function

'发送一条微博

Public Function Post_Webo(content)

Dim url, params

url = "/t/add_t"

params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&access_token=" & Session("Access_Token")

params = params & "&openid=" & Session("Openid")

params = params & "&content="&content

params = params & "&format=json"

Post_Webo = RequestUrl_post(url,params)

End Function

'发送一条说说

Public Function Post_add_topic(content)

Dim url, params

url = "/shuoshuo/add_topic"

params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&access_token=" & Session("Access_Token")

params = params & "&openid=" & Session("Openid")

params = params & "&con="&content params = params & "&format=json"

Post_add_topic = RequestUrl_post(url,params)

End Function

'分享内容到QQ空间

Public Function Post_Share(title,turl,comment,summary,images)

Dim url, params

url = "/share/add_share"

params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&access_token=" & Session("Access_Token")

params = params & "&openid=" & Session("Openid")

params = params & "&title="&title

params = params & "&url="&turl

params = params & "&title="&title

params = params & "&comment="&comment

params = params & "&summary="&summary

params = params & "&images="&images

params = params & "&format=json"

Post_Share = RequestUrl_post(url,params)

End Function

'获取用户信息,得到一个json格式的字符串

Public Function GetUserInfo()

Dim url, params, result

url = "/user/get_user_info"

params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&access_token=" & Session("Access_Token")

params = params & "&openid=" & Session("Openid")

url = url & "?" & params

Temp = RequestUrl(url)

If CheckData(Temp,"nickname") = False Then

set obj = getjson(Temp)

if isobject(obj) Then

ret =

msg =

End If

set obj = Nothing

("获取用户信息时发生错误，错误代码："&ret&" , 错误描述："&msg)

()

End If

GetUserInfo = Temp

End Function

'获取腾讯微博登录用户的用户资料,得到一个json格式的字符串

Public Function Get_Info()

Dim url, params, result

url = "/user/get_info"

params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY

params = params & "&access_token=" & Session("Access_Token")

params = params & "&openid=" & Session("Openid")

params = params & "&format=json"

url = url & "?" & params

Get_Info = RequestUrl(url)

End Function

'获取用户名字,性别,从json字符串里截取相关字符

Public Function GetUserName(json)

Dim nickname,sex,obj

set obj = getjson(json)

if isobject(obj) Then

nickname = me

sex =

End If

set obj = Nothing

GetUserName = Array(nickname,sex)

End Function

'获取用户头像

Public Function GetUserPhoto(json)

Dim userphoto,obj

set obj = getjson(json)

if isobject(obj) Then

userphoto = url_qq_1

End If

set obj = Nothing

GetUserPhoto = userphoto

End Function

Public Function CutStr(data,s_str,e_str)

If Instr(data,s_str)>0 and Instr(data,e_str)>0 Then

CutStr = Split(data,s_str)(1)

CutStr = Split(CutStr,e_str)(0)

Else

CutStr = ""

End If

End Function

'发送数据

Function doRequest(verb, resLoc, getData, objData, multi)

Dim aUrl,xmlhttp

If(getData <>"") then getData = "?"&getData

aUrl = resLoc & getData

aUrl & "

"

Set xmlhttp=Object("XMLHTTP")

verb,aUrl,false

If(verb = "POST") Then

If(multi) Then '如果是图片

uestHeader "Content-Type","multipart/form-data; boundary="&boundary

'图片上传处理

Else

uestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"

End If

(objData)

doRequest=seText

'("测试信息，可注释: " & Replace(Replace(doRequest,"<","<"),">",">") & "

一个在线格式化JSON数据的工具：/

")

Set xmlhttp=Nothing

End Function

Function Sorts()

Dim i,arr(),aKeys,aItems

ReDim arr(-1)

aKeys =

aItems =

For i=0 To -1

arr(i)=aKeys(i)&"="&strUrlEnCode((aKeys(i)))

End Function

'URL Encode，并将不需要转换的再替换回来 Function strUrlEnCode(byVal strUrl)

strUrlEnCode = ode(strUrl)

strUrlEnCode = Replace(strUrlEnCode,"%5F","_")

strUrlEnCode = Replace(strUrlEnCode,"%2E",".")

strUrlEnCode = Replace(strUrlEnCode,"%2D","-")

strUrlEnCode = Replace(strUrlEnCode,"+","%20")

End Function

End Class

%>

　点击登陆后会在返回文件中附加Code=XXXX&State=XXXX内容，将此内容继续进行处理，可获得QQ图片，名字等信息。

If Len(Code)>0 then '登陆成功

SET qc = New QqConnet

Session("Access_Token")=ess_Token()

Session("Openid")=nid()

UserInfo=rInfo()

UserName=rName(UserInfo)(0)

UserPhoto=rPhoto(UserInfo)

End if

本文发布于:2023-12-06，感谢您对本站的认可！

本文链接:https://www.fzithome.com/xitong/1701869181a47874.html

QQ登陆代码

发布评论取消回复

最近发表

相关推荐

标签列表

QQ登陆代码

发布评论 取消回复

最近发表

相关推荐

标签列表

发布评论取消回复