Yang dibutuhkan dalam pembuatan aplikasi kali ini adalah :
- 1 listbox dengan properties name List1
- 2 textbox dengan propertie name Text1 dan Text2
- 2 commandbutton dengan properties name Command1 dan Command2
- 2 label dengan properties name label1, properties Caption="Cek IP Aktif dari" dan label2 dengan properties caption="Sampai"
Masukkan code di bawah ini pada form
Option Explicit Const SOCKET_ERROR = 0 Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvdest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean 'type data tambahan Private Type WSAdata wVersion As Integer wHighVersion As Integer szDescription(0 To 255) As Byte szSystemStatus(0 To 128) As Byte iMaxSockets As Integer iMaxUdpDg As Integer ipVendorInfo As Long End Type Private Type Hostent h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list As Long End Type Private Type IP_OPTION_INFORMATION TTL As Byte Tos As Byte Flage As Byte OptionsSize As Long OptionsData As String * 128 End Type Private Type IP_ECHO_REPLY Address(0 To 3) As Byte Status As Long RoundTripTime As Long DataSize As Integer Reserved As Integer data As Long Options As IP_OPTION_INFORMATION End Type Public dir As String Public Function doPing(ByVal HostName As String) As Boolean Dim hFile As Long, lpWSAdata As WSAdata Dim hHostent As Hostent, AddrList As Long Dim Address As Long, rIP As String Dim OptInfo As IP_OPTION_INFORMATION Dim EchoReply As IP_ECHO_REPLY Call WSAStartup(&H101, lpWSAdata) If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent) CopyMemory AddrList, ByVal hHostent.h_addr_list, 4 CopyMemory Address, ByVal AddrList, 4 End If hFile = IcmpCreateFile() If hFile = 0 Then MsgBox " Unable to create file handle", vbCritical + vbOKOnly doPing = False Exit Function End If OptInfo.TTL = 255 If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3)) Else doPing = False End If If EchoReply.Status = 0 Then doPing = True Else doPing = False End If Call IcmpCloseHandle(hFile) Call WSACleanup End Function Private Sub Command1_Click() Dim i As Integer Dim x, y Dim result As Boolean Dim resultString As String If Trim(Text1) = "" Then MsgBox "Isikan Alamat IP", vbCritical + vbOKOnly Text1.SetFocus Exit Sub End If If Trim(Text2) = "" Then MsgBox "Isikan Batasan/Range Alamat IP", vbCritical + vbOKOnly Text2.SetFocus Exit Sub End If List1.Clear x = Split(Text1.Text, ".") y = Split(Text2.Text, ".") For i = CInt(x(3)) To CInt(y(3)) dir = x(0) & "." & x(1) & "." & x(2) & "." & i result = doPing(dir) If result = True Then resultString = "Aktif" Else resultString = "NonAktif" End If List1.AddItem "Pinging " & dir & "..." & resultString List1.Refresh Next End Sub Private Sub Command2_Click() List1.Clear Text1.Text = "" Text2.Text = "" List1.Refresh End Sub
Terimakasih, semoga bermanfaat.
Download Cek IP Aktif
0 komentar:
Posting Komentar