VB + Winsock + CGI 实现 QQ (OICQ) 在线检测(支持代理服务器)!标准 EXE 例程下载http://microinfo.top263.net/Zip/WskQQExe.zip
'请先 "引用" -> "浏览" -> "Windows 目录/SYSTEM/MSWINSCK.OCX"Option ExplicitDim sResponse As StringDim WithEvents WinsockX As MSWinsockLib.WinsockDim WithEvents WinsockListenX As MSWinsockLib.WinsockPrivate Sub Check1_Click()Text2.Enabled = VBA.IIf(Check1.Value = vbChecked, True, False)Text3.Enabled = Text2.EnabledEnd SubPrivate Sub Check2_Click()If Check2.Value = vbChecked Then Text4.Enabled = False WinsockListenX.Protocol = sckTCPProtocol WinsockListenX.LocalPort = CInt(Text4.Text) WinsockListenX.ListenElse Text4.Enabled = True If WinsockX.State <> sckClosed Then WinsockX.Close End If If WinsockListenX.State <> sckClosed Then WinsockListenX.Close End IfEnd IfEnd SubPrivate Sub Command1_Click()sResponse = ""Command1.Enabled = FalseMe.MousePointer = vbHourglassDim i As LongIf WinsockX.State <> sckClosed Then WinsockX.CloseEnd IfWinsockX.Protocol = sckTCPProtocolIf Check1.Value = vbChecked Then WinsockX.Connect Trim(Text2.Text), CInt(Text3.Text)Else WinsockX.Connect "search.tencent.com", 80End IfDo 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 IfLoopWinsockX.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 SubPrivate Sub Form_Load()Text1.Text = "6881818"Text2.Text = "192.168.0.1"Text3.Text = "8080"Text4.Text = "80"Set WinsockX = New MSWinsockLib.WinsockSet WinsockListenX = New MSWinsockLib.WinsockCheck1_ClickCheck2_ClickEnd SubPrivate Sub WinsockListenX_ConnectionRequest(ByVal requestID As Long)If WinsockX.State <> sckClosed Then WinsockX.CloseEnd IfWinsockX.Accept requestIDEnd SubPrivate Sub WinsockX_Close()Command1.Enabled = TrueMe.MousePointer = vbDefaultIf 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!"ElseIf sResponse Like "*http://img.tencent.com/face/*-1.gif*" Then MsgBox "Hide!"End IfEnd SubPrivate Sub WinsockX_DataArrival(ByVal bytesTotal As Long)Dim s As StringWinsockX.GetData s, vbStringIf Check2.Value = vbChecked Then MsgBox sEnd IfsResponse = sResponse & sEnd Sub
ActiveX DLL 例程下载:http://microinfo.top263.net/Zip/WskQQDll.zip
