[原创]检测阿里旺旺用户是否在线
Option Explicit'===========================================================================
'//功能:检测阿里旺旺用户是否在线
'//用法:MsgBox AliWangOnLine("阿里旺旺ID了") True在线 False不在线
'//作者:countrygril@qq.com村姑 转载请注名出处! http://hi.baidu.com/countrygril/
'===========================================================================
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoA" (ByVal sUrlName As String, lpCacheEntryInfo As Any, lpdwCacheEntryInfoBufferSize As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Function AliWangOnLine(ByVal sUserNameID As String) As Boolean
Dim strID As String
strID = "http://amos1.taobao.com/muliuserstatus.aw?beginnum=0&site=cntaobao&uids=" & sUserNameID
Call DeleteCacheURL(strID)
If InStr(GetHTML(strID), "1") <> 0 Then
AliWangOnLine = True
Else
AliWangOnLine = False
End If
End Function
Private Function InCache(ByVal URL As String) As Boolean
If GetUrlCacheEntryInfo(URL, ByVal 0&, 0) = 0 Then
InCache = (Err.LastDllError = 122)
End If
End Function
Private Sub DeleteCacheURL(ByVal URL As String)
If (InCache(URL)) Then
DeleteUrlCacheEntry URL
End If
End Sub
Private Function GetHTML(sURL) As String
Dim XMLHTTP As Object, ReturnType As String
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
If Not IsObject(XMLHTTP) Then
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
If Not IsObject(XMLHTTP) Then Exit Function
End If
XMLHTTP.Open "GET", sURL, True
XMLHTTP.Send
Do While XMLHTTP.readystate <> 4
DoEvents
Loop
GetHTML = StrConv(XMLHTTP.ResponseBody, vbUnicode)
End Function
--------------------编程问答--------------------
虽然没试过
补充:VB , 资源