爱尚共享网

VB6获取本机默认网关地址

爱尚共享网2020-07-25学习资料 162 0A+A-

模块代码:

Option Explicit
Option Compare Text
Public GatewayIP As String
Public Type WSADATA
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To 255) As Byte
  szSystemStatus(0 To 127) As Byte
  wMaxSockets As Integer
  wMaxUDPDG As Integer
  dwVendorInfo As Long
End Type
Public Type IP_ADDR_STRING
  dwNext As Long
  IpAddress As String * 16
  IpMask As String * 16
  Context As Long
End Type
Public Type IP_ADAPTER_INFO
  dwNext As Long
  ComboIndex As Long
  AdapterName As String * 260
  Description As String * 132
  AddressLength As Long
  Address(7) As Byte
  Index As Long
  dwType As Long
  DhcpEnabled As Long
  CurrentIpAddress As Long
  IpAddressList As IP_ADDR_STRING
  GatewayList As IP_ADDR_STRING
  DhcpServer As IP_ADDR_STRING
  HaveWins As Long
  PrimaryWinsServer As IP_ADDR_STRING
  SecondaryWinsServer As IP_ADDR_STRING
  LeaseObtained As Long
  LeaseExpires As Long
End Type
Private Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.DLL" () As Long
Private Declare Function WSAStartup Lib "ws2_32.DLL" (ByVal wVR As Long, lpWSAD As WSADATA) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function SocketsCleanup() As Boolean
  SocketsCleanup = CBool(WSACleanup = 0)
End Function
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
  If WSAStartup(&H101, WSAD) = 0 Then
    SocketsInitialize = True
  Else
    SocketsCleanup
    SocketsInitialize = False
  End If
End Function
Public Function TrimString(ByVal vData As String) As String
Dim ZPos As Long
  ZPos = InStr(vData, Chr$(0))
  If ZPos <> 0 Then vData = Left(vData, ZPos - 1)
  TrimString = Trim(vData)
End Function
Public Sub ShowAdapterInfo()
Const MIB_IF_TYPE_ETHERNET = 6
Const MIB_IF_TYPE_TOKENRING = 9
Const MIB_IF_TYPE_FDDI = 15
Const MIB_IF_TYPE_PPP = 23
Const MIB_IF_TYPE_LOOPBACK = 24
Const MIB_IF_TYPE_SLIP = 28
Const MAX_ADAPTER_NAME = 128
Const ERROR_BUFFER_OVERFLOW = 111
Const GMEM_FIXED = &H0
Dim Error As Long
Dim AdapterInfoSize As Long
Dim I As Long
Dim NewTime As Date
Dim AdapterInfo As IP_ADAPTER_INFO
Dim Buffer As IP_ADDR_STRING
Dim pAddrStr As Long
Dim pAdapt As Long
Dim Buffer2 As IP_ADAPTER_INFO
Dim AdapterInfoBuffer As Long
  AdapterInfoSize = 0
  Error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
  If Error <> 0 Then
    If Error <> ERROR_BUFFER_OVERFLOW Then
      MsgBox "Error retrieving devices."
      Exit Sub
    End If
  End If
  AdapterInfoBuffer = GlobalAlloc(GMEM_FIXED, AdapterInfoSize)
  If AdapterInfoBuffer = 0 Then
    MsgBox "Error retrieving devices."
    Exit Sub
  End If
  Error = GetAdaptersInfo(ByVal AdapterInfoBuffer, AdapterInfoSize)
  If Error <> 0 Then
    MsgBox "Error retrieving devices."
    GlobalFree AdapterInfoBuffer
    Exit Sub
  End If
  CopyMemory AdapterInfo, ByVal AdapterInfoBuffer, Len(AdapterInfo)
  pAdapt = AdapterInfo.dwNext
  Do
    CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
    Debug.Print "****************************************************************"
    Debug.Print "Adapter Index : "; Format(Buffer2.Index, "0")
    Debug.Print "Adapter Name : "; TrimString(AdapterInfo.AdapterName)
    Debug.Print "Description : "; TrimString(Buffer2.Description)
    Select Case Buffer2.dwType
      Case MIB_IF_TYPE_ETHERNET
        Debug.Print "Type : "; "Ethernet adapter"
      Case MIB_IF_TYPE_TOKENRING
        Debug.Print "Type : "; "Token ring adapter"
      Case MIB_IF_TYPE_FDDI
        Debug.Print "Type : "; "FDDI adapter"
      Case MIB_IF_TYPE_PPP
        Debug.Print "Type : "; "PPP adapter"
      Case MIB_IF_TYPE_LOOPBACK
        Debug.Print "Type : "; "Loopback adapter"
      Case MIB_IF_TYPE_SLIP
        Debug.Print "Type : "; "Slip adapter"
      Case Else
        Debug.Print "Type : "; "Other adapter"
    End Select
    Debug.Print "MAC Address : ";
    For I = 0 To Buffer2.AddressLength - 1
      If Len(Hex(Buffer2.Address(I))) = 1 Then
        Debug.Print "0"; Hex(Buffer2.Address(I));
      Else
        Debug.Print Hex(Buffer2.Address(I));
      End If
      If I < Buffer2.AddressLength - 1 Then Debug.Print "-";
    Next
    Debug.Print ""
    If Buffer2.DhcpEnabled Then
      Debug.Print "DHCP : "; "Enabled"
    Else
      Debug.Print "DHCP : "; "Disabled"
    End If
    Debug.Print "IP Address : "; TrimString(Buffer2.IpAddressList.IpAddress)
    Debug.Print "Subnet Mask : "; TrimString(Buffer2.IpAddressList.IpMask)
    pAddrStr = Buffer2.IpAddressList.dwNext
    Do While pAddrStr <> 0
    'NOTE : I haven't tested this
      CopyMemory Buffer, Buffer2.IpAddressList, Len(Buffer)
      Debug.Print "IP Address : "; TrimString(Buffer.IpAddress)
      Debug.Print "Subnet Mask : "; TrimString(Buffer.IpMask)
      pAddrStr = Buffer.dwNext
      If pAddrStr <> 0 Then CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList)
    Loop
    Debug.Print "Default Gateway : "; TrimString(Buffer2.GatewayList.IpAddress)
    If TrimString(Buffer2.GatewayList.IpAddress) <> "0.0.0.0" Then GatewayIP = TrimString(Buffer2.GatewayList.IpAddress)
    pAddrStr = Buffer2.GatewayList.dwNext
    Do While pAddrStr <> 0
      CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer)
      pAddrStr = Buffer.dwNext
      If pAddrStr <> 0 Then CopyMemory Buffer2.GatewayList, ByVal pAddrStr, Len(Buffer2.GatewayList)
    Loop
    Debug.Print "DHCP Server : "; TrimString(Buffer2.DhcpServer.IpAddress)
    Debug.Print "Primary WINS Server : "; TrimString(Buffer2.PrimaryWinsServer.IpAddress)
    Debug.Print "Secondary WINS Server : "; TrimString(Buffer2.SecondaryWinsServer.IpAddress)
    NewTime = DateAdd("s", Buffer2.LeaseObtained, #1/1/1970#)
    Debug.Print "Lease Obtained : "; CStr(Format(NewTime, "dddd,mmm d hh:mm:ss yyyy"))
    NewTime = DateAdd("s", Buffer2.LeaseExpires, #1/1/1970#)
    Debug.Print "Lease Expires : "; CStr(Format(NewTime, "dddd,mmm d hh:mm:ss yyyy"))
    pAdapt = Buffer2.dwNext
    If pAdapt <> 0 Then CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
  Loop While pAdapt <> 0
  GlobalFree AdapterInfoBuffer
End Sub

窗体调用代码:

Private Sub Form_Load()
    If SocketsInitialize Then ShowAdapterInfo
    SocketsCleanup
    MsgBox GatewayIP
End Sub


发表评论