4 Jan 2012

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.

No comments:

Post a Comment

Garudayasa

Garudayasa