bas/modEth.bas

   1 Attribute VB_Name = "modEth"
   2 Option Explicit
   3 '
   4 Public EthGateWay As String
   5 '
   6 Public Const MAX_HOSTNAME_LEN = 132
   7 Public Const MAX_DOMAIN_NAME_LEN = 132
   8 Public Const MAX_SCOPE_ID_LEN = 260
   9 Public Const MAX_ADAPTER_NAME_LENGTH = 260
  10 Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
  11 Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
  12 Public Const ERROR_BUFFER_OVERFLOW = 111
  13 Public Const MIB_IF_TYPE_ETHERNET = 1
  14 Public Const MIB_IF_TYPE_TOKENRING = 2
  15 Public Const MIB_IF_TYPE_FDDI = 3
  16 Public Const MIB_IF_TYPE_PPP = 4
  17 Public Const MIB_IF_TYPE_LOOPBACK = 5
  18 Public Const MIB_IF_TYPE_SLIP = 6
  19
  20 Type IP_ADDR_STRING
  21             Next As Long
  22             IpAddress As String * 16
  23             IpMask As String * 16
  24             Context As Long
  25 End Type
  26
  27 Type IP_ADAPTER_INFO
  28             Next As Long
  29             ComboIndex As Long
  30             AdapterName As String * MAX_ADAPTER_NAME_LENGTH
  31             Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
  32             AddressLength As Long
  33             Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
  34             Index As Long
  35             Type As Long
  36             DhcpEnabled As Long
  37             CurrentIpAddress As Long
  38             IpAddressList As IP_ADDR_STRING
  39             GatewayList As IP_ADDR_STRING
  40             DhcpServer As IP_ADDR_STRING
  41             HaveWins As Boolean
  42             PrimaryWinsServer As IP_ADDR_STRING
  43             SecondaryWinsServer As IP_ADDR_STRING
  44             LeaseObtained As Long
  45             LeaseExpires As Long
  46 End Type
  47
  48 Type FIXED_INFO
  49             HostName As String * MAX_HOSTNAME_LEN
  50             DomainName As String * MAX_DOMAIN_NAME_LEN
  51             CurrentDnsServer As Long
  52             DnsServerList As IP_ADDR_STRING
  53             NodeType As Long
  54             ScopeId  As String * MAX_SCOPE_ID_LEN
  55             EnableRouting As Long
  56             EnableProxy As Long
  57             EnableDns As Long
  58 End Type
  59
  60 Public Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
  61 Public Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
  62 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  63
  64 Sub EthInfo()
  65     Dim error As Long
  66     Dim FixedInfoSize As Long
  67     Dim AdapterInfoSize As Long
  68     Dim i As Integer
  69     Dim PhysicalAddress  As String
  70     Dim NewTime As Date
  71     Dim AdapterInfo As IP_ADAPTER_INFO
  72     Dim Adapt As IP_ADAPTER_INFO
  73     Dim AddrStr As IP_ADDR_STRING
  74     Dim FixedInfo As FIXED_INFO
  75     Dim Buffer As IP_ADDR_STRING
  76     Dim pAddrStr As Long
  77     Dim pAdapt As Long
  78     Dim Buffer2 As IP_ADAPTER_INFO
  79     Dim FixedInfoBuffer() As Byte
  80     Dim AdapterInfoBuffer() As Byte
  81     'Get the main IP configuration information for this machine using a FIXED_INFO structure
  82     FixedInfoSize = 0
  83     error = GetNetworkParams(ByVal 0&, FixedInfoSize)
  84
  85     If error <> 0 Then
  86         If error <> ERROR_BUFFER_OVERFLOW Then
  87 '            MsgBox "GetNetworkParams sizing failed with error " & error
  88             Exit Sub
  89         End If
  90     End If
  91
  92     ReDim FixedInfoBuffer(FixedInfoSize - 1)
  93     error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
  94
  95     If error = 0 Then
  96         CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
  97 '        MsgBox "Host Name:  " & FixedInfo.HostName
  98 '        MsgBox "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress
  99         pAddrStr = FixedInfo.DnsServerList.Next
 100
 101         Do While pAddrStr <> 0
 102             CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
 103 '            MsgBox "DNS Servers:  " & Buffer.IpAddress
 104             pAddrStr = Buffer.Next
 105         Loop
 106
 107 '        MsgBox "NetBIOS Scope ID:  " & FixedInfo.ScopeId
 108
 109         If FixedInfo.EnableRouting Then
 110 '            MsgBox "IP Routing Enabled "
 111         Else
 112 '            MsgBox "IP Routing not enabled"
 113         End If
 114
 115         If FixedInfo.EnableProxy Then
 116 '            MsgBox "WINS Proxy Enabled "
 117         Else
 118 '            MsgBox "WINS Proxy not Enabled "
 119         End If
 120
 121         If FixedInfo.EnableDns Then
 122 '            MsgBox "NetBIOS Resolution Uses DNS "
 123         Else
 124 '            MsgBox "NetBIOS Resolution Does not use DNS  "
 125         End If
 126
 127     Else
 128 '        MsgBox "GetNetworkParams failed with error " & error
 129         Exit Sub
 130     End If
 131
 132     'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
 133     'Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
 134     AdapterInfoSize = 0
 135     error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
 136
 137     If error <> 0 Then
 138         If error <> ERROR_BUFFER_OVERFLOW Then
 139  '           MsgBox "GetAdaptersInfo sizing failed with error " & error
 140             Exit Sub
 141         End If
 142     End If
 143
 144     ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
 145     ' Get actual adapter information
 146     error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
 147
 148     If error <> 0 Then
 149 '        MsgBox "GetAdaptersInfo failed with error " & error
 150         Exit Sub
 151     End If
 152
 153     CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
 154     pAdapt = AdapterInfo.Next
 155     CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
 156
 157 '    MsgBox " AdapterName: " & Buffer2.AdapterName
 158 '    MsgBox "AdapterDescription: " & Buffer2.Description
 159
 160     For i = 0 To Buffer2.AddressLength - 1
 161         PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
 162
 163         If i < Buffer2.AddressLength - 1 Then
 164             PhysicalAddress = PhysicalAddress & "-"
 165         End If
 166
 167     Next
 168
 169 '    MsgBox "Physical Address: " & PhysicalAddress
 170
 171     If Buffer2.DhcpEnabled Then
 172 '        MsgBox "DHCP Enabled "
 173     Else
 174 '        MsgBox "DHCP disabled"
 175     End If
 176
 177     pAddrStr = Buffer2.IpAddressList.Next
 178
 179 '    MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
 180 EthGateWay = Replace$(Buffer2.GatewayList.IpAddress, Chr(0), "")
 181
 182 End Sub