VB判断QQ是否在线

Private Sub Command1_Click()

    Dim strHtml$

    strHtml = getHtmlStr("http://219.133.49.157/getonline?81597651:")

    MsgBox IIf(InStr(strHtml, "1;") > 0, "在线", "不在线")

End Sub

 

Private Function getHtmlStr$(strUrl$)

    Dim XmlHttp

    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

    XmlHttp.Open "GET", strUrl, False

    XmlHttp.send

    getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)

    Set XmlHttp = Nothing

End Function