一个Winsock组件

我自己写了一个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

原文转自：http://www.ltesting.net