Atomic Angel
вот упрощенный пример для определения имени хоста по ip на API WSOCK32.DLL
| Код |
'модуль
Option Explicit
Private Const AF_INET As Integer = 2 ' UDP, TCP, и т.д.
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal ipaddress$) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Long, addrLen As Long, addrType As Long) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSAData As WSADATA) As Long
Public Function ResolveHostname(ByVal sIp As String) As String
Dim hostip_addr As Long
Dim hostent_addr As Long
Dim newAddr As Long
Dim host As HOSTENT
Dim strTemp As String
Dim strHost As String * 255
If SocketsInitialize Then
newAddr = inet_addr(sIp)
hostent_addr = gethostbyaddr(newAddr, Len(newAddr), AF_INET)
If hostent_addr = 0 Then
WSACleanup
Exit Function
End If
RtlMoveMemory host, hostent_addr, Len(host)
RtlMoveMemory ByVal strHost, host.hName, 255
strTemp = strHost
If InStr(strTemp, Chr(0)) <> 0 Then strTemp = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
strTemp = Trim(strTemp)
ResolveHostname = strTemp
WSACleanup
End If
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim X As Integer
Dim szLoByte As String
Dim szHiByte As String
Dim szBuf As String
X = WSAStartup(WS_VERSION_REQD, WSAD)
'ответ должен быть равен 0
If X <> 0 Then
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
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
szHiByte = Trim$(Str$(hibyte(WSAD.wversion)))
szLoByte = Trim$(Str$(lobyte(WSAD.wversion)))
szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
szBuf = szBuf & " is not supported by Windows " & _
"Sockets for 32 bit Windows environments."
MsgBox szBuf, vbExclamation
Exit Function
End If
'check that there are available sockets
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
szBuf = "This application requires a minimum of " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox szBuf, vbExclamation
Exit Function
End If
SocketsInitialize = True
End Function
Private Function hibyte(ByVal wParam As Long) As Integer
hibyte = wParam \ &H100 And &HFF&
End Function
Private Function lobyte(ByVal wParam As Long) As Integer
lobyte = wParam And &HFF&
End Function
|
пример использования:
| Код |
MsgBox ResolveHostname("192.168.0.1")
|
полный код можно найти на planetsoucecode.com |
.. [/offtop]