qq_online.asp

超级留言簿（dxxo） 本留言参考了网上很多留言簿改进而来

<%
rem 用于取得QQ的URL
Function GetURL(url) 
       on error resume next
Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
With Retrieval 
.Open "GET", url, False, "", "" 
.Send 
GetURL = .ResponseText 
End With 
Set Retrieval = Nothing 
if err.number<>0 then err.clear
End Function
%>
<%
function qq_online(qq)
if qq<>"" then
on error resume next
Dim T,Start,Length,QQURL 
T=GetURL("http://search.tencent.com/cgi-bin/friend/oicq_find?oicq_no="&qq&"") 
Start=Instr(1,T,"ShowResult("+chr(34)) 
Start=Instr(Start,T,"http://") 
Length=Instr(Start,T,chr(34)+","+chr(34))-Start 
QQURL=Mid(T,Start,Length)
response.write "<a href=http://search.tencent.com/cgi-bin/friend/user_show_info?ln="&qq&" target=_blank title=QQ:"&qq&"><img src="&QQURL&" width=16 height=16 border=0></a>"
'response.write "<a href=http://search.tencent.com/cgi-bin/friend/user_show_info?ln="&qq&" target=_blank title=QQ:"&qq&"><img src=image/oicq.gif width=16 height=16 border=0></a>"
if err.number<>0 then err.clear
else
response.write "<img src=image/oicq.gif width=16 height=16>"
end if
end function
%>