我自己写了一个Winsock组件，很简单，将带发送的报文发给指定IP的指定端口，并返回应答报文。技术粗糙, 请大家指教。附源码如下：
-------------------------------------
VERSION 1.0 CLASS
BEGIN
MultiUse = -1'True
Persistable = 0'NotPersistable
DataBindingBehavior = 0'vbNone
DataSourceBehavior= 0'vbNone
MTSTransactionMode= 0'NotAnMTSObject
END
Attribute VB_Name = "clsWinSockEm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'******************************************************************************
'
' clsWinSockEm.CLS
' 嵌入式WinSocket类
' 输入：服务器IP、服务器Port、待发送报文
' 输出：接收报文
'
'******************************************************************************
Option Explicit
'******************************************************************************
Const RECV_TIME_OUT = 60' 接收超时
Const SEND_TIME_OUT = 60' 发送超时
Const CONN_TIME_OUT = 120 ' 连接超时
Const RECV_MAX_LEN = 2048 ' 接收报文最大数
'******************************************************************************
Private WithEvents wskEm As MSWinsockLib.Winsock' WinSock Control
Attribute wskEm.VB_VarHelpID = -1
Private mstrServerIP As String' 远程服务器IP
Private mintServerPort As Integer ' 远程服务器端口
Private mstrTextToSend As String' 发送报文
Private mstrTextReceived As String' 接收报文
Private bConnected As Boolean ' 连接标志
'******************************************************************************
' 初始化
Public Sub Init(strServerIP As String, intServerPort As Integer)
mstrServerIP = strServerIP
mintServerPort = intServerPort
mstrTextToSend = ""
mstrTextReceived = ""
bConnected = False
End Sub
' 返回报文
Public Function ReturnText(strTextToSend As String) As String
Dim dtStart As Date
dtStart = Now
Set wskEm = New MSWinsockLib.Winsock
' 获取发送字符串
mstrTextToSend = strTextToSend
mstrTextToSend = mstrTextToSend & Chr(0)
ConnectServer
SendText
' 接收报文超时控制
Do Until Not (mstrTextReceived = "")
DoEvents
If DateDiff("s", dtStart, Now) > RECV_TIME_OUT Then
Err.Raise vbObjectError, "Socket错误", "通讯超时"
End If
Loop
wskEm.Close
Set wskEm = Nothing
ReturnText = mstrTextReceived
End Function
' 连接服务器
Private Sub ConnectServer()
Dim dtStart As Date
dtStart = Now()
wskEm.RemoteHost = mstrServerIP
wskEm.RemotePort = mintServerPort
wskEm.Connect
Do Until bConnected
DoEvents
If DateDiff("s", dtStart, Now) > CONN_TIME_OUT Then
Err.Raise vbObjectError, "Socket错误", "连接超时"
End If
Loop
End Sub
' 发送报文
Private Sub SendText()
Dim dtStart As Date
dtStart = Now()
wskEm.SendData mstrTextToSend ' 发送报文
'Do Until wskEm.State = sckClosed
'DoEvents
'If DateDiff("s", dtStart, Now) > 5 Then
'Err.Raise vbObjectError, "Socket错误", "发送请求超时"
'End If
'Loop
End Sub
' WinSock连接事件
Private Sub wskEm_Connect()
bConnected = True
End Sub
' WinSock数据到达事件
Private Sub wskEm_DataArrival(ByVal bytesTotal As Long)
wskEm.GetData mstrTextReceived, vbString, RECV_MAX_LEN
End Sub
关键词：一个Winsock组件