兄弟，我太懂你在VB6里搞CAD/CAM以太网通信的糟心了——WinSock控件死死绑定Windows消息循环，要是你的软件在非UI线程或者需要严格同步的场景下用，那简直是灾难。别愁，我给你一套纯Winsock API的实现方案，完全不依赖消息循环，直接在VB6里跑，还附上手写的代码片段，你直接抄改就行。

WinSock控件依赖消息循环是因为它用了异步回调机制，而我们直接调用底层API的同步阻塞方法，所有操作（连接、发送、接收）都会等待完成后再继续执行，完全不需要处理WM_SOCKET消息，完美避开消息循环依赖。

第一步：声明所需的Winsock API和常量 #

先在VB6模块里加这些声明（注意是标准模块，不是窗体模块）：

' Winsock基础API
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Integer, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal sock_type As Long, ByVal protocol As Long) As Long
Private Declare Function connect Lib "wsock32.dll" (ByVal s As Long, name As sockaddr_in, ByVal namelen As Long) As Long
Private Declare Function send Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal len As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal len As Long, ByVal flags As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Integer) As Integer

' 辅助结构和常量
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Long
    iMaxUdpDg As Long
    lpVendorInfo As Long
End Type

Private Type sockaddr_in
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Const AF_INET = 2
Const SOCK_STREAM = 1
Const IPPROTO_TCP = 6
Const INVALID_SOCKET = -1
Const SOCKET_ERROR = -1

第二步：实现完整的同步通信函数 #

写一个封装好的函数，输入服务器IP、端口、要发送的数据，返回服务器响应：

Function SyncEthernetComm(serverIP As String, port As Integer, sendData As String) As String
    Dim wsaData As WSADATA
    Dim sockHandle As Long
    Dim sockAddr As sockaddr_in
    Dim sendBytes() As Byte
    Dim bytesSent As Long
    Dim recvBuffer As String * 1024
    Dim bytesReceived As Long
    Dim response As String
    Dim timeout As Long
    
    ' 1. 初始化Winsock库
    If WSAStartup(&H101, wsaData) <> 0 Then
        Err.Raise vbObjectError + 1000, , "Winsock初始化失败，错误码：" & WSAGetLastError()
        Exit Function
    End If
    
    ' 2. 创建TCP套接字
    sockHandle = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    If sockHandle = INVALID_SOCKET Then
        Err.Raise vbObjectError + 1001, , "创建套接字失败，错误码：" & WSAGetLastError()
        GoTo Cleanup
    End If
    
    ' 3. 设置接收超时（可选，避免无限阻塞，这里设5秒）
    timeout = 5000 ' 毫秒
    setsockopt sockHandle, SOL_SOCKET, SO_RCVTIMEO, timeout, Len(timeout)
    
    ' 4. 填充服务器地址结构
    sockAddr.sin_family = AF_INET
    sockAddr.sin_port = htons(port) ' 转换为网络字节序
    sockAddr.sin_addr = inet_addr(serverIP) ' 字符串IP转长整型
    sockAddr.sin_zero = String(8, 0)
    
    ' 5. 连接服务器（阻塞直到连接成功/失败）
    If connect(sockHandle, sockAddr, Len(sockAddr)) = SOCKET_ERROR Then
        Err.Raise vbObjectError + 1002, , "连接服务器失败，错误码：" & WSAGetLastError()
        GoTo Cleanup
    End If
    
    ' 6. 发送数据（VB6字符串是Unicode，转成ANSI字节数组）
    sendBytes = StrConv(sendData, vbFromUnicode)
    bytesSent = send(sockHandle, sendBytes(0), UBound(sendBytes) + 1, 0)
    If bytesSent = SOCKET_ERROR Then
        Err.Raise vbObjectError + 1003, , "发送数据失败，错误码：" & WSAGetLastError()
        GoTo Cleanup
    End If
    
    ' 7. 接收响应（循环接收直到收到完整数据，这里以换行符为结束标志）
    response = ""
    Do
        bytesReceived = recv(sockHandle, recvBuffer, Len(recvBuffer), 0)
        If bytesReceived > 0 Then
            response = response & Left$(recvBuffer, bytesReceived)
            ' 根据你的通信协议判断是否接收完成，比如找换行符
            If InStr(response, vbCrLf) > 0 Then
                response = Left$(response, InStr(response, vbCrLf) - 1) ' 去掉换行符
                Exit Do
            End If
        ElseIf bytesReceived = 0 Then
            ' 服务器主动关闭连接
            Exit Do
        Else
            Err.Raise vbObjectError + 1004, , "接收数据失败，错误码：" & WSAGetLastError()
            GoTo Cleanup
        End If
    Loop
    
    ' 8. 返回响应
    SyncEthernetComm = StrConv(response, vbUnicode) ' 转成VB6 Unicode字符串
    
Cleanup:
    ' 清理资源
    If sockHandle <> INVALID_SOCKET Then closesocket sockHandle
    WSACleanup
End Function

' 补充超时设置的API声明（加到模块开头）
Private Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Const SOL_SOCKET = 65535
Const SO_RCVTIMEO = &H1006
Const SO_SNDTIMEO = &H1005

关键注意事项 #

• 线程阻塞问题：同步调用会卡住当前线程，如果在UI线程调用，软件会假死。建议把通信逻辑放到后台线程（比如VB6的ActiveX EXE多线程组件，或者用CreateThread API，但要注意VB6的线程安全——后台线程绝对不能访问UI控件）。
• 协议适配：代码里用换行符判断接收完成，你要根据自己的CAD/CAM设备通信协议修改（比如固定长度、特定结束符）。
• 编码调整：如果你的设备用UTF-8编码，就不能用vbFromUnicode，要自己写Unicode转UTF-8的函数。
• 错误处理：每个API调用都加了错误抛出，你可以根据实际需求改成日志记录或者弹窗提示。

调用示例 #

在窗体里直接调用就行：

Private Sub cmdSend_Click()
    Dim serverResponse As String
    On Error GoTo CommError
    
    serverResponse = SyncEthernetComm("192.168.1.100", 8080, "REQUEST_MACHINE_STATUS")
    MsgBox "设备响应：" & serverResponse
    Exit Sub
    
CommError:
    MsgBox "通信失败：" & Err.Description
End Sub

内容的提问来源于stack exchange，提问作者RS Conley