Cara Mendapatkan Nama dan IP Komputer
Mendeteksi Nama Komputer (Hostname) dan IP Address pada Windows
Untuk membuat project ini kita membutuhkan 2 module saja, yaitu:- Module Form,
- Class Module.
A. Form1 (frmMain.frm)
Option Explicit
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim computerName As String
Dim clsHostNIp As clsHostNIp
Private Sub Command1_Click()
Set clsHostNIp= New clsHostNIp
MsgBox clsHostNIp.GetHostNameFromIP("172.21.157.88")MsgBox clsHostNIp.GetIPFromHostName("wwwsitus.com")
End Sub
B. Class Module (clsHostNIp.cls)
Option Explicit
Private Const IP_SUCCESS As Long = 0
Private Const SOCKET_ERROR As Long = -1
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const AF_INET As Long = 2
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
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 Sub apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes As Long)
Private Declare Function apiStrLen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
'wsock32
Private Declare Function apiGetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal hostname As String) As Long
Private Declare Function apiWSAStartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function apiWSACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Private Declare Function apiInetAddr Lib "wsock32.dll" Alias "inet_addr" (ByVal s As String) As Long
Private Declare Function apiGetHostByAddr Lib "wsock32.dll" Alias "gethostbyaddr" (haddr As Long, ByVal hnlen As Long, ByVal addrtype As Long) As Long
Private Function InitializeSocket() As Boolean
Dim WSAD As WSADATA
InitializeSocket = apiWSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Private Sub CloseSocket()
If apiWSACleanup() <> 0 Then
MsgBox "Error calling apiWSACleanup.", vbCritical
End If
End Sub
Public Function GetIPFromHostName(ByVal sHostName As String) As String
Dim nBytes As Long
Dim ptrHosent As Long
Dim hstHost As HOSTENT
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String 'declare this as Dim sAddress(1) As String if you want 2 ip addresses returned
If InitializeSocket() = True Then
ptrHosent = apiGetHostByName(sHostName & vbNullChar)
If ptrHosent <> 0 Then
apiCopyMemory hstHost, ByVal ptrHosent, LenB(hstHost)
apiCopyMemory ptrIPAddress, ByVal hstHost.hAddrList, 4
sAddress = Space$(4)
apiCopyMemory ByVal sAddress, ByVal ptrIPAddress, hstHost.hLength
GetIPFromHostName = IPToText(sAddress)
End If
Else
MsgBox "Gagal membuka socket."
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
Public Function GetHostNameFromIP(ByVal sIPAddress As String) As String
Dim ptrHosent As Long
Dim hAddress As Long
Dim sHost As String
Dim nBytes As Long
If InitializeSocket() = True Then
hAddress = apiInetAddr(sIPAddress)
ptrHosent = apiGetHostByAddr(hAddress, 4, AF_INET)
If ptrHosent <> 0 Then
apiCopyMemory ptrHosent, ByVal ptrHosent, 4
nBytes = apiStrLen(ByVal ptrHosent)
If nBytes > 0 Then
sHost = Space$(nBytes)
apiCopyMemory ByVal sHost, ByVal ptrHosent, nBytes
GetHostNameFromIP = sHost
End If
Else
MsgBox "Gagal mendapatkan Hostname."
End If
CloseSocket
Else
MsgBox "IP Address tidak benar"
End If
Else
MsgBox "Gagal membuka socket"
End If
End Function
Selamat Mencoba
Post a Comment for "Cara Mendapatkan Nama dan IP Komputer"