一个WINSOCK组件
类别: ASP教程
我自己写了一个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
-------------------------------------
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
-= 资 源 教 程 =-
文 章 搜 索