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