VB 版 (精华区)

发信人: zxfsnow (希望的春天), 信区: VB
标  题: 根据域名返回ip地址 (转载) 
发信站: 哈工大紫丁香 (2000年06月05日12:57:07 星期一), 转信

发信人: gnim (我), 信区: VB
标  题: 根据域名返回ip地址 (转载)
发信站: 虎踞龙蟠 (Tue Mar 28 18:41:15 2000), 转信

发信人: yucheng (无话可说), 信区: VisualBasic
标  题: 根据域名返回ip地址 (转载)
发信站: BBS 水木清华站 (Fri Mar 24 20:12:27 2000)

【 以下文字转载自 NewSoftware 讨论区 】
【 原文由 yucheng 所发表 】
BAS Module Code
Add the following code to a BAS module:
----------------------------------------------------------------------------
----
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?996-2000 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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&Pub
lic Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&Public Const M
IN_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.DLL" _
  (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.DLL" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () 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  'address of hostent structure
   Dim ptrName As Long    'address of name pointer
   Dim ptrAddress As Long 'address of address pointer
   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
'--end block--'
 Form Code
To a form add a command button (Command1) and a text box, along with the fol
lowing code:
----------------------------------------------------------------------------
----
Option Explicit
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 " & _
               "environments is not successfully responding."
   End If
End Sub

--

--

 以科计为本,以产业报国!
  超越自我,飞跃无限!
  

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.249]