vb获取网关

发布网友发布时间：2022-05-07 23:23

共4个回答

热心网友时间：2023-11-20 03:24

Private Function EthernetAddress(LanaNumber As Long) As String

Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim x As Integer

udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)

strOut = ""

If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)

With udtASTAT.adapt

For x = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
Next x

End With

HeapFree GetProcessHeap(), 0, lngASTAT
End If

EthernetAddress = strOut
End Function

Function LocalIPAddress() As String
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING
Dim ptr1 As Long
Dim sIPAddr As String
Dim found As Boolean
Call GetAdaptersInfo(ByVal 0&, cbRequired)

If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte

If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
'获取存放在buff()中的数据的指针
ptr1 = VarPtr(buff(0))

Do While (ptr1 <> 0)
'将第一个网卡的数据转换到IP_ADAPTER_INFO结构中
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)

With Adapter
'IpAddress.IpAddr成员给出了DHCP的IP地址
sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))

If Len(sIPAddr) > 0 Then
found = True
Exit Do
End If

ptr1 = .dwNext
End With 'With Adapter

'不再有网卡时，ptr1的值为0
Loop 'Do While (ptr1 <> 0)

End If 'If GetAdaptersInfo
End If 'If cbRequired > 0

'返回结果字符串
LocalIPAddress = sIPAddr
End Function

Function TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))

If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If

End Function

Private Sub Form_Load()
Text1 = "IP地址:" & LocalIPAddress
Text2 = "MAC地址:" & EthernetAddress(0)
End Sub

热心网友时间：2023-12-12 04:22

Option Explicit

Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0

Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins 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.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)

Private Sub Command1_Click()

Label1.Caption = LocalIPAddress()
End Sub

Private Function LocalIPAddress() As String

'api vars
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING

'working vars
Dim ptr1 As Long
Dim sIPAddr As String
Dim found As Boolean
Dim sGateway As String

Call GetAdaptersInfo(ByVal 0&, cbRequired)

If cbRequired > 0 Then

ReDim buff(0 To cbRequired - 1) As Byte

If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then

ptr1 = VarPtr(buff(0))

Do While (ptr1 <> 0)

CopyMemory Adapter, ByVal ptr1, LenB(Adapter)

With Adapter

'IP地址
sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))

'默认网关
sGateway = TrimNull(StrConv(.GatewayList.IpAddress.IpAddr, vbUnicode))

If Len(sGateway) > 0 Then 'Len(sIPAddr)
found = True
Exit Do
End If

ptr1 = .dwNext

End With
Loop

End If
End If

LocalIPAddress = sGateway ' sIPAddr

End Function

Private Function TrimNull(item As String)

Dim pos As Integer

'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If

End Function

热心网友时间：2023-11-20 03:24

热心网友时间：2023-11-20 03:25

GetAdaptersInfo

热心网友时间：2023-11-20 03:25

窗体代码：

Private Sub Command1_Click()
If SocketsInitialize Then ShowAdapterInfo
SocketsCleanup
Label1.Caption = GatewayIP
End Sub

模块代码：

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

热心网友时间：2023-12-12 04:22

GetAdaptersInfo

热心网友时间：2023-11-20 03:24

热心网友时间：2023-11-20 03:25

GetAdaptersInfo

热心网友时间：2023-11-20 03:25

热心网友时间：2023-12-12 04:23

热心网友时间：2023-11-20 03:24

热心网友时间：2023-11-20 03:25

GetAdaptersInfo

热心网友时间：2023-11-20 03:26