vbnetbios.bas

功能强大的API

' Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS,
' followed by an array of NAME_BUFFER structures.

Public ADAPTER_STATUS As ADAPTER_STATUS
Public PADAPTER_STATUS As ADAPTER_STATUS

Type NAME_BUFFER                        ' NCBNAMSZ = 16
    name_(0 To (NCBNAMSZ - 1)) As Byte  ' 16-bytes
    name_num As Byte                    '  1-byte
    name_flags As Byte                  '  1-byte
End Type                                ' 18-bytes total

' Values for name_flags bits

Public Const NAME_FLAGS_MASK = &H87
Public Const GROUP_NAME = &H80
Public Const UNIQUE_NAME = &H0
Public Const REGISTERING = &H0
Public Const DEREGISTERED = &H4
Public Const DUPLICATE = &H5
Public Const DUPLICATE_DEREG = &H7

Public NAME_BUFFER As NAME_BUFFER
Public PNAME_BUFFER As NAME_BUFFER

Type LANA_ENUM
    length As Byte                          '   1-byte (Number of valid entries in lana[]
    lana(0 To (MAX_LANA - 1)) As Byte       ' 256-bytes
End Type                                    ' 257-bytes total

' Command NCBENUM returns:

' On a system containing lana's 0,2 and 3, a structure with
' length=3, lan[0] = 0, lana[1] = 1 and lana[2] = 3 will be
' returned.

Public LANA_ENUM As LANA_ENUM
Public PLANA_ENUM As LANA_ENUM

Type NET_STATUS
    ADAPTER_STATUS As ADAPTER_STATUS                    ' 60-bytes for ADAPTER_STATUS
    NAME_BUFFER(0 To (NCBNAMSZ + 1)) As NAME_BUFFER     ' 18-bytes for NAME_BUFFER UDT
End Type                                                    ' 78-bytes total

Public NET_STATUS As NET_STATUS

Declare Function NetBios Lib "NetAPI32.dll" Alias "Netbios" (ByRef PNCB As NCB) As Long

' The following lines of code were modified by Jim Huff on May 18, 1998 to include
' the location of the VarPtr function call for those who are using vb5.0

' The following VarPtr function call is for vb5.
' Declare Function VarPtr Lib "MSVBVM50.DLL" (pVoid As Any) As Long

' The following VarPtr function call is for vb4.
Declare Function VarPtr Lib "VB40032.dll" (pVoid As Any) As Long
Function vbGetMacAddress(Adapter As Integer, HostName As String) As String

    If Adapter >= MAX_LANA Then
        MsgBox "ERROR:  Illegal lana has been designated.  Must be less than 254.", vbOKOnly, "vbNetBIOS.BAS Demo"
        vbGetMacAddress = ""
        Exit Function
    End If

    ' This function returns the MAC Address to the calling procedure when provided with
    ' the LanaEnum (Adapter) number.

    Dim lResult As Long
    Dim MACAddr As String
    Dim HexStringValue As String
    Dim i As Integer

    MACAddr = ""

    NCB.ncb_command = NCBENUM                   ' Enumerate lana numbers
    NCB.ncb_buffer = VarPtr(LANA_ENUM)
    NCB.ncb_length = LenB(LANA_ENUM)

    lResult = NetBios(NCB)
    DisplayError lResult

    Debug.Print "Enumerate lana Numbers Result: " & lResult

    NCB.ncb_command = NCBRESET                  ' Reset
    NCB.ncb_lana_num = LANA_ENUM.lana(Adapter)

    lResult = NetBios(NCB)
    DisplayError lResult

    NCB.ncb_command = NCBASTAT                  ' Adapter Status
    NCB.ncb_lana_num = LANA_ENUM.lana(Adapter)

    ' Use the following lines to identify a remote host

    NCB.ncb_callname = UCase(HostName) + Space(16 - Len(HostName))

    NCB.ncb_buffer = VarPtr(NET_STATUS)
    NCB.ncb_length = LenB(NET_STATUS)

    lResult = NetBios(NCB)
    DisplayError lResult

    Debug.Print "Adapter Status Result: " & lResult

    For i = 0 To 5

        HexStringValue = Hex(NET_STATUS.ADAPTER_STATUS.adapter_address(i))

        If NET_STATUS.ADAPTER_STATUS.adapter_address(i) < 16 Then HexStringValue = "0" & HexStringValue

        MACAddr = MACAddr + HexStringValue

        If i <> 5 Then MACAddr = MACAddr + "-"

    Next i

    vbGetMacAddress = MACAddr

End Function
Sub DisplayError(ResultCode As Long)

    Dim DispMsg As String

    Select Case ResultCode

        Case NRC_GOODRET    ' Good return (also returned when
            Exit Sub        ' ASYNCH request accepted)
        Case NRC_BUFLEN     ' Illegal Buffer Length
            DispMsg = "Illegal Buffer Length"
        Case NRC_ILLCMD         ' Illegal Command
            DispMsg = "Illegal Command"
        Case NRC_CMDTMO         ' Command Timed Out
            DispMsg = "Command Timed Out"
        Case NRC_INCOMP         ' Message Incomplete, Issue Another
                                ' Command
            DispMsg = "Message Incomplete.  Issue Another Command"
        Case NRC_BADDR          ' Illegal Buffer Address
            DispMsg = "Illegal Buffer Address"
        Case NRC_SNUMOUT        ' Session Number is Out Of Range
            DispMsg = "Session Number is Out of Range"
        Case NRC_NORES          ' No Resource Available
            DispMsg = "No Resources Available"
        Case NRC_SCLOSED        ' Session Closed
            DispMsg = "Session Closed"
        Case NRC_CMDCAN         ' Command Cancelled
            DispMsg = "Command Cancelled"
        Case NRC_DUPNAME        ' Duplicate Name
            DispMsg = "Duplicate Name"
        Case NRC_NAMTFUL        ' Name Table Full
            DispMsg = "Name Table Full"
        Case NRC_ACTSES         ' No Deletions, Name has Active
                                ' Sessions
            DispMsg = "No Deletions.  Name has Active Sessions"
        Case NRC_LOCTFUL        ' Local Session Table Full
            DispMsg = "Local Session Table Full"
        Case NRC_REMTFUL        ' Remote Session Table Full
            DispMsg = "Remote Session Table Full"
        Case NRC_ILLNN          ' Illegal Name Number
            DispMsg = "Illegal Name Number"
        Case NRC_NOCALL         ' No Call Name
            DispMsg = "No Call Name"
        Case NRC_NOWILD         ' Cannot Put in NCB_NAME
            DispMsg = "Cannot Put in NCB_NAME"
        Case NRC_INUSE          ' Name in Use on Remote Adapter
            DispMsg = "Name in Use on Remote Computer"
        Case NRC_NAMERR         ' Name Deleted
            DispMsg = "Name Deleted"
        Case NRC_SABORT         ' Session Ended Abnormally
            DispMsg = "Session Ended Abnormally"
        Case NRC_NAMCONF        ' Name Conflict Detected
            DispMsg = "Name Conflict Detected"
        Case NRC_IFBUSY         ' Interface Busy, IRET before
                                ' Retrying
            DispMsg = "Interface Busy.  IRET Before Retrying"
        Case NRC_TOOMANY        ' Too Many Commands outstanding,
                                ' Retry later
            DispMsg = "Too Many Commands Outstanding.  Retry Later"
        Case NRC_BRIDGE         ' ncb_lana_num field invalid
            DispMsg = "ncb_lana_num Field Invalid"
        Case NRC_CANOCCR        ' Command Completed While Cancel
                                ' Occurring
            DispMsg = "Command Completed While Cancel Occurring"
        Case NRC_CANCEL         ' Command Not Valid to Cancel
            DispMsg = "Command Not Valid to Cancel"
        Case NRC_DUPENV         ' Name Defined By Another Local
                                ' Process
            DispMsg = "Name Defined By Another Process"
        Case NRC_ENVNOTDEF      ' Environment Undefined. RESET
                                ' Required
            DispMsg = "Environment Undefined.  RESET Required"
        Case NRC_OSRESNOTAV     ' Required OS Resources Exhausted
            DispMsg = "Required OS Resources Exhausted"
        Case NRC_MAXAPPS        ' Max Number of Applications
                                ' Exceeded
            DispMsg = "Max Number Of Applications Exceeded"
        Case NRC_NOSAPS         ' No Saps Available for NetBIOS
            DispMsg = "No saps Available for NetBIOS"
        Case NRC_NORESOURCES    ' Requested Resources are Not
                                ' Available
            DispMsg = "Requested Resources are Not Available"
        Case NRC_INVADDRESS     ' Invalid NCB Address, or
                                ' Length > Segment
            DispMsg = "Invalid NCB Address, or Length > Segment"
        Case NRC_INVDDID        ' Invalid NCB DDID
            DispMsg = "Invalid NCB DDID"
        Case NRC_LOCKFAIL       ' Lock of User Area Failed
            DispMsg = "Lock of User Area Failed"
        Case NRC_OPENERR        ' NetBIOS Not Loaded
            DispMsg = "NetBIOS Not Loaded"
        Case NRC_SYSTEM         ' System Error
            DispMsg = "System Error"
        Case NRC_PENDING        ' Asynchronous Command is Not Yet
                                ' Completed
            DispMsg = "Asynchronous Command Is Not Yet Completed"

    End Select

    MsgBox "ERROR: " + CStr(ResultCode) + Chr$(13) + Chr$(10) + DispMsg, vbOKOnly, "vbNetBIOS.BAS Demo"

End Sub