Mengetahui alamat IP dari komputer anda menggunakan Windows API di Visual Basic 6

Pada proyek lama dahulu yang bersifat program client server, dibutuhkan fungsi informasi yang melaporkan PC mana saja yang terdapat program yang sedang digunakan. Setelah mencari beberapa referensi, akhirnya saya bisa membuatnya walau fungsinya juga cukup sederhana.
Fungsi untuk mendapatkan alamat IP yang saya berikan disini menggunakan Windows API. Silahkan kode berikut diletakkan pada sebuah form.

Deklarasi konstanta untuk Windows API

Public Const MAX_WSADescription = 256

Public Const MAX_WSASYSStatus = 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

Deklarasi Tipe Data baru

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

 

Deklarasi fungsi API

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Public Declare Function WSAStartup Lib "WSOCK32.DLL" _

(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Declare Function gethostname Lib "WSOCK32.DLL" _

(ByVal szHost As String, ByVal dwHostLen As Long) As Long

Public Declare Function gethostbyname Lib "WSOCK32.DLL" _

(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)

 

Fungsi DapatkanIP

Public Function DapatkanIP() 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

DapatkanIP = ""

Exit Function

End If

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPAddress = ""

MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _

" Gagal mendapatkan nama host."

SocketsCleanup

Exit Function

End If

sHostName = Trim$(sHostName)

lpHost = gethostbyname(sHostName)

 If lpHost = 0 Then

DapatkanIP = ""

MsgBox "Windows Sockets tidak merespon. " & _

"gagal mendapatkan nama 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

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

 SocketsCleanup

End Function

 

Fungsi dan prosedur pendukung lainnya

Public Function HiByte(ByVal wParam As Integer)

HiByte = wParam \ &H100 And &HFF&

End Function

Public Function LoByte(ByVal wParam As Integer)

LoByte = wParam And &HFF&

End Function

Public Sub SocketsCleanup()

If WSACleanup() <> ERROR_SUCCESS Then

MsgBox "Socket error pada pembersihan."

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 "Windows socket tidak merespon."

SocketsInitialize = False

Exit Function

End If

 If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

MsgBox "Aplikasi ini membutuhkan minimal " & _

CStr(MIN_SOCKETS_REQD) & " socket."

 SocketsInitialize = False

Exit Function

End If

 

Untuk menggunakan fungsi ini, anda tinggal memanggil fungsi DapatkanIP().
Contoh penggunaan pada MessageBox

MsgBox "IP dari komputer ini adalah" & DapatkanIP()

 

Semoga informasi ini membantu anda.