一个Winsock组件

80酷酷网    80kuku.com

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

分享到
  • 微信分享
  • 新浪微博
  • QQ好友
  • QQ空间
点击: