Office 2010中的VBA套接字连接

时间:2011-12-29 16:25:13

标签: windows sockets vba windows-7 visio

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

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

其他想法
我发现Visio here的一些非常有用的VBA内容让我相信应该是一个新的解决方案。


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

3 个答案:

答案 0 :(得分:3)

简答
wsock32.dll

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

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

答案 1 :(得分:0)

我以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 :(得分:0)

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