netbios.bas

一个很好的TCP和UDP端口控制的例子！稍加改动

    If nRet <> NRC_GOODRET Then
        MsgBox "ERROR: Netbios: AddGroupName: " & localNcb.ncb_retcode
        AddGroupName = localNcb.ncb_retcode
    Else
        num = localNcb.ncb_num
        AddGroupName = NRC_GOODRET
    End If

End Function

'
' Function: Send
'
' Description:
'    Send len bytes from the data buffer on the given session (lsn)
'    and lana number. This function performs a synchronous send.
'
Function Send(ByVal lana As Long, ByVal lsn As Long, ByVal dataPtr As Long, ByVal dlen As Long) As Long
    Dim localNcb As NCB
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBSEND
    localNcb.ncb_buffer = dataPtr
    localNcb.ncb_length = dlen
    localNcb.ncb_lana_num = lana
    localNcb.ncb_lsn = lsn
    Send = Netbios(localNcb)
End Function

'
' Function: Recv
'
' Description:
'    Receive up to len bytes into the data buffer on the given session
'    (lsn) and lana number.
'
Function Recv(ByVal lana As Long, ByVal lsn As Long, ByVal dataPtr As Long, ByRef dlen As Long) As Long
    Dim localNcb As NCB
    Dim nRet As Long
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = ncbRecv
    localNcb.ncb_buffer = dataPtr
    localNcb.ncb_length = dlen
    localNcb.ncb_lana_num = lana
    localNcb.ncb_lsn = lsn
    nRet = Netbios(localNcb)
    If nRet <> NRC_GOODRET Then
        dlen = -1
        Recv = localNcb.ncb_retcode
    Else
        dlen = localNcb.ncb_length
        Recv = NRC_GOODRET
    End If
End Function

'
' Function: Hangup
'
' Description:
'    Disconnect the given session on the given lana number.
'
Function Hangup(ByVal lana As Long, ByVal lsn As Long) As Long
    Dim localNcb As NCB
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBHANGUP
    localNcb.ncb_lsn = lsn
    localNcb.ncb_lana_num = lana
    Hangup = Netbios(localNcb)

End Function

'
' Function: Cancel
'
' Description:
'    Cancel the given asynchronous command denoted in the NCB
'    structure parameter.
'
Function Cancel(pncb As NCB) As Long
    Dim localNcb As NCB
    Dim nRet As Long
    
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBCANCEL
    localNcb.ncb_buffer = VarPtr(pncb)
    localNcb.ncb_lana_num = pncb.ncb_lana_num
    
    nRet = Netbios(localNcb)
    
    If nRet <> NRC_GOODRET Then
        MsgBox "ERROR: Netbios: NCBCANCEL: " & localNcb.ncb_retcode
        Cancel = localNcb.ncb_retcode
    Else
        Cancel = NRC_GOODRET
    End If
End Function

'
' Function: Connect
'
' Description:
'    Post an asyncrhonous connect on the given LANA number to server.
'    The NCB structure passed in already has the ncb_event field set
'    to a valid Windows event handle. Just fill in the blanks and make
'    the call.
'
Function Connect(pncb As NCB, ByVal lana As Long, ByVal server As String, ByVal client As String) As Long
    Dim nRet As Long
    
    pncb.ncb_command = NCBCALL Or ASYNCH
    pncb.ncb_lana_num = lana
    
    
    Dim i As Long, j As Long
    For i = 0 To NCBNAMSZ - 1
        pncb.ncb_callname(i) = Asc(" ")
        pncb.ncb_name(i) = Asc(" ")
    Next
    If Len(client) < NCBNAMSZ - 1 Then
        j = Len(client)
    Else
        j = NCBNAMSZ - 1
    End If
    For i = 0 To j - 1
        pncb.ncb_name(i) = Asc(Mid(client, i + 1, 1))
    Next
    If Len(server) < NCBNAMSZ - 1 Then
        j = Len(server)
    Else
        j = NCBNAMSZ - 1
    End If
    For i = 0 To j - 1
        pncb.ncb_callname(i) = Asc(Mid(server, i + 1, 1))
    Next
    
    nRet = Netbios(pncb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBCONNECT failed: " & pncb.ncb_retcode
        Connect = pncb.ncb_retcode
    Else
        Connect = NRC_GOODRET
    End If

End Function

'
' Function: Listen
'
' Description:
'    Post an asynchronous listen. The NCB structure passed into this function
'    should either have a callback or an event set within the structure.
'
Function Listen(pncb As NCB, ByVal lana As Long, ByVal name As String) As Long
    Dim nRet As Long
    
    pncb.ncb_command = NCBLISTEN Or ASYNCH
    pncb.ncb_lana_num = lana
    
    
    Dim i As Long, j As Long
    For i = 0 To NCBNAMSZ - 1
        pncb.ncb_callname(i) = Asc(" ")
        pncb.ncb_name(i) = Asc(" ")
    Next
    If Len(name) < NCBNAMSZ - 1 Then
        j = Len(name)
    Else
        j = NCBNAMSZ - 1
    End If
    For i = 0 To j - 1
        pncb.ncb_name(i) = Asc(Mid(name, i + 1, 1))
    Next
    
    pncb.ncb_callname(0) = Asc("*")
    
    nRet = Netbios(pncb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBLISTEN failed: " & pncb.ncb_retcode
        Listen = pncb.ncb_retcode
    Else
        Listen = NRC_GOODRET
    End If

End Function

'
' Function: DatagramSend
'
' Description:
'    Send a directed datagram to the specified recipient on the
'    specified LANA number from the given name number to the
'    specified recipient. Also specified is the data buffer and
'    the number of bytes to send.
'
Function DatagramSend(ByVal lana As Long, ByVal num As Long, ByVal recipient As String, ByVal buffer As Long, ByRef buflen As Long) As Long
    Dim localNcb As NCB
    Dim nRet As Long
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBDGSEND
    localNcb.ncb_lana_num = lana
    localNcb.ncb_num = num
    localNcb.ncb_buffer = buffer
    localNcb.ncb_length = buflen
    
    Dim i As Long, j As Long
    For i = 0 To NCBNAMSZ - 1
        localNcb.ncb_callname(i) = Asc(" ")
    Next
    If Len(recipient) < NCBNAMSZ - 1 Then
        j = Len(recipient)
    Else
        j = NCBNAMSZ - 1
    End If
    For i = 0 To j - 1
        localNcb.ncb_callname(i) = Asc(Mid(recipient, i + 1, 1))
    Next
    
    nRet = Netbios(localNcb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBDGSEND failed: " & localNcb.ncb_retcode
        DatagramSend = localNcb.ncb_retcode
    Else
        DatagramSend = NRC_GOODRET
    End If
End Function

'
' Function: DatagramSendBC
'
' Description:
'    Send a broadcast datagram on the specified LANA number from the
'    given name number.  Also specified is the data buffer and number
'    of bytes to send.
'
Function DatagramSendBC(ByVal lana As Long, ByVal num As Long, ByVal buffer As Long, ByRef buflen As Long) As Long
    Dim localNcb As NCB
    Dim nRet As Long
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBDGSENDBC
    localNcb.ncb_lana_num = lana
    localNcb.ncb_num = num
    localNcb.ncb_buffer = buffer
    localNcb.ncb_length = buflen
    
    
    nRet = Netbios(localNcb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBDGSENDBC failed: " & localNcb.ncb_retcode
        DatagramSendBC = localNcb.ncb_retcode
    Else
        DatagramSendBC = NRC_GOODRET
    End If
End Function

'
' Function: DatagramRecv
'
' Description:
'    Receive a datagram on the given LANA number directed towards the
'    name represented by num.  Data is copied into the supplied buffer.
'    If hEvent is not zero then the receive call is made asynchronously
'    with the supplied event handle. If num is 0xFF then listen for a
'    datagram destined for any NetBIOS name registered by the process.
'
Function DatagramRecv(pncb As NCB, ByVal lana As Long, ByVal num As Long, ByVal buffer As Long, ByRef buflen As Long, ByVal hEvent As Long) As Long
    Dim nRet As Long
    ZeroMemory pncb, Len(pncb)
    
    If hEvent <> 0 Then
        pncb.ncb_command = NCBDGRECV Or ASYNCH
        pncb.ncb_event = hEvent
    Else
        pncb.ncb_command = NCBDGRECV
    End If
    
    pncb.ncb_lana_num = lana
    pncb.ncb_num = num
    pncb.ncb_buffer = buffer
    pncb.ncb_length = buflen
    
    
    nRet = Netbios(pncb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBDGRECV failed: " & pncb.ncb_retcode
        DatagramRecv = pncb.ncb_retcode
    Else
        DatagramRecv = NRC_GOODRET
    End If
End Function

'
' Function: DatagramRecvBC
'
' Description:
'    Receive a broadcast datagram on the given LANA number.
'    Data is copied into the supplied buffer.  If hEvent is not zero
'    then the receive call is made asynchronously with the supplied
'    event handle.
'
Function DatagramRecvBC(pncb As NCB, ByVal lana As Long, ByVal num As Long, ByVal buffer As Long, ByRef buflen As Long, ByVal hEvent As Long) As Long
    Dim nRet As Long
    ZeroMemory pncb, Len(pncb)
    
    If hEvent <> 0 Then
        pncb.ncb_command = NCBDGRECVBC Or ASYNCH
        pncb.ncb_event = hEvent
    Else
        pncb.ncb_command = NCBDGRECV
    End If
    
    pncb.ncb_lana_num = lana
    pncb.ncb_num = num
    pncb.ncb_buffer = buffer
    pncb.ncb_length = buflen
    
    
    nRet = Netbios(pncb)
    If nRet <> NRC_GOODRET Then
        Debug.Print "Netbios: NCBDGRECVBC failed: " & pncb.ncb_retcode
        DatagramRecvBC = pncb.ncb_retcode
    Else
        DatagramRecvBC = NRC_GOODRET
    End If
End Function

'
' Function: FormatNetbiosName
'
' Description:
'    Format the given NetBIOS name so it is printable.  Any unprintable
'    characters are replaced by a period.  The outname buffer is
'    the returned string which is assumed to be at least NCBNAMSZ+1
'    characters in length.
'
Function FormatNetbiosName(nbname() As Byte, ByRef outname As String) As Long
    Dim i As Long
    i = 0
    outname = ""
    Do While (nbname(i) <> 0)
        If nbname(i) = Asc(" ") Then
            Exit Do
        End If
        outname = outname & Chr(nbname(i))
        i = i + 1
        If i = 16 Then
            Exit Do
        End If
         
    Loop
    FormatNetbiosName = NRC_GOODRET
    
End Function