Skip to content Skip to sidebar Skip to footer

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:
  1. Module Form,
  2. Class Module.
Berikut ini adalah script/kode mendapatkan hostname dan ip address komputer pada windows:

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"