module1.bas

电子书“Visual Basic 6 网络编程实例教程.rar”

Attribute VB_Name = "Module1"
Option Explicit

Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const IP_SUCCESS As Long = 0
Private Const SOCKET_ERROR As Long = -1
Private Const AF_INET As Long = 2

Private Type WSADATA
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To WSADescription_Len) As Byte
  szSystemStatus(0 To WSASYS_Status_Len) As Byte
  imaxsockets As Integer
  imaxudp As Integer
  lpszvenderinfo As Long
End Type

Private Declare Function WSAStartup Lib "wsock32.dll" _
  (ByVal VersionReq As Long, _
   WSADataReturn As WSADATA) As Long
  
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long

Private Declare Function inet_addr Lib "wsock32.dll" _
  (ByVal s As String) As Long

Private Declare Function gethostbyaddr Lib "wsock32.dll" _
  (haddr As Long, _
   ByVal hnlen As Long, _
   ByVal addrtype As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nbytes As Long)
   
Private Declare Function lstrlen Lib "kernel32" _
   Alias "lstrlenA" _
  (lpString As Any) As Long
  
  
Public Function SocketsInitialize() As Boolean
   Dim WSAD As WSADATA
   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Public Sub SocketsCleanup()
   If WSACleanup() <> 0 Then
       MsgBox "终止Windows套接字错误", vbExclamation
   End If
End Sub

Public Function GetHostNameFromIP(ByVal sAddress As String) As String
   Dim ptrHosent As Long
   Dim hAddress As Long
   Dim nbytes As Long
   If SocketsInitialize() Then
     '转换地址字符串为一个long值
      hAddress = inet_addr(sAddress)
      If hAddress <> SOCKET_ERROR Then
        '获取HOSTENT结构的指针，该结构中包含了对应于网络地址的名称和地址
         ptrHosent = gethostbyaddr(hAddress, 4, AF_INET)
         If ptrHosent <> 0 Then
           '转换地址，并获取已解析的主机名
            CopyMemory ptrHosent, ByVal ptrHosent, 4
            nbytes = lstrlen(ByVal ptrHosent)
            If nbytes > 0 Then
               sAddress = Space$(nbytes)
               CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
               GetHostNameFromIP = sAddress
            End If
         Else: MsgBox "gethostbyaddr函数调用失败！"
         End If 'If ptrHosent
      SocketsCleanup
      Else: MsgBox "无效的IP地址字符串！"
      End If 'If hAddress
   Else: MsgBox "套接字初始化失败！"
   End If  'If SocketsInitialize
End Function