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 Type IP_ADDR_STRING
  20 Next As Long
  21
  22 IpAddress As String * 16
  23 IpMask As String * 16
  24 Context As Long
  25 End Type
  26 Type IP_ADAPTER_INFO
  27 Next As Long
  28
  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 Type FIXED_INFO
  48     HostName As String * MAX_HOSTNAME_LEN
  49
  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 Public Declare Function GetNetworkParams _
  60                Lib "IPHlpApi" (FixedInfo As Any, _
  61                                pOutBufLen As Long) As Long
  62 Public Declare Function GetAdaptersInfo _
  63                Lib "IPHlpApi" (IpAdapterInfo As Any, _
  64                                pOutBufLen As Long) As Long
  65 Public Declare Sub CopyMemory _
  66                Lib "kernel32" _
  67                Alias "RtlMoveMemory" (Destination As Any, _
  68                                       Source As Any, _
  69                                       ByVal Length As Long)
  70
  71 Sub EthInfo()
  72         '<EhHeader>
  73         On Error GoTo EthInfo_Err
  74         '</EhHeader>
  75         Dim error As Long
  76         Dim FixedInfoSize As Long
  77         Dim AdapterInfoSize As Long
  78         Dim i As Integer
  79         Dim PhysicalAddress  As String
  80         Dim NewTime As Date
  81         Dim AdapterInfo As IP_ADAPTER_INFO
  82         Dim Adapt As IP_ADAPTER_INFO
  83         Dim AddrStr As IP_ADDR_STRING
  84         Dim FixedInfo As FIXED_INFO
  85         Dim Buffer As IP_ADDR_STRING
  86         Dim pAddrStr As Long
  87         Dim pAdapt As Long
  88         Dim Buffer2 As IP_ADAPTER_INFO
  89         Dim FixedInfoBuffer() As Byte
  90         Dim AdapterInfoBuffer() As Byte
  91         'Get the main IP configuration information for this machine using a FIXED_INFO structure
  92 100     FixedInfoSize = 0
  93 101     error = GetNetworkParams(ByVal 0&, FixedInfoSize)
  94
  95 102     If error <> 0 Then
  96 103         If error <> ERROR_BUFFER_OVERFLOW Then
  97                 '            MsgBox "GetNetworkParams sizing failed with error " & error
  98                 Exit Sub
  99             End If
 100         End If
 101
 102 104     ReDim FixedInfoBuffer(FixedInfoSize - 1)
 103 105     error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
 104
 105 106     If error = 0 Then
 106 107         CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
 107             '        MsgBox "Host Name:  " & FixedInfo.HostName
 108             '        MsgBox "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress
 109 108         pAddrStr = FixedInfo.DnsServerList.Next
 110
 111 109         Do While pAddrStr <> 0
 112 110             CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
 113                 '            MsgBox "DNS Servers:  " & Buffer.IpAddress
 114 111             pAddrStr = Buffer.Next
 115             Loop
 116
 117             '        MsgBox "NetBIOS Scope ID:  " & FixedInfo.ScopeId
 118 112         If FixedInfo.EnableRouting Then
 119                 '            MsgBox "IP Routing Enabled "
 120             Else
 121                 '            MsgBox "IP Routing not enabled"
 122             End If
 123
 124 113         If FixedInfo.EnableProxy Then
 125                 '            MsgBox "WINS Proxy Enabled "
 126             Else
 127                 '            MsgBox "WINS Proxy not Enabled "
 128             End If
 129
 130 114         If FixedInfo.EnableDns Then
 131                 '            MsgBox "NetBIOS Resolution Uses DNS "
 132             Else
 133                 '            MsgBox "NetBIOS Resolution Does not use DNS  "
 134             End If
 135
 136         Else
 137             '        MsgBox "GetNetworkParams failed with error " & error
 138             Exit Sub
 139         End If
 140
 141         'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
 142         'Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
 143 115     AdapterInfoSize = 0
 144 116     error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
 145
 146 117     If error <> 0 Then
 147 118         If error <> ERROR_BUFFER_OVERFLOW Then
 148                 '           MsgBox "GetAdaptersInfo sizing failed with error " & error
 149                 Exit Sub
 150             End If
 151         End If
 152
 153 119     ReDim AdapterInfoBuffer(AdapterInfoSize - 1)
 154         ' Get actual adapter information
 155 120     error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
 156
 157 121     If error <> 0 Then
 158             '        MsgBox "GetAdaptersInfo failed with error " & error
 159             Exit Sub
 160         End If
 161
 162 122     CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
 163 123     pAdapt = AdapterInfo.Next
 164 124     CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
 165
 166         '    MsgBox " AdapterName: " & Buffer2.AdapterName
 167         '    MsgBox "AdapterDescription: " & Buffer2.Description
 168 125     For i = 0 To Buffer2.AddressLength - 1
 169 126         PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
 170
 171 127         If i < Buffer2.AddressLength - 1 Then
 172 128             PhysicalAddress = PhysicalAddress & "-"
 173             End If
 174
 175         Next
 176
 177         '    MsgBox "Physical Address: " & PhysicalAddress
 178 129     If Buffer2.DhcpEnabled Then
 179             '        MsgBox "DHCP Enabled "
 180         Else
 181             '        MsgBox "DHCP disabled"
 182         End If
 183
 184 130     pAddrStr = Buffer2.IpAddressList.Next
 185         '    MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
 186 131     EthGateWay = Replace$(Buffer2.GatewayList.IpAddress, Chr(0), "")
 187         '<EhFooter>
 188         Exit Sub
 189 EthInfo_Err:
 190         Controlar_Error Erl, Err.Description, "Reseter.modEth.EthInfo.Ref 12/2/2008 : 09:38:36"
 191         Resume Next
 192         '</EhFooter>
 193 End Sub