Begin VB.Timer Timer1 
         Enabled         =   0   'False
         Interval        =   100
         Left            =   3000
         Top             =   240
      End
      Begin MSWinsockLib.Winsock Ws 
         Index           =   0
         Left            =   3600
         Top             =   240
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin VB.TextBox TxtStart 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   1080
         TabIndex        =   1
         Text            =   "127.0.0.1"
         Top             =   280
         Width           =   3495
      End
      Begin VB.Label Label1 
         Caption         =   "IP地址"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
   End
End
Attribute VB_Name = "MainFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const TitleInfo As String = "程序制作紅色銀狐"
Public LstTotal As Long
Public lngNextPort As Long
'--------------------------------------------------------------------------------------------------
'添加指定端口
'--------------------------------------------------------------------------------------------------
Private Sub cmdAddPort_Click()
    Dim iPort As Long
    iPort = Val(TxtPort.Text)
    If Len(iPort) = 0 Or IsNumeric(iPort) = False Or iPort > 65535 Or iPort = 0 Then
        Exit Sub
    End If
    LstPorts.AddItem iPort
    TxtPort.Text = ""
End Sub
'--------------------------------------------------------------------------------------------------
'添加排序端口
'--------------------------------------------------------------------------------------------------
Private Sub cmdAddPorts_Click()
    Dim i As Long
    Dim sTxtsNumber As String, sTxtbNumber
    LstPorts.Clear
    sTxtsNumber = Val(TxtsNumber.Text)
    sTxtbNumber = Val(TxtbNumber.Text)
    If IsNumeric(sTxtsNumber) = False Or IsNumeric(sTxtbNumber) = False Then
        Exit Sub
    End If
    For i = sTxtsNumber To sTxtbNumber
        LstPorts.AddItem i
    Next
End Sub
'--------------------------------------------------------------------------------------------------
'單擊全部清除
'--------------------------------------------------------------------------------------------------
Private Sub cmdClear_Click()
    LstPorts.Clear
End Sub
'--------------------------------------------------------------------------------------------------
'開始掃描
'--------------------------------------------------------------------------------------------------
Private Sub cmdScan_Click()
    Dim StrCaption As String, StratIP As String
    Dim i As Long
    LstTotal = LstPorts.ListCount
    If LstTotal = 0 Then
        MsgBox "請添加要掃描的端口！", vbExclamation, TitleInfo
        Exit Sub
    End If
    Bar1.Max = LstTotal
    StrCaption = cmdScan.Caption
    StratIP = TxtStart.Text
    ResultFrm.ListView1.ListItems.Clear
    Select Case StrCaption
        Case "開始掃描"
            cmdScan.Caption = "終止掃描"
            Slider1.Enabled = False
            Slider2.Enabled = False
            Frame2.Enabled = False
            Timer1.Enabled = True
            Bar1.Value = 0
            lngNextPort = 0
            On Error Resume Next
            For i = 1 To Val(Slider1.Value)
                '加載線程
                Load Ws(i)
                Ws(i).Close
                DoEvents
                Ws(i).Connect StratIP, LstPorts.List(lngNextPort)
            Next
            cmdScan.Enabled = True
            ResultFrm.Top = MainFrm.Top
            ResultFrm.Left = MainFrm.Left + MainFrm.Width
            ResultFrm.Height = MainFrm.Height
            ResultFrm.Show
        Case "終止掃描"
            cmdScan.Caption = "開始掃描"
            Slider1.Enabled = True
            Slider2.Enabled = True
            Frame2.Enabled = True
            Timer1.Enabled = False
            Bar1.Value = 0
            lngNextPort = 0
            On Error Resume Next
            For i = 1 To Val(Slider1.Value)
                Ws(i).Close
                DoEvents
                '卸載線程
                Unload Ws(i)
                DoEvents
            Next
            cmdScan.Enabled = True
    End Select
End Sub
'--------------------------------------------------------------------------------------------------
'窗體卸載
'--------------------------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
    Unload SqlFrm
    Unload ResultFrm
    Unload MainFrm
End Sub
'----------------------------------------------------------------------------------------
'雙擊選中刪除
'----------------------------------------------------------------------------------------
Private Sub LstPorts_DblClick()
    Dim i As Long
    For i = LstPorts.ListCount - 1 To 0 Step -1
        If LstPorts.Selected(i) = True Then
            LstPorts.RemoveItem (LstPorts.ListIndex)
            Exit For
        End If
    Next
End Sub
'----------------------------------------------------------------------------------------
'鼠標移動提示
'----------------------------------------------------------------------------------------
Private Sub LstPorts_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    LstPorts.ToolTipText = "雙擊刪除選中"
End Sub
'--------------------------------------------------------------------------------------------------
'狀態欄顯示端口和IP進度
'--------------------------------------------------------------------------------------------------
Private Sub Timer1_Timer()
    ResultFrm.StatusBar1.Panels(1).Text = "當前端口號: " & LstPorts.List(lngNextPort)
End Sub
'--------------------------------------------------------------------------------------------------
'窗體拖動后也不變化位置
'--------------------------------------------------------------------------------------------------
Private Sub Timer2_Timer()
    If Me.WindowState <> 1 Then
        ResultFrm.Top = MainFrm.Top
        ResultFrm.Left = MainFrm.Left + MainFrm.Width
        ResultFrm.Height = MainFrm.Height
    End If
End Sub
'--------------------------------------------------------------------------------------------------
'Winsock控件連接時
'--------------------------------------------------------------------------------------------------
Private Sub Ws_Connect(Index As Integer)
    ResultFrm.ListView1.ListItems.Add , , Ws(Index).RemoteHost
    ResultFrm.ListView1.ListItems(ResultFrm.ListView1.ListItems.Count).ListSubItems.Add , , Ws(Index).RemotePort
    Call Try_Next_Port(Index)
End Sub
'--------------------------------------------------------------------------------------------------
'繼續下一個端口
'--------------------------------------------------------------------------------------------------
Private Sub Try_Next_Port(Index As Integer)
    On Error Resume Next
    Dim i As Long
    Ws(Index).Close
    If Bar1.Value < LstTotal Then
        Bar1.Value = Bar1.Value + 1
    End If
    If lngNextPort < LstTotal Then
        Ws(Index).Connect , LstPorts.List(lngNextPort)
        lngNextPort = lngNextPort + 1
    Else
        Unload Ws(Index)
        ResultFrm.StatusBar1.Panels(1).Text = "掃描完成"
        cmdScan.Caption = "開始掃描"
        Slider1.Enabled = True
        Slider2.Enabled = True
        Frame2.Enabled = True
        cmdScan.Enabled = True
        Timer1.Enabled = False
        lngNextPort = 0
        For i = 1 To Slider1.Value
            Ws(i).Close
            DoEvents
            '卸載線程
            Unload Ws(i)
            DoEvents
        Next
    End If
End Sub
'--------------------------------------------------------------------------------------------------
'Winsock控件錯誤
'--------------------------------------------------------------------------------------------------
Private Sub Ws_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Call Try_Next_Port(Index)
End Sub