Часто задаваемые вопросы и ответы по программированию на VB
Последнее обновление: 28.03.03
Q: Как определить IP по URL?
A (purpe):
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you can not publish
' or reproduce this code on any web site,
' on any online service, or distribute on
' any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const IP_SUCCESS As Long = 0
Public Const MAX_WSADescription As Long = 256
Public Const MAX_WSASYSStatus As Long = 128
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 MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
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 Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "wsock32" _
(ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Public Declare Function WSAStartup Lib "wsock32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "wsock32" () As Long
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Public Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address.
Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'assign pointer addresses and offset
'The Address is offset 12 bytes from the start of
'the HOSENT structure. Note: Here we are retrieving
'only the first address returned. To return more than
'one, define sAddress as a string array and loop through
'the 4-byte ptrIPAddress members returned. The last
'item is a terminating null. All addresses are returned
'in network byte order.
ptrAddress = ptrHosent + 12
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
End Function
Private Function IPToText(ByVal IPAddress As String) As String
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Private Sub Command1_Click()
Dim sHostName As String
If SocketsInitialize() Then
'pass the host address to the function
sHostName = Text1.Text
Text2.Text = GetIPFromHostName(sHostName)
SocketsCleanup
Else
MsgBox "Windows Sockets for 32 bit Windows " & _
"is not successfully responding."
End If
End Sub
FAQ составлен по материалам Форума на Исходниках.Ру.
Составитель:
Crew
Copyright © 2002 by Sources.ru. All rights
reserved.