中国DOS联盟

On Error Resume Next
QQ = InputBox("输入QQ号码(数字):", "输入")
Set x = CreateObject("Msxml2.XMLHTTP")
If Err.Number <> 0 Then
        Set x = CreateObject("Microsoft.XMLHTTP")
        Err.Clear
End If
x.Open "GET", "http://webpresence.qq.com/getonline?Type=1&" & QQ & ":", False
x.Send
r = x.responseText
r = r & "0=0"
r = Left(Split(r, "=")(1), 1)
If isNumeric(r) And r <> 0 Then
        r = "在线"
Else
        r = "隐身或者不在线"
End If
MsgBox "QQ " & QQ & " " & r, 4160, "状态"