Localizar IP

[renatoalexrocha 0]

Olá galera,

 

alguém conhece um código para localizar o ip de uma máquina onde meu sistema for instalado, pois o utilizarei para criar a chave de registro do meu sistema e controlar quantos usuários estão utilizando-o, será Free!

 

Valeu!!!

[Claudio Neto 3]

Olá galera,

 

alguém conhece um código para localizar o ip de uma máquina onde meu sistema for instalado, pois o utilizarei para criar a chave de registro do meu sistema e controlar quantos usuários estão utilizando-o, será Free!

 

Valeu!!!

 

Não entendi, você quer o IP da da mesma máquina que está usando seu programa, ou quer os IP's de todas as máquinas que, de alguma forma estão conectadas à sua de alguma forma?

 

Se for o da sua própria máquina, segue abaixo, caso contrário, não sei não:

 

Coloque o código abaixo em um 'module':

CODE

Option Explicit

 

Public Const MAX_WSADescription As Long = 256

Public Const MAX_WSASYSStatus As Long = 128

Public Const ERROR_SUCCESS As Long = 0

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 HOSTENT

hName As Long

hAliases As Long

hAddrType As Integer

hLen As Integer

hAddrList As Long

End Type

 

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

 

Public Declare Function WSAGetLastError Lib "wsock32" () 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 Declare Function gethostname Lib "wsock32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long

 

Public Declare Function gethostbyname Lib "wsock32" (ByVal szHost As String) As Long

 

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

 

Public Function GetIPAddress() As String

 

Dim sHostName As String * 256

Dim lpHost As Long

Dim HOST As HOSTENT

Dim dwIPAddr As Long

Dim tmpIPAddr() As Byte

Dim i As Integer

Dim sIPAddr As String

 

If Not SocketsInitialize() Then

GetIPAddress = ""

Exit Function

End If

 

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPAddress = ""

MsgBox "Ocorre um erro de Socket : " & Str$(WSAGetLastError()) & " , não é possivel obter nome do Host."

SocketsCleanup

Exit Function

End If

 

sHostName = Trim$(sHostName)

lpHost = gethostbyname(sHostName)

 

If lpHost = 0 Then

GetIPAddress = ""

MsgBox "Windows Sockets não esta respondendo. " & "não é possivel obter nome do Host"

SocketsCleanup

Exit Function

End If

 

CopyMemory HOST, lpHost, Len(HOST)

CopyMemory dwIPAddr, HOST.hAddrList, 4

 

ReDim tmpIPAddr(1 To HOST.hLen)

CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

 

For i = 1 To HOST.hLen

sIPAddr = sIPAddr & tmpIPAddr(i) & "."

Next

 

GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

 

SocketsCleanup

 

End Function

 

Public Function GetIPHostName() As String

 

Dim sHostName As String * 256

 

If Not SocketsInitialize() Then

GetIPHostName = ""

Exit Function

End If

 

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPHostName = ""

MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " não é possivel obter nome do Host."

SocketsCleanup

Exit Function

End If

 

GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)

SocketsCleanup

 

End Function

 

Public Function HiByte(ByVal wParam As Integer) As Byte

 

HiByte = (wParam And &HFF00&) \ (&H100)

 

End Function

 

Public Function LoByte(ByVal wParam As Integer) As Byte

 

LoByte = wParam And &HFF&

 

End Function

 

Public Sub SocketsCleanup()

 

If WSACleanup() <> ERROR_SUCCESS Then

MsgBox " Erro de Socket."

End If

 

End Sub

 

Public Function SocketsInitialize() As Boolean

 

Dim WSAD As WSADATA

Dim sLoByte As String

Dim sHiByte As String

 

If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then

MsgBox "32-bit Windows Socket não esta respondendo."

SocketsInitialize = False

Exit Function

End If

 

 

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

MsgBox " Esta aplicação requer um minimo de " & _

CStr(MIN_SOCKETS_REQD) & " sockets suportados."

 

SocketsInitialize = False

Exit Function

End If

 

 

If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

 

sHiByte = CStr(HiByte(WSAD.wVersion))

sLoByte = CStr(LoByte(WSAD.wVersion))

 

MsgBox "A versao Sockets " & sLoByte & "." & sHiByte & " não é suportada por 32-bit Windows Sockets."

 

SocketsInitialize = False

Exit Function

 

End If

 

 

SocketsInitialize = True

 

End Function

 

Importante: caso já esteja usando algum module em seu programa, crie outro exclusivamente para o código do IP

 

coloque isso onde quer que apareça seu ip (ah, o nome da máquina já vai junto de lambuja, hehe):

 

CODE

Public IP As String

Public NomePC As String

 

IP = GetIPAddress()

NomePC = GetIPHostName()

 

msgbox "O nome do computador é " & NomePc & " e o IP é " & IP

Boa sorte.