obtener ip
Publicado por fran (2 intervenciones) el 03/06/2008 10:16:10
Hola, necesito saber la ip de un ordenador que elimine un registro desde una base de datos access, la base de datos esta en el servidor, y necesito saber la dirección IP del que elimina el registro. He estado indagando y he encontrado este codigo de visual basic para aplicaciones:
Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer ' not currently used
unused2 As Integer '; not currently used
End Type
Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
'converts a Long to a string
Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Private Sub Comando0_Click()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim cad As String
cad = ""
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
'retrieve the data
GetIpAddrTable bBytes(0), Ret, False
'Get the first 4 bytes to get the entry's.. ip installed
CopyMemory Listing.dEntrys, bBytes(0), 4
'MsgBox "IP's found : " & Listing.dEntrys => Founded ip installed on your PC..
cad = Listing.dEntrys & " IP addresses found on your PC !!" & vbCrLf
cad = cad & "----------------------------------------" & vbCrLf
For Tel = 0 To Listing.dEntrys - 1
'Copy whole structure to Listing..
' MsgBox bBytes(tel) & "."
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
Debug.Print cad & "IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
Debug.Print cad & "IP Subnetmask : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
Debug.Print cad & "BroadCast IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
Debug.Print cad & "**************************************" & vbCrLf
Next
'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub
Esto en teroria me devolvería la direccion IP, pero el problema es que he creado un formulario en acces y al pulsar el botón q deberia ejecutar este código me da el siguiente mensaje:
La Expresion 'Al hacer click' que introdujo como valor de la propiedad produjo un error: No se puede defirnir un tipo definido por el usuario Public dentro de un modulo de objeto.
Haber si alguien me pudiera echar una mano, estoy atrancado aqui y no se como solucionar el problema
Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer ' not currently used
unused2 As Integer '; not currently used
End Type
Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
'converts a Long to a string
Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Private Sub Comando0_Click()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim cad As String
cad = ""
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
'retrieve the data
GetIpAddrTable bBytes(0), Ret, False
'Get the first 4 bytes to get the entry's.. ip installed
CopyMemory Listing.dEntrys, bBytes(0), 4
'MsgBox "IP's found : " & Listing.dEntrys => Founded ip installed on your PC..
cad = Listing.dEntrys & " IP addresses found on your PC !!" & vbCrLf
cad = cad & "----------------------------------------" & vbCrLf
For Tel = 0 To Listing.dEntrys - 1
'Copy whole structure to Listing..
' MsgBox bBytes(tel) & "."
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
Debug.Print cad & "IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
Debug.Print cad & "IP Subnetmask : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
Debug.Print cad & "BroadCast IP address : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
Debug.Print cad & "**************************************" & vbCrLf
Next
'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub
Esto en teroria me devolvería la direccion IP, pero el problema es que he creado un formulario en acces y al pulsar el botón q deberia ejecutar este código me da el siguiente mensaje:
La Expresion 'Al hacer click' que introdujo como valor de la propiedad produjo un error: No se puede defirnir un tipo definido por el usuario Public dentro de un modulo de objeto.
Haber si alguien me pudiera echar una mano, estoy atrancado aqui y no se como solucionar el problema
Valora esta pregunta


0