VB用API获取本机IP地址
2012-12-26 15:32
260 查看
Option Explicit Public Const MIN_SOCKETS_REQD As Long = 1 Public Const WS_VERSION_REQD As Long = &H101 Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF& Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF& Public Const SOCKET_ERROR As Long = -1 Public Const ERROR_SUCCESS As Long = 0 Public Const WSADESCRIPTION_LEN = 257 Public Const WSASYS_STATUS_LEN = 129 Public Const MAX_WSADescription = 256 Public Const MAX_WSASYSStatus = 128 Public Type WSAData wVersion As Integer wHighVersion As Integer szDescription(0 To MAX_WSADescription) As Byte szSystemStatus(0 To MAX_WSASYSStatus) As Byte wMaxSockets As Integer wMaxUDPDG As Integer dwVendorInfo As Long End Type Type WSADataInfo wVersion As Integer wHighVersion As Integer szDescription As String * WSADESCRIPTION_LEN szSystemStatus As String * WSASYS_STATUS_LEN iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As String End Type Public Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLen As Integer hAddrList As Long End Type Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long Declare Function WSACleanup Lib "WSOCK32" () As Long Declare Function WSAGetLastError Lib "WSOCK32" () As Long Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long) '获取本地IP地址 Public Function GetIPAddress() As String Dim sHostName As String * 256 Dim lpHost As Long Dim HOST As HOSTENT Dim dwIPAddr As Long Dim tmpIPAddr() As Byte Dim I As Integer Dim sIPAddr As String If Not SocketsInitialize() Then GetIPAddress = "" Exit Function End If If gethostname(sHostName, 256) = SOCKET_ERROR Then GetIPAddress = "" MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name." SocketsCleanup Exit Function End If sHostName = Trim$(sHostName) lpHost = gethostbyname(sHostName) If lpHost = 0 Then GetIPAddress = "" MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name." SocketsCleanup Exit Function End If CopyMemoryIP HOST, lpHost, Len(HOST) CopyMemoryIP dwIPAddr, HOST.hAddrList, 4 ReDim tmpIPAddr(1 To HOST.hLen) CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen For I = 1 To HOST.hLen sIPAddr = sIPAddr & tmpIPAddr(I) & "." Next GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1) SocketsCleanup End Function Public Function GetIPHostName() As String Dim sHostName As String * 256 If Not SocketsInitialize() Then GetIPHostName = "" Exit Function End If If gethostname(sHostName, 256) = SOCKET_ERROR Then GetIPHostName = "" MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name." SocketsCleanup Exit Function End If GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1) SocketsCleanup End Function Public Function HiByte(ByVal wParam As Integer) HiByte = wParam \ &H100 And &HFF& End Function Public Function LoByte(ByVal wParam As Integer) LoByte = wParam And &HFF& End Function Public Sub SocketsCleanup() If WSACleanup() <> ERROR_SUCCESS Then MsgBox "Socket error occurred in Cleanup." End If End Sub Public Function SocketsInitialize() As Boolean Dim WSAD As WSAData Dim sLoByte As String Dim sHiByte As String If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then MsgBox "The 32-bit Windows Socket is not responding." SocketsInitialize = False Exit Function End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets." SocketsInitialize = False Exit Function End If If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then sHiByte = CStr(HiByte(WSAD.wVersion)) sLoByte = CStr(LoByte(WSAD.wVersion)) MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets." SocketsInitialize = False Exit Function End If SocketsInitialize = True End Function Sub MAIN() MsgBox GetIPAddress, , "IP Address" End End Sub
相关文章推荐
- 在vb中使用Iphlpapi.dll获取网络信息 第二章 第十节 获取本机已探测的IP – 物理地址映射表
- 在vb中使用Iphlpapi.dll获取网络信息 第二章 第十节 获取本机已探测的IP – 物理地址映射表
- 在vb中使用Iphlpapi.dll获取网络信息 第二章 第十三节 获得目的地IP对应的物理地址
- 在vb中使用Iphlpapi.dll获取网络信息 第二章 第十三节 获得目的地IP对应的物理地址
- 不调用苹果似有API也能获取 iPhone 本机 IP 地址的
- VB获取本机网卡类型、IP、MAC地址
- VB.NET获取局域网IP和MAC地址
- 获取指定(访客)IP的所有信息,地址、邮政编码、国家、经纬度等的API
- 获取指定(访客)IP的所有信息,地址、邮政编码、国家、经纬度等的API
- 获取指定(访客)IP的所有信息,地址、邮政编码、国家、经纬度等的API
- 不调用苹果似有API也能获取 iPhone 本机 IP 地址的
- 使用Nginx代理通过HttpServletRequest获取用户IP地址
- 通过特定获取获取电脑外网IP地址
- java获取mac地址-屏蔽ip封mac地址
- SOCKET 编程 获取本机IP 地址
- C# Winform程序获取外网IP地址
- 动态获取API地址
- C#获取路由器外网IP,MAC地址
- Qt如何获取外网IP地址