Dapatkan IP Adress

Const IP_SUCCESS As Long = 0
Const MAX_WSADescription As Long = 256
Const MAX_WSASYSStatus As Long = 128
Const WS_VERSION_REQD As Long = &H101
Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Const MIN_SOCKETS_REQD As Long = 1
Const SOCKET_ERROR As Long = -1

Private 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" _
(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

Private Declare Function WSAStartup Lib "wsock32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long

Private Declare Function WSACleanup Lib "wsock32" () 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
'konversi host name ke IP Address.

Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String

sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
ptrAddress = ptrHosent + 12
'mendapatkan 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

Private Sub Form_Load()
If SocketsInitialize() Then
MsgBox "Host Name: localhost, " & GetIPFromHostName("localhost")
SocketsCleanup
Else
MsgBox "Error, tidak dapat mendapatkan IP Address"

End If
End Sub