将 VB6 代码编组并转换为 .NET

发布于 2024-08-09 21:29:41 字数 14244 浏览 3 评论 0 原文

我在将一些代码从 VB6 转换为 VB.NET 时遇到问题(我对 .NET 没有太多经验)。当我在.NET 中运行“Select 函数(来自 WS2_32.dll 库)”时,使用与 VB6 程序相同的参数,它返回结果 -1(表示错误)。我认为该错误可能与我看到的有关编组的升级评论有关,但我不确定需要做什么来以不同的方式声明该函数。以下是我认为与该问题相关的代码(包括 Visual Studio 的升级警告):

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure FD_SET

   Dim fd_count As Integer
   <VBFixedArray(FD_SETSIZE)> Dim fd_array() As Integer
   Public Sub Initialize()
      ReDim fd_array(FD_SETSIZE)
   End Sub

End Structure



<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure TIMEVAL

   Dim tv_sec As Integer
   Dim tv_usec As Integer

End Structure



'UPGRADE_WARNING: Structure TIMEVAL may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

Private Declare Function bsd_select Lib "WS2_32.dll" Alias "select" (ByVal nfds As Integer, ByRef readfds As FD_SET,  ByRef writefds As FD_SET,  ByRef exceptfds As FD_SET,  ByRef timeout As TIMEVAL) As Integer


nResult = bsd_select(0, fdsRead, fdsWrite, fdsExcept, tvTimeout) 'the first parameter is ignored in Windows Sockets 2

这是整个程序的代码。提前致谢!

Option Strict Off
Option Explicit On

Imports System.Runtime.InteropServices

Module modTCPCommunicaiton

    'Constants used with Windows Sockets
    Private Const AF_INET As Integer = 2
    Private Const SOCK_STREAM As Integer = 1
    Private Const IPPROTO_TCP As Integer = 6
    Private Const FD_SETSIZE As Integer = 64
    Private Const SOCKET_ERROR As Integer = -1
    Private Const INVALID_SOCKET As Integer = -1

    'Constants used for clarity
    Private Const WS_VERSION_1_1 As Short = 257
    Private Const SOCKADDR_LEN As Integer = 16
    Private Const NO_FLAGS As Integer = 0
    Private Const MAX_REPLY_LEN As Integer = 3200

    'Define structures used with Windows Sockets
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure WSADATA
        Dim wVersion As Short
        Dim wHighVersion As Short
        'UPGRADE_WARNING: Fixed-length string size must fit in the buffer. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="3C1E4426-0B80-443E-B943-0627CD55D48B"'
        <VBFixedString(258), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=258)> Public szDescription() As Char
        'UPGRADE_WARNING: Fixed-length string size must fit in the buffer. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="3C1E4426-0B80-443E-B943-0627CD55D48B"'
        <VBFixedString(130), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=130)> Public szSystemStatus() As Char


        Dim iMaxSockets As Short
        Dim iMaxUdpDg As Short
        Dim lpVenderInfo As String
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure SOCKADDR_IN
        Dim sin_family As Short
        Dim sin_port As Short
        Dim sin_addr As Integer
        <VBFixedArray(8)> Dim sin_zero() As Byte 'this is just padding to make the whole structure size to be 16 bytes.

        Public Sub Initialize()
            ReDim sin_zero(8)
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure FD_SET
        Dim fd_count As Integer
        <VBFixedArray(FD_SETSIZE)> Dim fd_array() As Integer

        Public Sub Initialize()
            ReDim fd_array(FD_SETSIZE)
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure TIMEVAL
        Dim tv_sec As Integer
        Dim tv_usec As Integer
    End Structure

    'Declare imported Windows Sockets functions
    'UPGRADE_WARNING: Structure WSADATA may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function WSAStartup Lib "WS2_32.dll" (ByVal wVersionRequested As Short, <[In](), Out()> ByRef lpWSAData As WSADATA) As Integer
    Private Declare Function WSACleanup Lib "WS2_32.dll" () As Integer
    Private Declare Function WSAGetLastError Lib "WS2_32.dll" () As Integer
    Private Declare Function inet_addr Lib "WS2_32.dll" (ByVal szIPv4 As String) As Integer
    Private Declare Function htons Lib "WS2_32.dll" (ByVal short_int As Short) As Short
    Private Declare Function socket Lib "WS2_32.dll" (ByVal af As Integer, ByVal sock_type As Integer, ByVal protocol As Integer) As Integer
    'UPGRADE_WARNING: Structure SOCKADDR_IN may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function connect Lib "WS2_32.dll" (ByVal s As Integer, <[In](), Out()> ByRef name As SOCKADDR_IN, ByVal namelen As Integer) As Integer
    Private Declare Function send Lib "WS2_32.dll" (ByVal s As Integer, ByVal buf As String, ByVal length As Integer, ByVal flags As Integer) As Integer
    'Have to rename the "select" function due to conflict with reserved word in VB
    'UPGRADE_WARNING: Structure TIMEVAL may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function bsd_select Lib "WS2_32.dll" Alias "select" (ByVal nfds As Integer, <[In](), Out()> ByRef readfds As FD_SET, <[In](), Out()> ByRef writefds As FD_SET, <[In](), Out()> ByRef exceptfds As FD_SET, <[In]()> ByRef timeout As TIMEVAL) As Integer
    Private Declare Function recv Lib "WS2_32.dll" (ByVal s As Integer, ByVal buf As String, ByVal length As Integer, ByVal flags As Integer) As Integer
    Private Declare Function closesocket Lib "WS2_32.dll" (ByVal s As Integer) As Integer

    'Variables used in this module
    Dim hSock As Integer
    Dim nResult As Integer
    Dim fs As New Scripting.FileSystemObject 'Requires reference to "Microsoft Scripting Runtime" (system32\scrrun.dll)
    Dim fileOut As Scripting.TextStream

    Public Sub Main()
        'This code provides a simple example of TCP communication to a SAFER DAS.
        'After initializing and connecting to the DAS, several requests will be
        'sent and the results logged to a text file.  When finished, the notepad
        'file will be opened.  Users may modify this sample however they like.

        'Initialize and attempt to connect to SAFER DAS
        If Not SC_Init() Then
            Exit Sub
        End If

        'We are now connected and ready to transact data with the DAS.
        'The subroutine will take care of properly formatting the request string.
        Call SC_SendRequest("SI 1")
        'Call SC_SendRequest("SS 1")
        'Call SC_SendRequest("SA 1,1")
        'Call SC_SendRequest("SH 1,1")
        'Call SC_SendRequest("SM 1,1")
        'Call SC_SendRequest("SN 1,1")
        'Call SC_SendRequest("SP 1,1")
        'Call SC_SendRequest("SQ 1,1")

        'We're finished, so close down the socket connection
        Call SC_Close()

        'Open the output text file
        Call Shell("notepad.exe SAFER_com.txt", AppWinStyle.NormalFocus)

    End Sub

    Private Function SC_Init() As Boolean

        SC_Init = False

        'Prompt for IP address and port number to connect to
        Dim sIPAddr As String
        Dim sPort As String
        sIPAddr = "151.163.221.93"
        If sIPAddr = "" Then
            Exit Function
        End If
        sPort = "3000"
        If sPort = "" Then
            Exit Function
        End If

        'Get the output file ready
        On Error GoTo ErrorHandler
        fileOut = fs.CreateTextFile("SAFER_com.txt", True)

        'Initialize Windows Sockets 2
        Dim wsAttrib As WSADATA
        nResult = WSAStartup(WS_VERSION_1_1, wsAttrib)
        If Not nResult = 0 Then
            MsgBox("WSAStartup Error = " & nResult)
            fileOut.Close()
            Exit Function
        End If

        'Create a TCP socket
        hSock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
        If hSock = INVALID_SOCKET Then
            MsgBox("socket() Error = " & WSAGetLastError())
            nResult = WSACleanup()
            fileOut.Close()
            Exit Function
        End If

        'Prepare the address data structure
        Dim saAddress As New SOCKADDR_IN
        saAddress.Initialize()
        saAddress.sin_family = AF_INET
        saAddress.sin_port = htons(Val(sPort))
        saAddress.sin_addr = inet_addr(sIPAddr)

        'Try connecting to the server
        nResult = connect(hSock, saAddress, SOCKADDR_LEN)
        If nResult = SOCKET_ERROR Then
            MsgBox("connect() Error = " & WSAGetLastError())
            nResult = WSACleanup()
            fileOut.Close()
            Exit Function
        End If

        'Successfully connected to the server
        SC_Init = True
        Exit Function

ErrorHandler:
        MsgBox("Could not create output file.")

    End Function

    Private Sub SC_Close()

        'Send special close request to DAS (5 bytes to send)
        Dim sRequest As New VB6.FixedLengthString(15)
        sRequest.Value = Chr(1) & Chr(0) & Chr(0) & Chr(0) & Chr(0)
        nResult = send(hSock, sRequest.Value, 5, NO_FLAGS)

        'Close our socket and shutdown Windows Sockets 2
        nResult = closesocket(hSock)
        nResult = WSACleanup()
        fileOut.Close()

    End Sub

    Private Sub SC_SendRequest(ByRef sReq As String)

        'Test for valid request length
        If (Len(RTrim(sReq)) < 4) Or (Len(RTrim(sReq)) > 9) Then
            MsgBox("Request is not valid")
            Exit Sub
        End If

        'Format the request for sending to SAFER DAS by TCP port
        Dim sRequest As New VB6.FixedLengthString(15)
        sRequest.Value = Chr(0) & Chr(0) & Chr(0) & RTrim(sReq) & Chr(13) & Chr(0) & Chr(0)

        'Send the formatted request
        Dim nLen As Integer
        nLen = 6 + Len(RTrim(sReq)) 'Include the 6 extra format bytes in the length
        nResult = send(hSock, sRequest.Value, nLen, NO_FLAGS)
        fileOut.WriteLine((sReq))
        fileOut.WriteBlankLines((1))

        'NOTE: When using the recv() function in blocking mode (default), it may wait forever
        'for the other side to send some data.  This can be problematic for your application.
        'The select() function can be used to watch for the reply data to arrive with a timeout.
        'If data has still not arrived after a generous timeout expires, it probably never will.
        'In that case, the whole socket connection may be suspect and you might want to close it
        'and start over.

        'Prepare data structures for use with select() function
        Dim fdsWrite, fdsRead, fdsExcept As New FD_SET
        fdsWrite.Initialize()
        fdsRead.Initialize()
        fdsExcept.Initialize()

        Dim tvTimeout As TIMEVAL
        fdsRead.fd_count = 1 'how many sockets to check for incoming data
        fdsRead.fd_array(0) = hSock 'which sockets to check
        fdsWrite.fd_count = 0
        fdsExcept.fd_count = 0
        tvTimeout.tv_sec = 5 '5-second timeout
        tvTimeout.tv_usec = 0

        'Wait up to timeout for data to arrive from SAFER DAS
        'System.Threading.Thread.Sleep(5000)
        nResult = bsd_select(0, fdsRead, fdsWrite, fdsExcept, tvTimeout) 'the first parameter is ignored in Windows Sockets 2


        Dim sReply As New VB6.FixedLengthString(MAX_REPLY_LEN)
        Dim sData As String
        If nResult = 1 Then
            'select() reports that some data has arrived for 1 socket (our only socket)
            nLen = recv(hSock, sReply.Value, MAX_REPLY_LEN, NO_FLAGS)
            'nLen = recv(1001, sReply.Value, MAX_REPLY_LEN, NO_FLAGS)

            'Get the length of just the SAFER data by excluding the first 3 wrapper bytes,
            'the <LF> end delimiter, and the last 2 wrapper bytes.
            nLen = nLen - 6

            'Extract the SAFER data packet from the reply string, skipping over the first 3 wrapper bytes
            sData = Mid(sReply.Value, 4, nLen)
            fileOut.WriteLine((sData))
            fileOut.WriteBlankLines((1))

        ElseIf nResult = 0 Then
            'select() timed out
            MsgBox("Timed out waiting for reply" & nResult)
            fileOut.WriteLine(("Timed out waiting for reply" & nResult))
            fileOut.WriteBlankLines((1))
        Else
            'Some other error occurred
            MsgBox("select() Error = " & WSAGetLastError())
            fileOut.WriteLine(("select() Error = " & WSAGetLastError()))
            fileOut.WriteBlankLines((1))
        End If

    End Sub
End Module

I am having trouble converting some code from VB6 to VB.NET (I don't have as much experience with .NET). When I run the 'Select function (from the WS2_32.dll library) in .NET, using the same parameters as the VB6 program, it returns a result of -1 (indicating an error). I think the error may be related to an upgrade comment I saw about marshalling, but I was not sure what I needed to do to declare the function differently. Here is the code that I believe is related to the problem (including the upgrade warnings from Visual Studios):

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure FD_SET

   Dim fd_count As Integer
   <VBFixedArray(FD_SETSIZE)> Dim fd_array() As Integer
   Public Sub Initialize()
      ReDim fd_array(FD_SETSIZE)
   End Sub

End Structure



<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure TIMEVAL

   Dim tv_sec As Integer
   Dim tv_usec As Integer

End Structure



'UPGRADE_WARNING: Structure TIMEVAL may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. 

Private Declare Function bsd_select Lib "WS2_32.dll" Alias "select" (ByVal nfds As Integer, ByRef readfds As FD_SET,  ByRef writefds As FD_SET,  ByRef exceptfds As FD_SET,  ByRef timeout As TIMEVAL) As Integer


nResult = bsd_select(0, fdsRead, fdsWrite, fdsExcept, tvTimeout) 'the first parameter is ignored in Windows Sockets 2

Here is the code for the entire program. Thanks in advance!

Option Strict Off
Option Explicit On

Imports System.Runtime.InteropServices

Module modTCPCommunicaiton

    'Constants used with Windows Sockets
    Private Const AF_INET As Integer = 2
    Private Const SOCK_STREAM As Integer = 1
    Private Const IPPROTO_TCP As Integer = 6
    Private Const FD_SETSIZE As Integer = 64
    Private Const SOCKET_ERROR As Integer = -1
    Private Const INVALID_SOCKET As Integer = -1

    'Constants used for clarity
    Private Const WS_VERSION_1_1 As Short = 257
    Private Const SOCKADDR_LEN As Integer = 16
    Private Const NO_FLAGS As Integer = 0
    Private Const MAX_REPLY_LEN As Integer = 3200

    'Define structures used with Windows Sockets
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure WSADATA
        Dim wVersion As Short
        Dim wHighVersion As Short
        'UPGRADE_WARNING: Fixed-length string size must fit in the buffer. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="3C1E4426-0B80-443E-B943-0627CD55D48B"'
        <VBFixedString(258), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=258)> Public szDescription() As Char
        'UPGRADE_WARNING: Fixed-length string size must fit in the buffer. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="3C1E4426-0B80-443E-B943-0627CD55D48B"'
        <VBFixedString(130), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=130)> Public szSystemStatus() As Char


        Dim iMaxSockets As Short
        Dim iMaxUdpDg As Short
        Dim lpVenderInfo As String
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure SOCKADDR_IN
        Dim sin_family As Short
        Dim sin_port As Short
        Dim sin_addr As Integer
        <VBFixedArray(8)> Dim sin_zero() As Byte 'this is just padding to make the whole structure size to be 16 bytes.

        Public Sub Initialize()
            ReDim sin_zero(8)
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure FD_SET
        Dim fd_count As Integer
        <VBFixedArray(FD_SETSIZE)> Dim fd_array() As Integer

        Public Sub Initialize()
            ReDim fd_array(FD_SETSIZE)
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> Private Structure TIMEVAL
        Dim tv_sec As Integer
        Dim tv_usec As Integer
    End Structure

    'Declare imported Windows Sockets functions
    'UPGRADE_WARNING: Structure WSADATA may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function WSAStartup Lib "WS2_32.dll" (ByVal wVersionRequested As Short, <[In](), Out()> ByRef lpWSAData As WSADATA) As Integer
    Private Declare Function WSACleanup Lib "WS2_32.dll" () As Integer
    Private Declare Function WSAGetLastError Lib "WS2_32.dll" () As Integer
    Private Declare Function inet_addr Lib "WS2_32.dll" (ByVal szIPv4 As String) As Integer
    Private Declare Function htons Lib "WS2_32.dll" (ByVal short_int As Short) As Short
    Private Declare Function socket Lib "WS2_32.dll" (ByVal af As Integer, ByVal sock_type As Integer, ByVal protocol As Integer) As Integer
    'UPGRADE_WARNING: Structure SOCKADDR_IN may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function connect Lib "WS2_32.dll" (ByVal s As Integer, <[In](), Out()> ByRef name As SOCKADDR_IN, ByVal namelen As Integer) As Integer
    Private Declare Function send Lib "WS2_32.dll" (ByVal s As Integer, ByVal buf As String, ByVal length As Integer, ByVal flags As Integer) As Integer
    'Have to rename the "select" function due to conflict with reserved word in VB
    'UPGRADE_WARNING: Structure TIMEVAL may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    'UPGRADE_WARNING: Structure FD_SET may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="C429C3A5-5D47-4CD9-8F51-74A1616405DC"'
    Private Declare Function bsd_select Lib "WS2_32.dll" Alias "select" (ByVal nfds As Integer, <[In](), Out()> ByRef readfds As FD_SET, <[In](), Out()> ByRef writefds As FD_SET, <[In](), Out()> ByRef exceptfds As FD_SET, <[In]()> ByRef timeout As TIMEVAL) As Integer
    Private Declare Function recv Lib "WS2_32.dll" (ByVal s As Integer, ByVal buf As String, ByVal length As Integer, ByVal flags As Integer) As Integer
    Private Declare Function closesocket Lib "WS2_32.dll" (ByVal s As Integer) As Integer

    'Variables used in this module
    Dim hSock As Integer
    Dim nResult As Integer
    Dim fs As New Scripting.FileSystemObject 'Requires reference to "Microsoft Scripting Runtime" (system32\scrrun.dll)
    Dim fileOut As Scripting.TextStream

    Public Sub Main()
        'This code provides a simple example of TCP communication to a SAFER DAS.
        'After initializing and connecting to the DAS, several requests will be
        'sent and the results logged to a text file.  When finished, the notepad
        'file will be opened.  Users may modify this sample however they like.

        'Initialize and attempt to connect to SAFER DAS
        If Not SC_Init() Then
            Exit Sub
        End If

        'We are now connected and ready to transact data with the DAS.
        'The subroutine will take care of properly formatting the request string.
        Call SC_SendRequest("SI 1")
        'Call SC_SendRequest("SS 1")
        'Call SC_SendRequest("SA 1,1")
        'Call SC_SendRequest("SH 1,1")
        'Call SC_SendRequest("SM 1,1")
        'Call SC_SendRequest("SN 1,1")
        'Call SC_SendRequest("SP 1,1")
        'Call SC_SendRequest("SQ 1,1")

        'We're finished, so close down the socket connection
        Call SC_Close()

        'Open the output text file
        Call Shell("notepad.exe SAFER_com.txt", AppWinStyle.NormalFocus)

    End Sub

    Private Function SC_Init() As Boolean

        SC_Init = False

        'Prompt for IP address and port number to connect to
        Dim sIPAddr As String
        Dim sPort As String
        sIPAddr = "151.163.221.93"
        If sIPAddr = "" Then
            Exit Function
        End If
        sPort = "3000"
        If sPort = "" Then
            Exit Function
        End If

        'Get the output file ready
        On Error GoTo ErrorHandler
        fileOut = fs.CreateTextFile("SAFER_com.txt", True)

        'Initialize Windows Sockets 2
        Dim wsAttrib As WSADATA
        nResult = WSAStartup(WS_VERSION_1_1, wsAttrib)
        If Not nResult = 0 Then
            MsgBox("WSAStartup Error = " & nResult)
            fileOut.Close()
            Exit Function
        End If

        'Create a TCP socket
        hSock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
        If hSock = INVALID_SOCKET Then
            MsgBox("socket() Error = " & WSAGetLastError())
            nResult = WSACleanup()
            fileOut.Close()
            Exit Function
        End If

        'Prepare the address data structure
        Dim saAddress As New SOCKADDR_IN
        saAddress.Initialize()
        saAddress.sin_family = AF_INET
        saAddress.sin_port = htons(Val(sPort))
        saAddress.sin_addr = inet_addr(sIPAddr)

        'Try connecting to the server
        nResult = connect(hSock, saAddress, SOCKADDR_LEN)
        If nResult = SOCKET_ERROR Then
            MsgBox("connect() Error = " & WSAGetLastError())
            nResult = WSACleanup()
            fileOut.Close()
            Exit Function
        End If

        'Successfully connected to the server
        SC_Init = True
        Exit Function

ErrorHandler:
        MsgBox("Could not create output file.")

    End Function

    Private Sub SC_Close()

        'Send special close request to DAS (5 bytes to send)
        Dim sRequest As New VB6.FixedLengthString(15)
        sRequest.Value = Chr(1) & Chr(0) & Chr(0) & Chr(0) & Chr(0)
        nResult = send(hSock, sRequest.Value, 5, NO_FLAGS)

        'Close our socket and shutdown Windows Sockets 2
        nResult = closesocket(hSock)
        nResult = WSACleanup()
        fileOut.Close()

    End Sub

    Private Sub SC_SendRequest(ByRef sReq As String)

        'Test for valid request length
        If (Len(RTrim(sReq)) < 4) Or (Len(RTrim(sReq)) > 9) Then
            MsgBox("Request is not valid")
            Exit Sub
        End If

        'Format the request for sending to SAFER DAS by TCP port
        Dim sRequest As New VB6.FixedLengthString(15)
        sRequest.Value = Chr(0) & Chr(0) & Chr(0) & RTrim(sReq) & Chr(13) & Chr(0) & Chr(0)

        'Send the formatted request
        Dim nLen As Integer
        nLen = 6 + Len(RTrim(sReq)) 'Include the 6 extra format bytes in the length
        nResult = send(hSock, sRequest.Value, nLen, NO_FLAGS)
        fileOut.WriteLine((sReq))
        fileOut.WriteBlankLines((1))

        'NOTE: When using the recv() function in blocking mode (default), it may wait forever
        'for the other side to send some data.  This can be problematic for your application.
        'The select() function can be used to watch for the reply data to arrive with a timeout.
        'If data has still not arrived after a generous timeout expires, it probably never will.
        'In that case, the whole socket connection may be suspect and you might want to close it
        'and start over.

        'Prepare data structures for use with select() function
        Dim fdsWrite, fdsRead, fdsExcept As New FD_SET
        fdsWrite.Initialize()
        fdsRead.Initialize()
        fdsExcept.Initialize()

        Dim tvTimeout As TIMEVAL
        fdsRead.fd_count = 1 'how many sockets to check for incoming data
        fdsRead.fd_array(0) = hSock 'which sockets to check
        fdsWrite.fd_count = 0
        fdsExcept.fd_count = 0
        tvTimeout.tv_sec = 5 '5-second timeout
        tvTimeout.tv_usec = 0

        'Wait up to timeout for data to arrive from SAFER DAS
        'System.Threading.Thread.Sleep(5000)
        nResult = bsd_select(0, fdsRead, fdsWrite, fdsExcept, tvTimeout) 'the first parameter is ignored in Windows Sockets 2


        Dim sReply As New VB6.FixedLengthString(MAX_REPLY_LEN)
        Dim sData As String
        If nResult = 1 Then
            'select() reports that some data has arrived for 1 socket (our only socket)
            nLen = recv(hSock, sReply.Value, MAX_REPLY_LEN, NO_FLAGS)
            'nLen = recv(1001, sReply.Value, MAX_REPLY_LEN, NO_FLAGS)

            'Get the length of just the SAFER data by excluding the first 3 wrapper bytes,
            'the <LF> end delimiter, and the last 2 wrapper bytes.
            nLen = nLen - 6

            'Extract the SAFER data packet from the reply string, skipping over the first 3 wrapper bytes
            sData = Mid(sReply.Value, 4, nLen)
            fileOut.WriteLine((sData))
            fileOut.WriteBlankLines((1))

        ElseIf nResult = 0 Then
            'select() timed out
            MsgBox("Timed out waiting for reply" & nResult)
            fileOut.WriteLine(("Timed out waiting for reply" & nResult))
            fileOut.WriteBlankLines((1))
        Else
            'Some other error occurred
            MsgBox("select() Error = " & WSAGetLastError())
            fileOut.WriteLine(("select() Error = " & WSAGetLastError()))
            fileOut.WriteBlankLines((1))
        End If

    End Sub
End Module

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

酒与心事 2024-08-16 21:29:41

尝试对您收到警告的参数设置属性 MarshalAs(UnmanagedType.LPStruct)>。应该有帮助。

另外,恕我直言,如果您尽快使用 System.Net.Socket 类重写代码会更好。它将更加简短、简单和健壮。

Try to set attribute MarshalAs(UnmanagedType.LPStruct)> on arguments you've received warnings about. It should help.

Also, IMHO it will be better if you rewrite your code using System.Net.Socket class ASAP. It will be much more short, simple and robust.

满身野味 2024-08-16 21:29:41

本例中的问题在于结构体​​ WSADATA 的定义;我使用了报告的WSAData64结构这里 因为我在 64 位系统下并且它在没有改变任何东西的情况下工作。

我在这里报告 32 位和 64 位结构,以防链接随着时间的推移而失效:

Private Structure WSAData32
    Public Version As UShort
    Public HighestVersion As UShort
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> _
    Public Description As String
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> _
    Public SystemStatus As String
    Public MaxSockets As UShort
    Public MaxUdpDatagramSize As UShort
    Public VendorInfoPointer As IntPtr
End Structure

Private Structure WSAData64
    Public Version As UShort
    Public HighestVersion As UShort
    Public MaxSockets As UShort
    Public MaxUdpDatagramSize As UShort
    Public VendorInfoPointer As IntPtr
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> _
    Public Description As String
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> _
    Public SystemStatus As String
End Structure

顺便说一句:不能使用任何新库,因为我处于遗留维护项目中,我必须更改尽可能少的代码。

The problem in this case is the definition of the structure WSADATA; I used the WSAData64 structure reported here as I am under a 64 bit system and it worked without changing anything.

I am reporting the 32 bit and 64 bit structures here in case the link dies over time:

Private Structure WSAData32
    Public Version As UShort
    Public HighestVersion As UShort
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> _
    Public Description As String
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> _
    Public SystemStatus As String
    Public MaxSockets As UShort
    Public MaxUdpDatagramSize As UShort
    Public VendorInfoPointer As IntPtr
End Structure

Private Structure WSAData64
    Public Version As UShort
    Public HighestVersion As UShort
    Public MaxSockets As UShort
    Public MaxUdpDatagramSize As UShort
    Public VendorInfoPointer As IntPtr
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=257)> _
    Public Description As String
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=129)> _
    Public SystemStatus As String
End Structure

BTW: cannot use any new library as I am in a legacy maintenance project where I must change as less code as possible.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文