Attribute VB_Name = "mod_funciones_impresora"
 'Constantes
 Public Const MIN_SOCKETS_REQD As Long = 1

 Public Const WS_VERSION_MAJOR As Long = &H101 \ &H100 And &HFF&
 Public Const WS_VERSION_MINOR As Long = &H101 And &HFF&
 Public Const SOCKET_ERROR As Long = -1
 Public Const WSADESCRIPTION_LEN = 257
 Public Const WSASYS_STATUS_LEN = 129
 Public Const MAX_WSADescription = 256
 Public Const MAX_WSASYSStatus = 128

 'Estructuras
 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

 'Declaraciones API

 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)


 'Función que obtiene la dirección IP
 '
 Public Function recuperar_IP(ByVal Nombre_Host As String) As String

     Dim lHost As Long, T_Host As HOSTENT, ipDir As Long
     Dim tIP() As Byte, I As Integer, sIP As String

If Not Inicializar_Socket() Then
         recuperar_IP = ""
         Exit Function
End If


     Nombre_Host = Trim$(Nombre_Host)

     lHost = gethostbyname(Nombre_Host)

If lHost = 0 Then
         recuperar_IP = ""
         MsgBox "Error"
         Remover_Socket
         Exit Function
End If

     CopyMemoryIP T_Host, lHost, Len(T_Host)
     CopyMemoryIP ipDir, T_Host.hAddrList, 4
     ReDim tIP(1 To T_Host.hLen)
     CopyMemoryIP tIP(1), ipDir, T_Host.hLen

     For I = 1 To T_Host.hLen
         sIP = sIP & tIP(I) & "."
     Next

     recuperar_IP = Mid$(sIP, 1, Len(sIP) - 1)

     Remover_Socket

 End Function


 Public Function Inicializar_Socket() As Boolean
     Dim w As WSAData, slb As String, shb As String

If WSAStartup(&H101, w) <> ERROR_SUCCESS Then
         MsgBox "Error"
         Inicializar_Socket = False
         Exit Function
End If
If w.wMaxSockets < MIN_SOCKETS_REQD Then
         MsgBox "Error"
         Inicializar_Socket = False
         Exit Function
End If
     If LB(w.wVersion) < WS_VERSION_MAJOR Or (LB(w.wVersion) _
             = WS_VERSION_MAJOR And HB(w.wVersion) < WS_VERSION_MINOR) Then

         shb = CStr(HB(w.wVersion))
         slb = CStr(LB(w.wVersion))
         MsgBox "Error"
         Inicializar_Socket = False
         Exit Function
End If

     Inicializar_Socket = True

 End Function

 Public Function HB(ByVal wParam As Integer)
     HB = wParam \ &H100 And &HFF&
 End Function
 Public Function LB(ByVal wParam As Integer)
     LB = wParam And &HFF&
 End Function
 Public Sub Remover_Socket()
If WSACleanup() <> ERROR_SUCCESS Then
         MsgBox "Socket error occurred in Cleanup."
End If
 End Sub


