三个文件:
qqconnect.asp
1 <%@codepage=65001%> 2 <% 3 '================================== 4 '=类 名 称:QqConnet 5 '=功 能:QQ登录 For ASP 6 '=作 者:㊣FireFox㊣ 7 '=Q Q: 63572063 8 '=日 期:2012-01-02 9 '================================== 10 '转载时请保留以上内容!! 11 Class QqConnet 12 Private QQ_OAUTH_CONSUMER_KEY 13 Private QQ_OAUTH_CONSUMER_SECRET 14 Private QQ_CALLBACK_URL 15 Private QQ_SCOPE 16 17 Private Sub Class_Initialize 18 QQ_OAUTH_CONSUMER_KEY = ""'APP ID 19 QQ_OAUTH_CONSUMER_SECRET = ""'APP KEY 20 QQ_CALLBACK_URL = "user.asp"'REDIRECT_URI,请改成你的回调地址。 21 QQ_SCOPE ="get_user_info" '授权项 例如:QQ_SCOPE=get_user_info,list_album,upload_pic,do_like,add_t 22 '不传则默认请求对接口get_user_info进行授权。 23 '建议控制授权项的数量,只传入必要的接口名称,因为授权项越多,用户越可能拒绝进行任何授权。 24 End Sub 25 Property Get APP_ID() 26 APP_ID = QQ_OAUTH_CONSUMER_KEY 27 End Property 28 29 '生成Session("State")数据. 30 Public Function MakeRandNum() 31 Randomize 32 Dim width : width = 6 '随机数长度,默认6位 33 width = 10 ^ (width - 1) 34 MakeRandNum = Int((width*10 - width) * Rnd() + width) 35 End Function 36 37 38 39 'Get方法请求url,获取请求内容 40 Private Function RequestUrl(url) 41 Set XmlObj = Server.CreateObject("Microsoft.XMLHTTP") 42 XmlObj.open "GET",url, false 43 XmlObj.send 44 RequestUrl = XmlObj.responseText 45 Set XmlObj = nothing 46 End Function 47 48 'Post方法请求url,获取请求内容 49 Private Function RequestUrl_post(url,data) 50 Set XmlObj = Server.CreateObject("Microsoft.XMLHTTP") 51 XmlObj.open "POST", url, false 52 'XmlObj.setrequestheader "POST","/t/add_t HTTP/1.1" 53 XmlObj.setrequestheader "Host"," graph.qq.com " 54 XmlObj.setrequestheader "content-length ",len(data) 55 XmlObj.setrequestheader "content-type ", "application/x-www-form-urlencoded " 56 XmlObj.setrequestheader "Connection"," Keep-Alive" 57 XmlObj.setrequestheader "Cache-Control"," no-cache" 58 XmlObj.send(data) 59 RequestUrl_post = XmlObj.responseText 60 Set XmlObj = nothing 61 End Function 62 63 '生成登录地址 64 Public Function GetAuthorization_Code() 65 Dim url, params 66 url = "https://graph.qq.com/oauth2.0/authorize" 67 params = "client_id=" & QQ_OAUTH_CONSUMER_KEY 68 params = params & "&redirect_uri=" & QQ_CALLBACK_URL 69 params = params & "&response_type=code" 70 params = params & "&scope="&QQ_SCOPE 71 params = params & "&state="&Session("State") 72 url = url & "?" & params 73 GetAuthorization_Code = (url) 74 End Function 75 76 77 '获取 access_token 78 Public Function GetAccess_Token() 79 Dim url, params,Temp 80 Url="https://graph.qq.com/oauth2.0/token" 81 params = "client_id=" & QQ_OAUTH_CONSUMER_KEY 82 params = params & "&client_secret=" & QQ_OAUTH_CONSUMER_SECRET 83 params = params & "&redirect_uri=" & QQ_CALLBACK_URL 84 params = params & "&grant_type=authorization_code" 85 params = params & "&code="&Session("Code") 86 params = params & "&state="&Session("State") 87 url = Url & "?" & params 88 Temp=RequestUrl(url) 89 Temp=split(Temp,"&")(0) 90 Temp=replace(Temp,"access_token=","") 91 GetAccess_Token=Temp 92 End Function 93 94 '检测是否合法登录! 95 Public Function CheckLogin() 96 Dim Code,mState 97 Code=Trim(Request.QueryString("code")) 98 mState=Trim(Request.QueryString("state")) 99 If Code<>"" Then 100 CheckLogin = True 101 Session("Code")=Code 102 Else 103 CheckLogin = False 104 End If 105 End Function 106 107 '获取openid 108 Public Function Getopenid() 109 Dim url, params,Temp 110 url = "https://graph.qq.com/oauth2.0/me" 111 params = "access_token="&Session("Access_Token") 112 url = Url & "?" & params 113 Temp=RequestUrl(url) 114 Temp=split(Temp,"openid"":""")(1) 115 Temp=split(Temp,"""}")(0) 116 Getopenid=Temp 117 End Function 118 119 '发送一条微博 120 Public Function Post_Webo(content) 121 Dim url, params 122 url = "https://graph.qq.com/t/add_t" 123 params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY 124 params = params & "&access_token=" & Session("Access_Token") 125 params = params & "&openid=" & Session("Openid") 126 params = params & "&content="&content 127 Post_Webo = RequestUrl_post(url,params) 128 End Function 129 130 '获取用户信息,得到一个json格式的字符串 131 Public Function GetUserInfo() 132 Dim url, params, result 133 url = "https://graph.qq.com/user/get_user_info" 134 params = "oauth_consumer_key=" & QQ_OAUTH_CONSUMER_KEY 135 params = params & "&access_token=" & Session("Access_Token") 136 params = params & "&openid=" & Session("Openid") 137 url = url & "?" & params 138 GetUserInfo = RequestUrl(url) 139 End Function 140 141 142 '获取用户名字,性别,从json字符串里截取相关字符 143 Public Function GetUserName(json) 144 Dim nickname,sex 145 nickname = Split(json, "nickname"":""")(1) 146 sex=Split(json, "gender"":""")(1) 147 nickname = Split(nickname, """,")(0) 148 sex=Split(sex, """")(0) 149 GetUserName = Array(nickname,sex) 150 End Function 151 End Class 152 %>
index.asp
<!--#include file="qqconnect.asp"--> <% Dim qc, url SET qc = New QqConnet Session("State")=qc.MakeRandNum() url = qc.GetAuthorization_Code() Response.Redirect(url) Set qc=Nothing %>
user.asp
<!--#include file="qqconnect.asp"--> <% SET qc = New QqConnet CheckLogin=qc.CheckLogin() If CheckLogin=False Then Response.Write("登录失败!") Response.End() End If ' Response.Write(Session("State")) Session("Access_Token")=qc.GetAccess_Token() 'Response.Write("Access_Token="&Session("Access_Token")&"<br/>") Session("Openid")=qc.Getopenid() qqid=Session("Openid") 'Response.Write("Openid="&Session("Openid")&" [此openid可作为唯一标识,可用来绑定网站原有帐号!]<br/>") UserInfo=qc.GetUserInfo() 'Response.Write(UserInfo) 'Response.Write("姓名:"&qc.GetUserName(UserInfo)(0)&"<br/>") nickname=qc.GetUserName(UserInfo)(0) 'Response.Write("性别:"&qc.GetUserName(UserInfo)(1)&"<br/>") sex=qc.GetUserName(UserInfo)(1) 'Response.Write("头像:<img src=http://qzapp.qlogo.cn/qzapp/"&qc.APP_ID&"/"&Session("Openid")&"/30") imgurl="http://qzapp.qlogo.cn/qzapp/"&qc.APP_ID&"/"&Session("Openid")&"/30" Set qc=Nothing %>