当前位置:编程学习 > VB >>

[原创]检测阿里旺旺用户是否在线

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 ,  资源
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,