<%
'******************************************************
'本SDK由周子铺制作
'新浪微博：http://weibo.com/cracker
'个人博客：http://4jax.net/log/
'使用请保留版权信息，如果你有更好的方法，欢迎共享。
'******************************************************
On Error Resume Next '容错
Response.Charset="utf-8"
Const apiKey="" //APP ID
Const secretKey="" //APP KEY
Const callback="http://127.0.0.1/login.asp" //返回地址修改为你的
Class OAuth
Private sha1,oDic,aItems,aKeys,TimeLine,Once,request_token,request_secret,oauth_token,oauth_secret,boundary
'初始化通用参数
Private Sub Class_Initialize 	
	TimeLine= DateDiff("s","01/01/1970 08:00:00",Now()) 'oauth_timestamp 国外主机注意时区国内为东八区所以是8点
	boundary="------------------"&TimeLine
	Once = TimeLine
	Set oDic = Server.CreateObject("Scripting.Dictionary")
	oDic.Add "oauth_consumer_key",apiKey
	oDic.Add "oauth_timestamp",TimeLine
	oDic.Add "oauth_nonce",Once
	oDic.Add "oauth_version","1.0"
	oDic.Add "oauth_signature_method","HMAC-SHA1"
End Sub
'销毁对象
Private Sub Class_Terminate() 
	Set oDic = Nothing
End Sub
'设置oauth_token
Function getToken(arr,t)
If IsArray(arr) Then 
  If t="request" Then 
    oDic.Add "oauth_token", arr(0)
    request_secret=arr(1)
  ElseIf t="token" Then 
  If oDic.Exists("oauth_token") Then 
    oDic.item("oauth_token") = arr(0)
	Else
	 oDic.Add "oauth_token", arr(0)
  End If  
   oauth_secret=arr(1)
  End If
End If 
End Function 
'获取签名字符
Function getSecretKey(tokenType)
Dim str
If tokenType="before" Then 
str=secretKey&"&"
ElseIf tokenType="request" Then
str=secretKey&"&"&request_secret
Else
str=secretKey&"&"&oauth_secret
End If
'response.write str&"<br>" '---------------------------
getSecretKey=str
End Function 
'Dictionary排序	  
Function Sorts()
Dim Rs,strList,i
	Set Rs = Server.CreateObject ("adodb.recordset")
	Rs.Fields.Append "SortField", 200, 30 
	Rs.CursorType = 3 
	Rs.Open 
	aKeys = oDic.Keys
	aItems = oDic.Items
	For i=0 To oDic.Count-1
		Rs.AddNew "SortField", aKeys (i)	
	Next
	Rs.Update  
	Rs.Sort = "SortField" 
	Rs.MoveFirst 
	Dim arr()
	i=0
	Do While Not Rs.Eof 
	ReDim Preserve arr(i)
		arr(i)=Rs.Fields("SortField")&"="& rfcEncoding(oDic.item(Cstr(Rs.Fields("SortField"))))       
		Rs.MoveNext 
		i=i+1
	Loop  
	Sorts=join(arr,"&")
End Function 
'签权后整合提交字符
Function Signature(method, url, paramString, tokenType)
Dim stringToSign,SignString
SignString=paramString
If InStr(tokenType,"pic=")>0 Then SignString=Replace(SignString,tokenType,"")
'Response.write paramString&"<br>" :response.end '-----------------
stringToSign = rfcEncoding(method)&"&"&rfcEncoding(url)&"&"&rfcEncoding(SignString)
'Response.write stringToSign&"<br>" :response.end '------------------------------------
Signature=paramString&"&oauth_signature="&rfcEncoding(b64_hmac_sha1(getSecretKey(tokenType), stringToSign))
End Function 
'发送数据
Function doRequest(verb, resLoc, getData, objData, multi)
Dim aUrl,xmlhttp
	If(getData <>"") then getData = "?"&getData
	aUrl = resLoc & getData		
	'Response.write aUrl
	Set xmlhttp=Server.CreateObject("MSXML2.ServerXMLHTTP")
	xmlhttp.Open verb,aUrl,false		
	If(verb = "POST") Then
	If(multi) Then '如果是图片
	 Else   
	   xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
	End  If 
	End  If	
	xmlhttp.send(objData)		
	doRequest=xmlhttp.responseText
	'Response.Write(doRequest) '----------------------------
	Set xmlhttp=Nothing
End Function 

Function getStr(str)
Dim arr1,arr2()
arr1=Split(str,"&")
If ubound(arr1)=4 Then
Redim arr2(2)
arr2(0)=Split(arr1(1),"=")(1)
arr2(1)=Split(arr1(2),"=")(1)
arr2(2)=Split(arr1(3),"=")(1)
Else
Redim arr2(1)
arr2(0)=Split(arr1(0),"=")(1)
arr2(1)=Split(arr1(1),"=")(1)
End If
getStr=arr2
End Function 

Function getRequestToken()
Dim url,method
oDic.Add "oauth_callback",callback
url="http://openapi.qzone.qq.com/oauth/qzoneoauth_request_token"
method="GET"
getRequestToken=getStr(doRequest(method, url, Signature(method,url,Sorts,"before"), null, false))
End Function 

Function getAuthorizeURL(token) 
  getAuthorizeURL= "http://openapi.qzone.qq.com/oauth/qzoneoauth_authorize?oauth_consumer_key="&apiKey&"&oauth_token="&token(0)&"&oauth_callback="&callback
End Function

Function getAccessToken (verifier) 
Dim url,method
oDic.Add "oauth_vericode",verifier
url="http://openapi.qzone.qq.com/oauth/qzoneoauth_access_token"
method="GET"
getAccessToken=getStr(doRequest(method, url, Signature(method,url,Sorts,"request"), null, false))
End Function
 
Function  getUserInfo(token)
Dim url,method
oDic.Add "openid",token(2)
url="http://openapi.qzone.qq.com/user/get_user_info"
method="GET"
Set getUserInfo=toObj(doRequest(method, url, Signature(method,url,Sorts,method), null, false))
End Function 
End Class
%>
<script language="javascript" runat="server">
var hexcase=0;var b64pad="=";var chrsz=8;function hex_sha1(s){return binb2hex(core_sha1(str2binb(s),s.length*chrsz))}function b64_sha1(s){return binb2b64(core_sha1(str2binb(s),s.length*chrsz))}function str_sha1(s){return binb2str(core_sha1(str2binb(s),s.length*chrsz))}function hex_hmac_sha1(key,data){return binb2hex(core_hmac_sha1(key,data))}function b64_hmac_sha1(key,data){return binb2b64(core_hmac_sha1(key,data))}function str_hmac_sha1(key,data){return binb2str(core_hmac_sha1(key,data))}function core_sha1(x,len){x[len>>5]|=0x80<<(24-len%32);x[((len+64>>9)<<4)+15]=len;var w=Array(80);var a=1732584193;var b=-271733879;var c=-1732584194;var d=271733878;var e=-1009589776;for(var i=0;i<x.length;i+=16){var olda=a;var oldb=b;var oldc=c;var oldd=d;var olde=e;for(var j=0;j<80;j++){if(j<16)w[j]=x[i+j];else w[j]=rol(w[j-3]^w[j-8]^w[j-14]^w[j-16],1);var t=safe_add(safe_add(rol(a,5),sha1_ft(j,b,c,d)),safe_add(safe_add(e,w[j]),sha1_kt(j)));e=d;d=c;c=rol(b,30);b=a;a=t}a=safe_add(a,olda);b=safe_add(b,oldb);c=safe_add(c,oldc);d=safe_add(d,oldd);e=safe_add(e,olde)}return Array(a,b,c,d,e)}function sha1_ft(t,b,c,d){if(t<20)return(b&c)|((~b)&d);if(t<40)return b^c^d;if(t<60)return(b&c)|(b&d)|(c&d);return b^c^d}function sha1_kt(t){return(t<20)?1518500249:(t<40)?1859775393:(t<60)?-1894007588:-899497514}function core_hmac_sha1(key,data){var bkey=str2binb(key);if(bkey.length>16)bkey=core_sha1(bkey,key.length*chrsz);var ipad=Array(16),opad=Array(16);for(var i=0;i<16;i++){ipad[i]=bkey[i]^0x36363636;opad[i]=bkey[i]^0x5C5C5C5C}var hash=core_sha1(ipad.concat(str2binb(data)),512+data.length*chrsz);return core_sha1(opad.concat(hash),512+160)}function safe_add(x,y){var lsw=(x&0xFFFF)+(y&0xFFFF);var msw=(x>>16)+(y>>16)+(lsw>>16);return(msw<<16)|(lsw&0xFFFF)}function rol(num,cnt){return(num<<cnt)|(num>>>(32-cnt))}function str2binb(str){var bin=Array();var mask=(1<<chrsz)-1;for(var i=0;i<str.length*chrsz;i+=chrsz)bin[i>>5]|=(str.charCodeAt(i/chrsz)&mask)<<(32-chrsz-i%32);return bin}function binb2str(bin){var str="";var mask=(1<<chrsz)-1;for(var i=0;i<bin.length*32;i+=chrsz)str+=String.fromCharCode((bin[i>>5]>>>(32-chrsz-i%32))&mask);return str}function binb2hex(binarray){var hex_tab=hexcase?"0123456789ABCDEF":"0123456789abcdef";var str="";for(var i=0;i<binarray.length*4;i++){str+=hex_tab.charAt((binarray[i>>2]>>((3-i%4)*8+4))&0xF)+hex_tab.charAt((binarray[i>>2]>>((3-i%4)*8))&0xF)}return str}function binb2b64(binarray){var tab="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";var str="";for(var i=0;i<binarray.length*4;i+=3){var triplet=(((binarray[i>>2]>>8*(3-i%4))&0xFF)<<16)|(((binarray[i+1>>2]>>8*(3-(i+1)%4))&0xFF)<<8)|((binarray[i+2>>2]>>8*(3-(i+2)%4))&0xFF);for(var j=0;j<4;j++){if(i*8+j*6>binarray.length*32)str+=b64pad;else str+=tab.charAt((triplet>>6*(3-j))&0x3F)}}return str}function rfcEncoding(str){var tmp=encodeURIComponent(str);tmp=tmp.replace('!','%21');tmp=tmp.replace('*','%2A');tmp=tmp.replace('(','%28');tmp=tmp.replace(')','%29');tmp=tmp.replace("'",'%27');return tmp;}function rfcDecoding(s){if(s!=null){s=s.replace(/\+/g," ");}return decodeURIComponent(s);}function toObj(json){eval("var o="+json);return o;}
</script>