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
Contoh penggunaan pada MessageBox
MsgBox
"IP dari komputer ini adalah"
& DapatkanIP()
Semoga informasi ini membantu anda.
No comments:
Post a Comment