frmmain.frm

VB快速端口扫描器的源代码

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Caption         =   "极速端口扫描工具 Ver 1.0"
   ClientHeight    =   5055
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9510
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5055
   ScaleWidth      =   9510
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "超时(秒)"
      Height          =   615
      Index           =   2
      Left            =   6480
      TabIndex        =   19
      Top             =   780
      Width           =   1575
      Begin VB.TextBox txtTimeout 
         Alignment       =   1  'Right Justify
         Height          =   285
         Left            =   120
         TabIndex        =   20
         Text            =   "0.125"
         Top             =   240
         Width           =   1320
      End
   End
   Begin MSComctlLib.ProgressBar pgbrPorts 
      Height          =   375
      Left            =   3840
      TabIndex        =   5
      Top             =   1560
      Visible         =   0   'False
      Width           =   2415
      _ExtentX        =   4260
      _ExtentY        =   661
      _Version        =   393216
      Appearance      =   1
   End
   Begin MSComctlLib.StatusBar sbMain 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   18
      Top             =   4680
      Width           =   9510
      _ExtentX        =   16775
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   11139
            Text            =   "完毕"
            TextSave        =   "完毕"
            Key             =   "Info"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            TextSave        =   "2006-11-27"
            Key             =   "Date"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            TextSave        =   "16:52"
            Key             =   "Time"
         EndProperty
      EndProperty
   End
   Begin VB.Frame Frame1 
      Caption         =   "Winsocks连接号"
      Height          =   615
      Index           =   1
      Left            =   6480
      TabIndex        =   13
      Top             =   120
      Width           =   1575
      Begin VB.TextBox txtWinsocks 
         Alignment       =   1  'Right Justify
         Height          =   285
         Left            =   120
         TabIndex        =   14
         Text            =   "200"
         Top             =   240
         Width           =   1320
      End
   End
   Begin VB.Frame framePortsToScan 
      Caption         =   "端口检查方式"
      Height          =   1335
      Left            =   3360
      TabIndex        =   3
      Top             =   120
      Width           =   3015
      Begin VB.OptionButton optPortOptions 
         Caption         =   "手动"
         Height          =   255
         Index           =   2
         Left            =   135
         TabIndex        =   11
         Top             =   960
         Value           =   -1  'True
         Width           =   855
      End
      Begin VB.OptionButton optPortOptions 
         Caption         =   "已知特洛伊木马/后门程序"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   10
         Top             =   600
         Width           =   2775
      End
      Begin VB.TextBox txtToPort 
         Height          =   285
         Left            =   2160
         TabIndex        =   9
         Text            =   "32000"
         Top             =   960
         Width           =   735
      End
      Begin VB.TextBox txtFromPort 
         Height          =   285
         Left            =   1080
         TabIndex        =   8
         Text            =   "0"
         Top             =   960
         Width           =   735
      End
      Begin VB.OptionButton optPortOptions 
         Caption         =   "已登记的"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "到"
         Height          =   210
         Index           =   0
         Left            =   1920
         TabIndex        =   12
         Top             =   1005
         Width           =   255
      End
   End
   Begin MSComctlLib.ImageList imglst 
      Left            =   6600
      Top             =   1920
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock tcpClient 
      Index           =   0
      Left            =   6720
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Caption         =   "IP 范围"
      Height          =   1335
      Index           =   0
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3195
      Begin VB.CommandButton cmdFindHost 
         Caption         =   "?"
         Height          =   315
         Left            =   2520
         TabIndex        =   21
         ToolTipText     =   "根据主机名和域搜索"
         Top             =   240
         Width           =   375
      End
      Begin VB.TextBox txtEndIP 
         Height          =   285
         Left            =   720
         TabIndex        =   15
         Top             =   600
         Width           =   1695
      End
      Begin VB.CheckBox chkJustMyComputer 
         Caption         =   "自我搜索"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   960
         Value           =   1  'Checked
         Width           =   1575
      End
      Begin VB.TextBox txtStartIP 
         Height          =   285
         Left            =   720
         TabIndex        =   0
         Top             =   240
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "结束:"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   17
         Top             =   600
         Width           =   495
      End
      Begin VB.Label Label1 
         Caption         =   "开始:"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   16
         Top             =   240
         Width           =   495
      End
   End
   Begin VB.CommandButton cmdScan 
      Caption         =   "开始扫描(&S)"
      Default         =   -1  'True
      Height          =   795
      Left            =   8205
      TabIndex        =   1
      Top             =   360
      Width           =   1215
   End
   Begin MSComctlLib.TreeView tvwScans 
      Height          =   1815
      Left            =   120
      TabIndex        =   6
      Top             =   1560
      Width           =   3615
      _ExtentX        =   6376
      _ExtentY        =   3201
      _Version        =   393217
      LineStyle       =   1
      Style           =   7
      Appearance      =   1
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Const NumberOfWinsocks = 1000
Dim sngTimeOut As Single   '超时描述
Dim blRefreshing As Boolean
Dim iphDNS As New IPHostResolver

Dim cn As ADODB.Connection
Dim rsPorts As ADODB.Recordset
Dim rsTroj As ADODB.Recordset
Dim rsReg As ADODB.Recordset

Dim blStop As Boolean
Dim lngCurrentWinsock As Long
Dim objPorts As New clsPorts
Dim lngX As Single
Dim lngY As Single


Private Sub chkJustMyComputer_Click()
    If Me.chkJustMyComputer Then
        Me.txtStartIP.Text = Me.tcpClient(0).LocalIP
        Me.txtEndIP.Text = Me.tcpClient(0).LocalIP
    End If
    Me.txtStartIP.Enabled = IIf(Me.chkJustMyComputer, False, True)
    Me.txtEndIP.Enabled = IIf(Me.chkJustMyComputer, False, True)
End Sub

Private Sub cmdFindHost_Click()
    '搜索主机或者域.
    Dim strHost As String
    strHost = InputBox("请输入主机名和域：", "查找主机")
    If strHost <> "" Then
        Me.txtStartIP.Text = iphDNS.NameToAddress(strHost)
        Me.txtEndIP.Text = Me.txtStartIP
        If Me.chkJustMyComputer Then Me.chkJustMyComputer = False
    End If
End Sub

Private Sub Form_Load()
    
    Me.txtStartIP.Text = Left(Me.tcpClient(0).LocalIP, InStrRev(Me.tcpClient(0).LocalIP, ".")) & "0"
    Me.txtEndIP.Text = Left(Me.tcpClient(0).LocalIP, InStrRev(Me.tcpClient(0).LocalIP, ".")) & "255"
    Set cn = MakeConnection
    Set rsTroj = New ADODB.Recordset
    Set rsPorts = New ADODB.Recordset
    Set rsReg = New ADODB.Recordset
    
    rsTroj.CursorLocation = adUseClient
    rsTroj.CursorType = adOpenDynamic
    rsTroj.Open "SELECT DISTINCT fldID,fldPort, fldTrojanName FROM tblTrojanPorts WHERE fldType = 'TCP' ORDER BY fldPort, fldTrojanName", cn, adOpenDynamic, adLockReadOnly
    
    rsPorts.CursorLocation = adUseClient
    rsPorts.CursorType = adOpenDynamic
    
    rsReg.CursorLocation = adUseClient
    rsReg.CursorType = adOpenDynamic
    rsReg.Open "SELECT DISTINCT fldID, fldPort, fldRegisterName FROM tblRegisteredPorts WHERE fldType = 'TCP' ORDER BY fldPort, fldRegisterName", cn, adOpenDynamic, adLockReadOnly
    With Me.tvwScans.Nodes  '预增四个分类.
        .Clear
        .Add , , "H", "打开的主机"
        .Add , , "P", "打开的端口"
        .Add , , "R", "可能存在问题的端口分析"
        .Add , , "T", "可能存在特洛伊木马/后门程序"
    End With
    chkJustMyComputer_Click '预置初始化本地计算机
End Sub

Private Sub ScanPorts()

    Dim strSub As String
    Dim lngHex As Long
    Dim lngStartTime As Long
    Dim lngPort As Long
    Dim lstItems As ListItems
    Dim strKey As String
    Dim lngTime As Long
    Dim lngPortCount As Long
    Dim lngPortMax As Long
    Dim lngWinSocks As Long
    Dim lngStartHex As Long
    Dim lngEndHex As Long
    Dim lngStartPort As Long
    Dim lngEndPort As Long
    Dim rs As ADODB.Recordset
    
    
    If blRefreshing Then Exit Sub
    strSub = Left(Me.txtStartIP, InStrRev(Me.txtStartIP, "."))
    lngStartHex = Val(Mid(Me.txtStartIP, Len(strSub) + 1))
    lngEndHex = Val(Mid(Me.txtEndIP, Len(strSub) + 1))
    lngStartPort = Val(Me.txtFromPort.Text)
    lngEndPort = Val(Me.txtToPort.Text)
    sngTimeOut = Val(Me.txtTimeout)
    If lngStartHex > lngEndHex Then Exit Sub
    blRefreshing = True
    Me.Frame1(0).Enabled = False