b + winsock + cgi 实现 qq (oicq) 在线检测(支持代理服务器)!
标准 exe 例程下载
http://microinfo.top263.net/zip/wskqqexe.zip
'请先 "引用" -> "浏览" -> "windows 目录\system\mswinsck.ocx"
option explicit
dim sresponse as string
dim withevents winsockx as mswinsocklib.winsock
dim withevents winsocklistenx as mswinsocklib.winsock
private sub check1_click()
text2.enabled = vba.iif(check1.value = vbchecked, true, false)
text3.enabled = text2.enabled
end sub
private sub check2_click()
if check2.value = vbchecked then
text4.enabled = false
winsocklistenx.protocol = scktcpprotocol
winsocklistenx.localport = cint(text4.text)
winsocklistenx.listen
else
text4.enabled = true
if winsockx.state <> sckclosed then
winsockx.close
end if
if winsocklistenx.state <> sckclosed then
winsocklistenx.close
end if
end if
end sub
private sub command1_click()
sresponse = ""
command1.enabled = false
me.mousepointer = vbhourglass
dim i as long
if winsockx.state <> sckclosed then
winsockx.close
end if
winsockx.protocol = scktcpprotocol
if check1.value = vbchecked then
winsockx.connect trim(text2.text), cint(text3.text)
else
winsockx.connect "search.tencent.com", 80
end if
do until winsockx.state = sckconnected
doevents
i = i + 1
if i > 50000 then
if vba.msgbox("timeout,retry?", vbquestion + vbyesno) = vbyes then
i = 0
else
command1.enabled = true
me.mousepointer = vbdefault
exit sub
end if
end if
loop
winsockx.senddata "post " & vba.iif(check1.value = vbchecked, "http://search.tencent.com", "") & "/cgi-bin/friend/oicq_find http/1.1" & vbcrlf _
& "accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*" & vbcrlf _
& "accept -language: zh -cn" & vbcrlf _
& "content-type: application/x-www-form-urlencoded" & vbcrlf _
& "accept -encoding: gzip , deflate" & vbcrlf _
& "user-agent: mozilla/4.0 (compatible; msie 5.5; windows 98; win 9x 4.90)" & vbcrlf _
& "host: " & winsockx.remotehost & vbcrlf _
& "content-length: " & vba.len(vba.trim("oicq_no=" & vba.trim(text1.text) & "&mov=0&begnum=0")) & vbcrlf _
& "connection: keep -alive" & vbcrlf _
& "cookie: 3wave=1" & vbcrlf & vbcrlf _
& "oicq_no=" & vba.trim(text1.text) & "&mov=0&begnum=0"
end sub
private sub form_load()
text1.text = "6881818"
text2.text = "192.168.0.1"
text3.text = "8080"
text4.text = "80"
set winsockx = new mswinsocklib.winsock
set winsocklistenx = new mswinsocklib.winsock
check1_click
check2_click
end sub
private sub winsocklistenx_connectionrequest(byval requestid as long)
if winsockx.state <> sckclosed then
winsockx.close
end if
winsockx.accept requestid
end sub
private sub winsockx_close()
command1.enabled = true
me.mousepointer = vbdefault
if sresponse like "*http://img.tencent.com/face/*-3.gif*" then
msgbox "off line!"
elseif sresponse like "*http://img.tencent.com/face/*-2.gif*" then
msgbox "on line!"
