scanmain.frm

用VB做端口扫描和SQL Server连接器.rar这个工具就不多说了,看源码就知道.

      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