netbios.bak

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

Function AddGroupName(ByVal lana As Long, ByVal name As String, ByRef num As Long) As Long
    Dim localNcb As NCB
    Dim nRet As Long
    ZeroMemory localNcb, Len(localNcb)
    localNcb.ncb_command = NCBADDGRNAME
    localNcb.ncb_lana_num = lana
    
    Dim i As Long, j As Long
    For i = 0 To NCBNAMSZ - 1
        localNcb.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
        localNcb.ncb_name(i) = Asc(Mid(name, i + 1, 1))
    Next
       
    nRet = Netbios(localNcb)
       
    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(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(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(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(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(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(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(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(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(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(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(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