Oncelikle Formumuza Aşağıdaki nesneleri ekleyelim.
Nesne -------------------- İsim
Winsock -------------- Winsock1
Label ------------------ Label1
Label ------------------ Label2
Label ------------------ Label3
Label ------------------ Hangi
Progressbar ------------ lblProgress
Textbox ---------------- txtbaslangıc
Textbox ---------------- txtbitis
Textbox ---------------- txtdurum
Listbox ----------------- List1
Command Buton ------- cmdstart
Command Buton ------- cmddur
Programın Goruntusu
'Resim ekleyemedim, malum mesaj sayısı
Şimdi gelelim kodlara
Kod:
'General Declarations Dim zaman As Boolean Private Sub cmddur_Click() cmddur.Enabled = False cmdstart.Enabled = True zaman = False txtdurum.Text = txtdurum + vbCrLf + vbCrLf + " Tarama Durduruldu..." End Sub Private Sub cmdstart_Click() txtdurum.Text = "" txtdurum.Text = "Tarama başladı..." + vbCrLf + vbCrLf + "Taranan port aralağı : " + txtbaslangıc + " - " + txtbitis cmddur.Enabled = True cmdstart.Enabled = False List1.Clear lblProgress.Value = 0 lblProgress.Max = txtbitis - txtbaslangıc + 1 On Error GoTo hata zaman = True For I = txtbaslangıc To txtbitis If zaman = False Then Exit Sub DoEvents Winsock1.Close Winsock1.LocalPort = I Winsock1.Listen hangi.Caption = I lblProgress.Value = lblProgress.Value + 1 If I = txtbitis Then txtdurum.Text = txtdurum + vbCrLf + vbCrLf + "Tarama bitti ..." cmdstart.Enabled = True cmddur.Enabled = False End If Next Exit Sub hata: List1.AddItem ("Bulunan Acık Port : " & Val(I)) Resume Next End Sub Private Sub Form_Load() Label1.Caption = "Başlangıc Portu :" Label2.Caption = "Bitiş Portu :" Label3.Caption = "Taranan Port :" hangi.Caption = "" Me.Caption = "Port Scanner 1.0 - SceenmewaR ?" End Sub Private Sub txtbaslangıc_Change() If txtbaslangıc > "" Then If txtbaslangıc < 1 Then txtbaslangıc = 0 End If End Sub Private Sub txtbaslangıc_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then KeyAscii = 0 End If End Sub Private Sub txtbitis_Change() If txtbitis > "" Then If txtbitis > 65531 Then txtbitis = 65531 End If End Sub Private Sub txtbitis_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then KeyAscii = 0 End If End Sub
Not: Winsock nesnesini eklemek icin "Ctrl + T" yaparak "Microsoft Winsock Control 6.0" ve progressbar nesnesini eklemek icin "Microsoft Windows Common Controls 6.0 (SP6)" ı şecmelisiniz.
Selametle.....
__________________