->>>>>DASAR MENGGUNAKAN VISUAL BASIC 6.0<<<<<-

    Apa itu Visual Basic? Kata “Visual” menun-
jukkan cara yang digunakan untuk membuat Graphical-
User Interface (GUI). Dengan cara ini Anda tidak-
lagi menuliskan instruksi pemrograman dalam kode-
kode baris, tetapi secara mudah Anda dapat melaku-
kan drag dan drop objek-objek yang akan Anda gunakan.

Kata “Basic” merupakan bagian bahasa BASIC-
(Beginners All Purpose Symbolic Instruction Code),-
yaitu sebuah bahasa pemrograman yang dalam sejarah-
nya sudah banyak digunakan oleh para programmer-
untuk menyusun aplikasi. Visual Basic dikembangkan
dari bahasa pemrograman BASIC.


1.1 Memulai Visual Basic 6.0
Setelah Anda menginstal program Visual Basic 6.0, Anda dapat
memulai dengan tombol Start yang ada pada task bar pada
Windows. Berikut langkah-langkahnya secara lengkap.
1. Tekan tombol Start dari Task bar pada Windows.
2. Pilih All Programs, dan arahkan ke pilihan Microsoft Visual
Studio 6.0 dan klik pada pilihan Microsoft Visual Basic 6.0.

Gambar 1.1 Membuka Program Visual Basic 6.0
3. Setelah Anda berhasil menjalankan Visual Basic untuk yang
pertama kalinya, Anda akan melihat tampilan logo Visual Basic
6.0 dan tak lama kemudian akan muncul kotak dialog berikut.

Gambar 1.2 Kotak Dialog New Project
4. Kotak dialog tersebut meminta konfirmasi kepada Anda untuk
memilih tipe proyek yang ingin Anda buat. Dalam hal ini, pilih
tipe proyek VB Enterprise Edition Constrols. Tekan tombol Open
untuk melanjutkan.

Gambar 1.3 Kotak Dialog Pemilihan Tipe Proyek
5. Dengan pemilihan tipe VB Enterprise Edition Controls di atas,
seorang pengguna tidak perlu lagi capek-capek menambahkan
komponen-komponen yang diperlukan. Hal itu karena pada tipe
proyek tersebut sudah menyediakan komponen-komponen secara
lengkap. Tekan tombol Open untuk melanjutkan.
6. Setelah menekan tombol Open, akan muncul sebuah layar
program Visual Basic dengan disertai komponen-komponen
lengkap yang ada pada bagian General atau Toolbox.

Gambar 1.4 Tampilan Interface Visual Basic
7. Tampilan di atas dapat disebut dengan lingkungan Integrated
Development Environment (IDE). Pada lingkungan tersebut,
Anda dapat melakukan berbagai aktivitas seperti proses editing,
compiling, dan debugging.


1.2 Mengenal Elemen Visual Basic 6.0
Setelah Anda berhasil membuka Visual Basic pada layar, Anda akan
menemukan interface program Visual Basic seperti Gambar 1.4.
Terlihat bahwa interface tersebut terdiri atas beberapa elemen.

1.2.1 Menu Bar
Menu Bar akan menampilkan perintah-perintah yang dapat Anda
gunakan saat Anda bekerja pada Visual Basic. Secara default, menu
bar ini memiliki pilihan File, Edit, View, Window, Query, Diagram,
Tools, Add-Ins, dan Help. Disamping itu, sehubungan dengan
pemrograman, terdapat menu yang bisa diakses, misalnya Project,
Format, Debug, atau Run.

Gambar 1.5 Tampilan Menu Bar
Jika masing-masing menu bar tersebut diklik, Visual Basic akan
menampilkan daftar pilihan dari menu bar yang Anda klik tadi.

1.2.2 Context Menu
Context Menu berisi shortcut yang suatu saat bisa Anda gunakan
untuk membuka sebuah context menu suatu objek. Untuk membuka
Context Menu ini, Anda dapat mengklik kanan objek yang akan
Anda buka Context Menu-nya. Berikut tampilan gambarnya.


Gambar 1.6 Tampilan Context Menu
Context Menu di atas, kami ambilkan dari Designer Form, yaitu
dengan cara mengklik kanan Form Designer.

1.2.3 Toolbar
Fasilitas ini dapat mempercepat pengaksesan perintah-perintah yang
ada dalam pemrograman. Anda dapat mengklik tombol-tombol
dalam toolbar ini untuk melakukan aksi tertentu. Secara standar,
toolbar jenis Standard yang akan ditampilkan saat Anda memulai
Visual Basic.
Jika Anda ingin mengatur tampilan toolbar yang lain, Anda dapat
menggunakan pilihan Toolbar pada menu bar View.

Gambar 1.7 Tampilan Toolbar

1.2.4 Toolbox
Sebuah window yang berisi tombol-tombol control yang akan Anda
gunakan untuk mendesain atau “Membangun” sebuah form atau
report. Selain tombol control di bawah, Anda juga dapat mendefinisikan
atau menambah sendiri tombol control yang lain.

Gambar 1.8 Tampilan Toolbox Tipe Standard

Gambar 1.9 Tampilan Toolbox Tipe VB Enterprise Edition Controls
Tampil tidaknya window ini dapat Anda atur dari pilihan Toolbox
yang ada pada menu bar View - Toolbox.

1.2.5 Window Project Explorer
Window Project Explorer ini menampilkan daftar form, modul, serta
objek lain yang ada dalam project yang aktif. Sebuah Project merupakan
sekumpulan file yang Anda gunakan untuk membangun
sebuah aplikasi. Berikut tampilan gambarnya.

Gambar 1.10 Tampilan Window Project Explorer

1.2.6 Window Properties
Window Properties ini dapat Anda gunakan untuk mengatur propertie
sebuah objek atau control yang Anda pilih. Sebuah property merupakan
karakteristik objek, seperti size, caption, text, atau color.

Gambar 1.11 Tampilan Window Properties

1.2.7 Objek Browser
Objek Browser ini merupakan daftar objek yang ada dalam project
yang aktif. Anda dapat menggunakan Object Browser untuk menampilkan
objek yang ada dalam Visual Basic dan aplikasi lain.
Untuk menampilkan objek ini Anda dapat menggunakan cara View
- Object Browser. Berikut tampilan gambarnya.

Gambar 1.12 Tampilan Object Browser

1.2.8 Form Designer
Form Designer adalah sebuah window yang dapat Anda gunakan
untuk mengatur tampilan aplikasi yang Anda susun, atau dengan
kata lain sebagai tempat untuk mendesain sebuah form. Dalam form
ini Anda dapat menambahkan control, grafik, dan gambar ke dalam
form pada posisi yang Anda inginkan. Setiap form memiliki window
designer form sendiri-sendiri. Berikut tampilan gambarnya.

Gambar 1.13 Tampilan Form Designer

1.2.9 Window Code Editor
Window Code Editor merupakan sebuah tampilan window yang
digunakan untuk memasukkan kode aplikasi. Window Code Editor
ini digunakan untuk mendefinisikan kode-kode form atau kode
modul dalam sebuah aplikasi. Berikut tampilan gambarnya.

Gambar 1.14 Tampilan Window Code Editor

1.2.10 Window Form Layout
Window Form Layout dapat digunakan untuk mengontrol posisi form
pada aplikasi Anda menggunakan sistem grafik dalam sebuah layar.
Dengan fasilitas ini, Anda dapat melihat dan mengetahui posisi form
yang baru Anda desain. Berikut tampilan gambarnya.

Gambar 1.15 Tampilan Window Form Layout

1.2.11 Window Immmediate, Local, dan Watch
Window-window ini merupakan window tambahan yang digunakan
untuk proses debug aplikasi Anda. Window-window ini hanya dapat
Anda gunakan jika Anda menjalankan aplikasi dengan interface
Visual Basic. Untuk menampilkan window-window ini, Anda dapat
melakukannya dengan cara View - Name Window.

Gambar 1.16 Tampilan Window Immediate

Gambar 1.17 Tampilan Window Locals

Gambar 1.18 Tampilan Window Watches

Rabu, 05 Maret 2008

CONVERT MSACCESS TO ORACLE

 Source code dibawah ini merupkan code untuk meng-
konverikan suatu database msAccess ke Oracle.
1. Buatlah 1 Project(name=Convert.vbp)
2. Tambahkan 1 Form(name=FrmAccessToOracle)
3. Tambahkan 1 SSTab(Tabs=3,TabsPerRow=3)
a. Tab=0,caption=1.Asal Database
Tambahkan Label1(caption=Nama MsAccse-
ss Database),TextBox(name=TxMdbName),
CommandButton(name=CmdBrowse,Caption=
Browse),CheckBox(name=CheckPassword,cap-
tion=Password),TextBox(name=TxPassword,
PasswordChar=*),Label(name=LabelOpenMsA-
ccess,Capt=open MsAccess database. . . .)
CommandButton(name=CmdCancel1,Capt=Batal)
CommandButton(name=CmdNext1,Capt=Beriku-
tnya >),Commondialog.
b. Tab=1,capt=2.Target Database
Tambahkan Label(Capt=Database),TextBox(
name=TxDatabaseOracle),label(Capt=User
Name),TextBox(name=TxUserOracle),Label
(Capt=Password),TextBox(name=TxPasswordOr-
acle),CommandButton(name=CmdOpenConnection,
Open connection)Label(name=LabelOpenOracle,
Capt=Open connection Oracle Database.....)
CommandButton(name=CmdCancel2,Capt=Batal)
CommandButton(name=CmdBack2,capt= nya)CommandButton(name=CmdNext2,capt=Beri-
kutnya>)
c. Tab=2,capt=3.Pilih Tabel
Label(capt=Daftar Tabel)ListBox(name=ListA-
vailableTable)CommandButton(name=CmdAdd,Ca-
pt=Tambahkan>)CommandButton(name=CmdAddAll,
Capt=Tambahkan semua>>)CommandButton(name=
CmdRemove,capt=< Buang)commandButton(name=
CmdRemoveAll,capt=<< Buang Semua)Label(Capt=
Table Yang Dipilih)ListBox(name=ListSele-
ctedTable)Label(name=LabelProsesTbl,capt=
LabelProses Tabel)CommandButton(name=CmdC-
ancel3,capt=Batal)CommandButton(name=CmdP-
rev3,capt=< Kembali)CommandButton(name=Cm-
dConvert,capt=Convert)


Copy coding dibawah ini dan paste di Editor Form:

Option Explicit
Dim CnAccess, CnOracle As ADODB.Connection
Dim cat As ADOX.Catalog

Private Sub CheckPassword_Click()
If CheckPassword.Value = 0 Then
TxPassword.Enabled = False
Else
TxPassword.Enabled = True
End If
End Sub

Private Sub CmdAdd_Click()
Dim i As Byte
i = 0
Do
If ListAvailableTable.Selected(i) Then
ListSelectedTable.AddItem ListAvailableTable.List(i)
ListAvailableTable.RemoveItem (i)
End If
i = i + 1
Loop While i <= ListAvailableTable.ListCount - 1

End Sub

Private Sub CmdAddAll_Click()
Dim i As Byte
i = 0
Do
ListSelectedTable.AddItem ListAvailableTable.List(i)
i = i + 1
Loop While i <= ListAvailableTable.ListCount - 1
ListAvailableTable.Clear
End Sub

Private Sub CmdBack2_Click()
SSTab1.Tab = 0
End Sub

Private Sub CmdBrowse_Click()
CommonDialog1.CancelError = True
CommonDialog1.Filter = "*.mdb"
CommonDialog1.FileName = "*.mdb"
On Error GoTo Batal
CommonDialog1.ShowOpen
TxMdbName.Text = CommonDialog1.FileName
Batal:
End Sub

Private Sub CmdCancel1_Click()
Unload Me
End Sub

Private Sub CmdCancel2_Click()
Unload Me
End Sub

Private Sub CmdCancel3_Click()
Unload Me
End Sub

Private Sub CmdConvert_Click()
ExportTablesADO
LabelProsesTbl.Caption = ""
End Sub

Private Sub CmdNext1_Click()
Dim strCn As String
Dim NTbl, i As Byte
Dim X As ADOX.Table
On Error GoTo BatalBuka
LabelOpenMsAccess.Visible = True
Me.Refresh
strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
strCn = strCn & TxMdbName.Text
strCn = strCn & ";Persist Security Info=False"
If CnAccess.State = 1 Then CnAccess.Close
CnAccess.Open strCn
cat.ActiveConnection = CnAccess

ListSelectedTable.Clear
ListAvailableTable.Clear
NTbl = cat.Tables.Count ' - 1
For Each X In cat.Tables
' If cat.Tables.Item(i).Type = "TABLE" Then
' ListAvailableTable.AddItem cat.Tables.Item(i).Name
' End If
If X.Type = "TABLE" Then
ListAvailableTable.AddItem X.Name
End If
Next
SSTab1.Tab = 1
LabelOpenMsAccess.Visible = False

Exit Sub
BatalBuka:
LabelOpenMsAccess.Visible = False
MsgBox "Tidak bisa connect dengan MsAccess"
End Sub

Private Sub CmdNext2_Click()
Dim strCn As String
LabelOpenOracle.Visible = True
Me.Refresh
strCn = "Provider=OraOLEDB.Oracle.1;Persist Security Info=False;" & _
"User ID=" & TxUserOracle.Text & ";" & _
"Password=" & TxPasswordOracle.Text & ";" & _
"Data Source=" & TxDatabaseOracle.Text

On Error GoTo BatalConnect
If CnOracle.State = 1 Then CnOracle.Close
CnOracle.Open strCn
LabelOpenOracle.Visible = False
SSTab1.Tab = 2
Exit Sub
BatalConnect:
LabelOpenOracle.Visible = False
MsgBox "Tidak bisa connect dengan Oracle"
End Sub

Private Sub ExportTablesADO()
Dim aRs, oRs As ADODB.Recordset
Dim TblName, TblAName, TblOName As String
Dim NTbl, NFld, NIdx, NICol As Byte
Dim i, j, k As Integer

Dim StrTbl, StrFld As String
Dim StrIdx As String
Dim idxField As String

Dim Nkey As Byte
Dim StrKey As String
Dim keyName, keyType As String
Dim keyRelatedTable As String
Dim keyField As String
Dim keyRelatedField As String

Set aRs = New ADODB.Recordset
Set oRs = New ADODB.Recordset
aRs.ActiveConnection = CnAccess
aRs.CursorLocation = adUseClient
aRs.CursorType = adOpenStatic
aRs.LockType = adLockReadOnly


On Error GoTo GagalExport
NTbl = ListSelectedTable.ListCount - 1
For i = 0 To NTbl
'Create Table
TblAName = "[" & ListSelectedTable.List(i) & "]"
TblOName = CekSpasi(CStr(ListSelectedTable.List(i)))
TblName = ListSelectedTable.List(i)
StrTbl = "CREATE TABLE " & TblOName & vbCrLf & " ("

aRs.Open "Select * From " & TblAName
NFld = aRs.Fields.Count - 1
LabelProsesTbl.Caption = TblName
Me.Refresh

For j = 0 To NFld
LabelProsesTbl.Caption = TblName & "/" & "Create table"
Me.Refresh
StrFld = CekSpasi(CStr(aRs.Fields(j).Name)) & " "
Select Case aRs.Fields(j).Type
Case 202 'Text
StrFld = StrFld & "VARCHAR2 " & "(" & aRs.Fields(j).DefinedSize & ")"
Case 203 'Memo
StrFld = StrFld & "CLOB"
Case 3 'Long
StrFld = StrFld & "NUMBER(11)"
Case 17 'Byte
StrFld = StrFld & "NUMBER(3)"
Case 2 'Integer
StrFld = StrFld & "NUMBER(5)"
Case 4 'Single
StrFld = StrFld & "REAL"
Case 5 'Double
StrFld = StrFld & "FLOAT"
Case 72 'Replication ID
StrFld = StrFld & "RAW(16)"
Case 7 'Date
StrFld = StrFld & "DATE"
Case 131 'Decimal
StrFld = StrFld & "NUMBER(18,0)"
Case 6 'Currency
StrFld = StrFld & "NUMBER(18,2)"
Case 11 'YesNo
StrFld = StrFld & "NUMBER(3)"
Case 205 'OLE
StrFld = StrFld & "BLOB"
Case 20 'Hyperlink
StrFld = StrFld & "CLOB"
Case Else
StrFld = StrFld & "VARCHAR2 " & "(" & aRs.Fields(j).DefinedSize & ")"
End Select
If j < NFld Then
StrFld = StrFld & ","
End If
StrTbl = StrTbl & StrFld

Next

'Add Index
StrIdx = ""
If cat.Tables(TblName).Indexes.Count > 0 Then
NIdx = cat.Tables(TblName).Indexes.Count - 1
TblName = cat.Tables(TblName).Name

For j = 0 To NIdx
If cat.Tables(TblName).Indexes.Item(j).PrimaryKey Then
LabelProsesTbl.Caption = TblName & "/" & "Add index"
Me.Refresh
StrIdx = "Primary Key ("
NICol = cat.Tables(TblName).Indexes.Item(j).Columns.Count - 1
For k = 0 To NICol
idxField = CekSpasi(CStr(cat.Tables(TblName).Indexes.Item(j).Columns.Item(k).Name))
StrIdx = StrIdx & idxField
If k < NICol Then
StrIdx = StrIdx & ","
Else
StrIdx = StrIdx & ")"
End If
Next
End If
Next
End If
If StrIdx <> "" Then
StrTbl = StrTbl & ", " & vbCrLf & StrIdx
End If

StrTbl = StrTbl & ") "

CnOracle.Execute StrTbl
StrTbl = ""

'Export data
LabelProsesTbl.Caption = TblName & "/" & "export data"
Me.Refresh
oRs.CursorLocation = adUseServer
oRs.LockType = adLockOptimistic
oRs.CursorType = adOpenDynamic
oRs.Open "Select * From " & TblOName, CnOracle
j = aRs.Fields.Count - 1
While Not aRs.EOF
oRs.AddNew
For k = 0 To j
oRs.Fields(k).Value = aRs.Fields(k).Value
Next
oRs.Update
aRs.MoveNext
Wend
oRs.Close
aRs.Close
Next i

'Add Check constraint
For i = 0 To NTbl
TblName = ListSelectedTable.List(i)
TblOName = CekSpasi(CStr(TblName))
NFld = cat.Tables(ListSelectedTable.List(i)).Columns.Count - 1

k = 0
For j = 0 To NFld
If cat.Tables(TblName).Columns(j).Properties.Item(8).Value <> "" Then
LabelProsesTbl.Caption = TblName & "/" & "Add CHECK constraint "
Me.Refresh
k = k + 1
StrTbl = "ALTER TABLE " & TblOName & " ADD CONSTRAINT "
StrTbl = StrTbl & TblOName & Format(k, "00") & vbCrLf & "CHECK ("
StrTbl = StrTbl & cat.Tables(TblName).Columns(j).Name & " "
StrTbl = StrTbl & cat.Tables(TblName).Columns(j).Properties.Item(8).Value
StrTbl = StrTbl & ") ENABLE Validate"
CnOracle.Execute StrTbl
End If
Next

Next i

'Add Foreign key
For i = 0 To NTbl
TblAName = "[" & ListSelectedTable.List(i) & "]"
TblOName = CekSpasi(CStr(ListSelectedTable.List(i)))
TblName = ListSelectedTable.List(i)

If cat.Tables(TblName).Keys.Count > 0 Then
Nkey = cat.Tables(TblName).Keys.Count - 1
LabelProsesTbl.Caption = TblName & "/" & "Add Foreign key constraint"
Me.Refresh
'TblOName = CekSpasi(CStr(cat.Tables(TblName).Name))
For j = 0 To Nkey
StrKey = ""
If cat.Tables(TblName).Keys.Item(j).Type = 2 Then
keyName = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Name))
keyRelatedTable = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).RelatedTable))
StrKey = "ALTER TABLE " & TblOName & " ADD (FOREIGN KEY ("
NICol = cat.Tables(TblName).Keys.Item(j).Columns.Count - 1
For k = 0 To NICol
idxField = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Columns.Item(k).Name))
StrKey = StrKey & idxField
If k < NICol Then
StrKey = StrKey & ","
Else
StrKey = StrKey & ")"
End If
Next
StrKey = StrKey & " References " & keyRelatedTable & " ("
For k = 0 To NICol
keyRelatedField = CekSpasi(CStr(cat.Tables(TblName).Keys.Item(j).Columns.Item(k).RelatedColumn))
StrKey = StrKey & keyRelatedField
If k < NICol Then
StrKey = StrKey & ","
Else
StrKey = StrKey & ")"
End If
Next
StrKey = StrKey & ")"

CnOracle.Execute StrKey

End If
Next
End If
Next i
LabelProsesTbl.Caption = "Selesai"
Me.Refresh
MsgBox "Export ke oracle Selesai"

Exit Sub
GagalExport:
MsgBox "Export ke oracle gagal " & vbCrLf & _
Err.Description

End Sub


Private Sub CmdPrev3_Click()
SSTab1.Tab = 1
End Sub

Private Sub CmdRemove_Click()
Dim i As Byte
i = 0
Do
If ListSelectedTable.Selected(i) Then
ListAvailableTable.AddItem ListSelectedTable.List(i)
ListSelectedTable.RemoveItem (i)
End If
i = i + 1
Loop While i <= ListSelectedTable.ListCount - 1

End Sub

Private Sub CmdRemoveAll_Click()
Dim i As Byte
i = 0
Do
ListAvailableTable.AddItem ListSelectedTable.List(i)
i = i + 1
Loop While i <= ListSelectedTable.ListCount - 1
ListSelectedTable.Clear
End Sub


Private Sub Form_Load()
Dim i, NTbl As Integer
Set CnAccess = New ADODB.Connection
Set CnOracle = New ADODB.Connection
Set cat = New ADOX.Catalog
TxMdbName.Text = ""
CheckPassword.Value = 0
TxPassword.Enabled = False
SSTab1.Tab = 0
TxDatabaseOracle.Text = ""
TxUserOracle.Text = ""
TxPasswordOracle.Text = ""
LabelOpenMsAccess.Visible = False
LabelOpenOracle.Visible = False
LabelProsesTbl.Caption = ""
End Sub

Private Function CekSpasi(X As String) As String
CekSpasi = Replace(RTrim(X), " ", "_")
End Function

Selasa, 04 Maret 2008

MENGECEK IP AKTIF


Source code dibawah ini merupakan
suatu program untuk mengecek suatu Host Yang
aktif yaitu untuk mengetahui komputer mana
saja yang sedang aktif.
1. Bukalah 1 Project(name=ActiveIP.vbp)
2. Tambah 1 Form(name=frmCekIP)tambahkan:
a. 1 ListBox
b. 2 TextBox
c. 1 CommandButton(name=CekIP)


Copy coding dibawah ini dan paste di Editor 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&, ipWSAdata 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

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
Flags 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, ipWSAdata 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, ipWSAdata)
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 = 225
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
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 = "Non-aktif"
End If
List1.AddItem "Pinging" & dir & "..." & resultString
List1.Refresh
Next
End Sub

Senin, 03 Maret 2008

CEK PORT TERBUKA



Source code berikut merupakan program
untuk mencari Port yang terbuka.
1. Bukalah 1 Project(name:Port_Scanner.vbp)
2. Tambahkan 1 Form(name:frmPortScanner)
Tambahkan:
a. 5 TextBox dengan:
Textbox1(name=TxtIP)
Textbox2(name=TxtFrom)
Textbox3(name=TxtTo)
Textbox4(name=TxtTime)
Textbox5(name=TxtData)
b. 2 Timer dengan
Timer1(name=TmrConnected,enable=false)
Timer2(name=TimeOut,enable=false)
c. 1 commandButton(name=scan)
d. Winsock(name=sckScan)untuk menambahkan
kontrol winsock dari menu Project-Components
-beri tanda cek pada Microsoft Wincock
control 6.0
e. 1 Label(name=Lblscan)
f. 1 ListBox(name=LstResult)


Copy coding dibawah ini dan paste di Editor Form:
 
Option Explicit
Dim Port As Single
Dim Scanning As Boolean
Dim RemoteOS As String
Dim PortType As Integer

Private Sub CmdScan_Click()
If Scanning = False Then
PortType = 0
LstResult.Clear
LstResult.AddItem " Port: service:"
LstResult.AddItem "=============================================="
TxtFrom.Enabled = False
TxtIP.Enabled = False
TxtTime.Enabled = False
TxtTo.Enabled = False
TxtData.Enabled = False
CmdScan.Caption = "&Cancel"
Scanning = True
Port = TxtFrom.Text + 1
BeginScan
Else
TxtFrom.Enabled = True
TxtIP.Enabled = True
TxtTime.Enabled = True
TxtTo.Enabled = True
TxtData.Enabled = True
CmdScan.Caption = "&Scan Again"
Scanning = False
TimeOut.Enabled = False
TmrConnected.Enabled = False
sckScan.Close
Port = TxtTo.Text
LblScan.Caption = ""
End If
End Sub

Private Sub sckScan_Connect()
TimeOut.Enabled = False
sckScan.SendData "GET abcdef.htm" & vbCrLf & "USER abcdef" & vbCrLf & "FINGER abcdef" & vbCrLf
TmrConnected.Interval = TxtData.Text
TmrConnected.Enabled = True
End Sub

Private Sub sckScan_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
sckScan.GetData Data, vbString
If InStr(1, Data, vbLf) <> 0 Then
RecognizePort Data
sckScan.Close
Port = Port + 1
BeginScan
End If
End Sub

Private Sub TimeOut_Timer()
TimeOut.Enabled = False
Port = Port + 1
BeginScan
End Sub

Private Sub TmrConnected_Timer()
LstResult.AddItem Format(sckScan.RemotePort, " #00000 --------->>") & " >Gue ga' tau...."
TmrConnected.Enabled = False
Port = Port + 1
BeginScan
End Sub

Private Sub BeginScan()
If Port <= TxtTo Then
sckScan.Close
sckScan.RemoteHost = TxtIP.Text
sckScan.RemotePort = Port
LblScan.Caption = " Port: " & Port & " @ " & sckScan.RemoteHost
sckScan.Connect
TimeOut.Interval = TxtTime.Text
TimeOut.Enabled = True
On Error Resume Next
Else
Call CmdScan_Click
End If
End Sub

Private Sub RecognizePort()
Dim MyType As String
If InStr(1, Data, "FTP") > 0 Then
MyType = "FTP Server"
If InStr(1, Data, "Serv-U") > 0 Then
MyType = MyType & "(Serv-U)"
End If
ElseIf InStr(1, UCase(Data), "HTTP") > 0 Or _
InStr(1, UCase(Data), "HTML") > 0 Then
MyType = "HTTP Server"
If InStr(1, Data, "Microsoft") > 0 Then
MyType = MyType & "(Microsoft)"
ElseIf InStr(1, Data, "Apache") > 0 Then
MyType = MyType & "(Apache)"
End If
ElseIf InStr(1, UCase(Data), "MAIL") > 0 Then
MyType = "MAIL Server"
If InStr(1, Data, "Microsoft") > 0 Then
MyType = MyType & "(Microsoft)"
End If
ElseIf InStr(1, UCase(Data), "IMAP") > 0 Then
MyType = "IMAP Server"
If InStr(1, Data, "Microsoft") > 0 Then
MyType = MyType & "(Microsoft)"
ElseIf InStr(1, UCase(Data), "NNTP") > 0 Then
MyType = "NNTP Server"
If InStr(1, Data, "Microsoft") > 0 Then
MyType = MyType & "(Microsoft)"
End If
ElseIf InStr(1, UCase(Data), "NOTICE AUTH") > 0 Then
MyType = "IRC Server"
ElseIf InStr(1, Data, "ERROR: Your host is trying too (re)connect too fast") > 0 Then
MyType = "IRC Server"
ElseIf Mid(Data, 1, Len("GET abscdef.htm")) = "GET abcdef.htm" Then
MyType = "PING Server"
Else
MyType = "Ora Ngerti...."
End If
LstResult.AddItem Format(sckScan.RemotePort, " #00000 --------->>") & " >" & MyType
End Sub