【问题标题】:VBA socket connection in Office 2010Office 2010 中的 VBA 套接字连接
【发布时间】:2019-11-12 18:02:46
【问题描述】:

小问题
是否有一个库应该替换用于在 VBA 应用程序中创建和维护套接字连接的 mswinsoc.osx?

背景
我正在尝试在 Visio 2010 Professional 文档中创建套接字连接。我找到了一种在 Windows 7 here 上注册 mswinsoc.osx 的方法,但这似乎很奇怪,微软会摆脱一个库来建立套接字连接而没有(更好的)替换它。更让我担心的是,几乎没有使用 Office 2010 的 Winsoc 库的示例。我支持旧文档,因此 Winsoc 不是必需的;这只是我知道会起作用的壁橱。

其他想法
我为 Visio here 找到了一些非常有用的 VBA 内容,这让我相信应该有一个新的解决方案。


Office 2010 的任何套接字连接示例或对 mswinsoc.osx 发生的情况的了解都会有很大帮助。

【问题讨论】:

    标签: windows sockets vba windows-7 visio


    【解决方案1】:

    我做了vba登录客户端(ws2_32.dll)例子

    它可能工作正常(我测试过。)

    Tested Screen Image Here

    ServerMain.c

    #undef UNICODE
    
    #define WIN32_LEAN_AND_MEAN
    
    #include <windows.h>
    #include <winsock2.h>
    #include <ws2tcpip.h>
    #include <stdlib.h>
    #include <stdio.h>
    
    // Need to link with Ws2_32.lib
    #pragma comment (lib, "Ws2_32.lib")
    
    #define DEFAULT_BUFLEN 512
    #define DEFAULT_PORT "16001"
    
    static char LoginCheck(char * recvbuf);
    
    int main(void)
    {
        WSADATA wsaData;
        int iResult;
    
        SOCKET ListenSocket = INVALID_SOCKET;
        SOCKET ClientSocket = INVALID_SOCKET;
    
        struct addrinfo *result = NULL;
        struct addrinfo hints;
    
        int iSendResult;
        char recvbuf[DEFAULT_BUFLEN];
        int recvbuflen = DEFAULT_BUFLEN;
    
        char sendbuf[DEFAULT_BUFLEN];
        int sendbuflen = DEFAULT_BUFLEN;
    
        printf("Excel Login Server Start..\n");
    
        // Initialize Winsock
        iResult = WSAStartup(MAKEWORD(2, 2), &wsaData);
        if (iResult != 0) {
            printf("WSAStartup failed with error: %d\n", iResult);
            return 1;
        }
    
        ZeroMemory(&hints, sizeof(hints));
        hints.ai_family = AF_INET;
        hints.ai_socktype = SOCK_STREAM;
        hints.ai_protocol = IPPROTO_TCP;
        hints.ai_flags = AI_PASSIVE;
    
        // Resolve the server address and port
        iResult = getaddrinfo(NULL, DEFAULT_PORT, &hints, &result);
        if (iResult != 0) {
            printf("getaddrinfo failed with error: %d\n", iResult);
            WSACleanup();
            return 1;
        }
    
        // Create a SOCKET for connecting to server
        ListenSocket = socket(result->ai_family, result->ai_socktype, result->ai_protocol);
        if (ListenSocket == INVALID_SOCKET) {
            printf("socket failed with error: %ld\n", WSAGetLastError());
            freeaddrinfo(result);
            WSACleanup();
            return 1;
        }
    
        // Setup the TCP listening socket
        iResult = bind(ListenSocket, result->ai_addr, (int)result->ai_addrlen);
        if (iResult == SOCKET_ERROR) {
            printf("bind failed with error: %d\n", WSAGetLastError());
            freeaddrinfo(result);
            closesocket(ListenSocket);
            WSACleanup();
            return 1;
        }
    
        freeaddrinfo(result);
    
        iResult = listen(ListenSocket, SOMAXCONN);
        if (iResult == SOCKET_ERROR) {
            printf("listen failed with error: %d\n", WSAGetLastError());
            closesocket(ListenSocket);
            WSACleanup();
            return 1;
        }
    
        printf("Server Is running at port %s\n", DEFAULT_PORT);
    
        while(1) {
            // Accept a client socket
            ClientSocket = accept(ListenSocket, NULL, NULL);
            if (ClientSocket == INVALID_SOCKET) {
                printf("accept failed with error: %d\n", WSAGetLastError());
                //closesocket(ListenSocket);
                //WSACleanup();
                //return 1;
            }
    
            // recieve data from client
            iResult = recv(ClientSocket, recvbuf, recvbuflen, 0);
            if (iResult > 0) {
                printf("Bytes received: %d\n", iResult);
                recvbuf[iResult] = '\0';
                printf("Recieved string : %s\n", recvbuf);
    
                // id, pw check
                sendbuf[0] = LoginCheck(recvbuf); //success code
                sendbuf[1] = '\0';
    
                // Echo the buffer back to the sender
                iSendResult = send(ClientSocket, sendbuf, 1, 0);
                if (iSendResult == SOCKET_ERROR) {
                    printf("send failed with error: %d\n", WSAGetLastError());
                    //closesocket(ClientSocket);
                    //WSACleanup();
                    //return 1;
                }
                printf("Bytes sent: %d\n", iSendResult);
            }
            else if (iResult == 0)
                printf("Connection closing...\n");
            else {
                printf("recv failed with error: %d\n", WSAGetLastError());
                //closesocket(ClientSocket);
                //WSACleanup();
                //return 1;
            }
    
            Sleep(10);
        }
    
        // No longer need server socket
        closesocket(ListenSocket);
    
        // shutdown the connection since we're done
        iResult = shutdown(ClientSocket, SD_SEND);
        if (iResult == SOCKET_ERROR) {
            printf("shutdown failed with error: %d\n", WSAGetLastError());
            closesocket(ClientSocket);
            WSACleanup();
            return 1;
        }
    
        // cleanup
        closesocket(ClientSocket);
        WSACleanup();
    
        return 0;
    }
    
    // check if login info correct (input : "id"|"pw")
    static char LoginCheck(char * recvbuf)
    {
        char *id, *pw;
        if (!recvbuf | !recvbuf[0])
            return 0;
    
        // temp id, pw info (later, may use db info)
        id = strtok(recvbuf, "|");
        if (!id) 
            return 0;
    
        if (strcmp(id, "testid"))
            return 0;
    
        pw = strtok(NULL, "|");
        if (!pw)
            return 0;
    
        if (strcmp(pw, "testpw"))
            return 0;
    
        return 's'; //success
    }
    

    Server.vb

    '
    ' reference site https://stackoverflow.com/questions/49028281/vba-with-winsock2-send-sends-wrong-data
    ' edited by robotmanya (2018.10.28) (https://blog.naver.com/monkey5255/221386590654)
    
    ' Constants ----------------------------------------------------------
    Const ip = "127.0.0.1"
    Const port = "16001"
    
    Const INVALID_SOCKET = -1
    Const WSADESCRIPTION_LEN = 256
    Const SOCKET_ERROR = -1
    Const SD_SEND = 1
    
    ' Typ definitions ----------------------------------------------------
    Private Type WSADATA
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To WSADESCRIPTION_LEN) As Byte
        szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpVendorInfo As Long
    End Type
    
    Private Type ADDRINFO
        ai_flags As Long
        ai_family As Long
        ai_socktype As Long
        ai_protocol As Long
        ai_addrlen As Long
        ai_canonName As LongPtr 'strptr
        ai_addr As LongPtr 'p sockaddr
        ai_next As LongPtr 'p addrinfo
    End Type
    
    
    ' Enums ---------------------------------------------------------------
    Enum AF
        AF_UNSPEC = 0
        AF_INET = 2
        AF_IPX = 6
        AF_APPLETALK = 16
        AF_NETBIOS = 17
        AF_INET6 = 23
        AF_IRDA = 26
        AF_BTH = 32
    End Enum
    
    Enum sock_type
        SOCK_STREAM = 1
        SOCK_DGRAM = 2
        SOCK_RAW = 3
        SOCK_RDM = 4
        SOCK_SEQPACKET = 5
    End Enum
    ' External functions --------------------------------------------------
    
    Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef data As WSADATA) As Long
    Public Declare Function connect Lib "ws2_32.dll" (ByVal socket As Long, ByVal SOCKADDR As Long, ByVal namelen As Long) As Long
    Public Declare Sub WSACleanup Lib "ws2_32.dll" ()
    Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String, ByVal ServName As String, ByVal lpHints As LongPtr, lpResult As LongPtr) As Long
    Public Declare Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
    Public Declare Function closesocket Lib "ws2_32.dll" (ByVal socket As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
    Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
    Public Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As Byte, ByVal buflen As Long, ByVal flags As Long) As Long
    Public Declare Function SendWithPtr Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal bufPtr As Long, ByVal buflen As Long, ByVal flags As Long) As Long
    Public Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
    Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
    Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As Long
    
    'Login Button Click Event
    Function Login(ID As String, pw As String)
        Dim m_wsaData As WSADATA
        Dim m_RetVal As Integer
        Dim m_Hints As ADDRINFO
        Dim m_ConnSocket As Long: m_ConnSocket = INVALID_SOCKET
        Dim pAddrInfo As LongPtr
        Dim RetVal As Long
        Dim lastError As Long
        Dim iRC As Long
        Dim MAX_BUF_SIZE As Integer: MAX_BUF_SIZE = 512
    
        Login = 0
    
        'Socket Settings
        RetVal = WSAStartup(MAKEWORD(2, 2), m_wsaData)
        If (RetVal <> 0) Then
            LogError "WSAStartup failed with error " & RetVal, WSAGetLastError()
            Call WSACleanup
            Exit Function
        End If
    
        m_Hints.ai_family = AF.AF_UNSPEC
        m_Hints.ai_socktype = sock_type.SOCK_STREAM
    
        RetVal = GetAddrInfo(ip, port, VarPtr(m_Hints), pAddrInfo)
        If (RetVal <> 0) Then
            LogError "Cannot resolve address " & ip & " and port " & port & ", error " & RetVal, WSAGetLastError()
            Call WSACleanup
            Exit Function
        End If
    
        m_Hints.ai_next = pAddrInfo
        Dim connected As Boolean: connected = False
        Do While m_Hints.ai_next > 0
            CopyMemory m_Hints, ByVal m_Hints.ai_next, LenB(m_Hints)
    
            m_ConnSocket = ws_socket(m_Hints.ai_family, m_Hints.ai_socktype, m_Hints.ai_protocol)
    
            If (m_ConnSocket = INVALID_SOCKET) Then
                LogError "Error opening socket, error " & RetVal
            Else
                Dim connectionResult As Long
    
                connectionResult = connect(m_ConnSocket, m_Hints.ai_addr, m_Hints.ai_addrlen)
    
                If connectionResult <> SOCKET_ERROR Then
                    connected = True
                    Exit Do
                End If
    
                LogError "connect() to socket failed"
                closesocket (m_ConnSocket)
            End If
        Loop
    
        If Not connected Then
            LogError "Fatal error: unable to connect to the server", WSAGetLastError()
            RetVal = closesocket(m_ConnSocket)
            Call WSACleanup
            Exit Function
        End If
    
        'After Socket Connected
        Dim SendBuf As String
        SendBuf = ID + "|" + pw
    
        'Send Login Data
        RetVal = Send(m_ConnSocket, SendBuf, Len(SendBuf), 0)
    
        If RetVal = SOCKET_ERROR Then
            LogError "send() failed", WSAGetLastError()
            RetVal = closesocket(m_ConnSocket)
            Call WSACleanup
            Exit Function
        Else
            Debug.Print "sent " & RetVal & " bytes"
        End If
    
        ' shutdown the connection since no more data will be sent
        RetVal = shutdown(m_ConnSocket, SD_SEND)
        If RetVal <> 0 Then
            LogError "send socket close failed", WSAGetLastError()
            RetVal = closesocket(m_ConnSocket)
            Call WSACleanup
        Else
            Debug.Print "send socket closed"
        End If
    
        'Recieve From Server (Login Success : 1, Fail : 0)
        Dim RecvBuf As Byte
        RetVal = Recv(m_ConnSocket, RecvBuf, MAX_BUF_SIZE, 0)
    
        If RetVal = SOCKET_ERROR Then
            LogError "recv() failed", WSAGetLastError()
            RetVal = closesocket(m_ConnSocket)
            Call WSACleanup
            Exit Function
        Else
            Debug.Print "recieved " & RetVal & " bytes"
        End If
    
        'Login Check (s : success(id,pw correspond, f : fail)
        If Left(Chr(RecvBuf), 1) = "s" Then
            Login = 1
        Else
            Login = 0
        End If
    
    
        RetVal = closesocket(m_ConnSocket)
        If RetVal <> 0 Then
        LogError "closesocket() failed", WSAGetLastError()
        Call WSACleanup
        Else
            Debug.Print "closed socket"
        End If
    End Function
    
    Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
        MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
    End Function
    
    Private Sub LogError(msg As String, Optional ErrorCode As Long = -1)
        If ErrorCode > -1 Then
            msg = msg & " (error code " & ErrorCode & ")"
        End If
    
        Debug.Print msg
    End Sub
    

    我认为这段代码解释了你所需要的一切。

    但如果你知道更详细的过程,

    我也在我的博客上发布了这个

    https://blog.naver.com/monkey5255/221386590654

    【讨论】:

      【解决方案2】:

      简答
      wsock32.dll

      其他信息
      我在 C 和 VB 中找到了一些使用此 DLL 的详细示例。
      Examples in C
      Examples in VB

      到目前为止,由于我的项目范围发生了变化,我还没有机会在 VBA 中运行任何示例。我改为使用 Python 通过COM 连接控制 Visio,取得了巨大成功。

      【讨论】:

        【解决方案3】:

        您可能想看看 Webxcel https://github.com/michaelneu/webxcel,这是一个用 Excel-Macros 编写的完整 REST-Backend。

        【讨论】:

          猜你喜欢
          • 1970-01-01
          • 2013-11-11
          • 1970-01-01
          • 2011-07-29
          • 1970-01-01
          • 2011-08-15
          • 1970-01-01
          • 1970-01-01
          • 1970-01-01
          相关资源
          最近更新 更多