ASP获取QQ是否在线—绝对能用【经典】

以前用来验证QQ是否在线的ASP代码，因为腾迅改版而不能用了，下面的是最新的保证可以用的代码，是个最基础的代码，具体应用的时候请自己更改。

<%
Function asp_isnull(str)
 if len(str)=0 or isnull(str) or str="" then
  asp_isnull=true
 else
  asp_isnull=false
 end if
end Function

'转换编码
Function BytesToBstr(Body, Cset)
   Dim Objstream
   Set Objstream = server.CreateObject("adodb.stream")
   Objstream.Type = 1
   Objstream.Mode = 3
   Objstream.Open
   Objstream.Write Body
   Objstream.Position = 0
   Objstream.Type = 2
   Objstream.Charset = Cset
   BytesToBstr = Objstream.ReadText
   Objstream.Close
   Set Objstream = Nothing
End Function

'获取网页源码
Function GetHttpPage(HttpUrl,CharsetCode)
 If IsNull(HttpUrl) = True Or Len(HttpUrl) < 18 Or HttpUrl = "Error" Then
   GetHttpPage = "Error"
   Exit Function
 End If
 Dim Http
 Set Http = server.CreateObject("MSXML2.ServerXMLHTTP")
 Http.Open "GET", HttpUrl, False
 on error resume next
 Http.Send
 If Http.Readystate <> 4 Then
 If Http.Status<>200 then
   Set Http = Nothing
   GetHttpPage = "Error"
   Exit Function
 End If
 End If
 GetHttpPage = BytesToBstr(Http.ResponseBody, CharsetCode)
 Set Http = Nothing
 If Err.Number <> 0 Then
   Err.Clear
 End If
End Function

dim qq
qq=request("qq")
if asp_isnull(qq) then
   response.write "请输qq号"
    response.end()
else
  dim qqstate
  qqstate=GetHttpPage("http://webpresence.qq.com/getonline?Type=1&"+qq&":","GB2312")
  qqstate=mid(qqstate,instr(qqstate,"=")+1,1)
  if qqstate="1" then 
     response.write "在线"
  else
    resposne.write "不在线"
  end if
end if
%>