protscan.frm

端口扫描器 vb6编写

            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   240
         Left            =   270
         TabIndex        =   13
         Top             =   540
         Width           =   555
      End
   End
   Begin MSComctlLib.StatusBar SBScanStatus 
      Align           =   2  'Align Bottom
      Height          =   345
      Left            =   0
      TabIndex        =   12
      Top             =   5655
      Width           =   5460
      _ExtentX        =   9631
      _ExtentY        =   609
      SimpleText      =   "当前状态："
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   4551
            Text            =   "扫描对象："
            TextSave        =   "扫描对象："
            Object.ToolTipText     =   "当前扫描的对象，可以是本机或远程计算机"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   4551
            Text            =   "当前扫描端口："
            TextSave        =   "当前扫描端口："
            Object.ToolTipText     =   "当前扫描的端口"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'========================================================================
'作者：jhk
'E-Mail：[e-mail]
'日期：2004年1月11日
'声明:
'      如果大家要转贴或修改的话，请保留作者信息，如果要修改源程序的话请先
'      备份一份原稿（源代码），以便其他朋友可以看到原汁原味的代码，而且他
'      也有机会思考更好的算法，到时别忘了发一份给我喔，谢谢！
'========================================================================
Dim strRemoteIP(3) As String '保存分组后的IP地址
'以下函数和常量实现文本框的滚动
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_SCROLL = &HB5 '该消息实现文本框的垂直滚动
Private Const SB_BOTTOM = 7    '始终保持滚动条在最下方
Private Sub cmdAbout_Click()
  Form2.Show
End Sub

Private Sub cmdCleanReport_Click()
  '清除扫描报告
  If txtReport.Text = "" Then txtReport.Text = "没有记录可清除" & vbCrLf: Exit Sub
  If MsgBox("确实要清除扫描结果吗？", vbYesNo + vbInformation, "注意") = vbNo Then Exit Sub
  txtReport.Text = ""
End Sub

Private Sub cmdEndScan_Click()
  '停止扫描
  bCanScan = False
  WS1.Close
End Sub
Private Sub cmdExit_Click()
  '如果程序正在扫描
  If bCanScan = True Then
     DoEvents
     If MsgBox("程序正在扫描，你确实要退出吗？", vbInformation + vbYesNo, "JHK警告") = vbYes Then
        WS1.Close
        End
     End If
  Else
     End
  End If
End Sub

Private Sub cmdSaveReport_Click()
  '保存扫描结果
  Dim FileNum As Integer  '有用的文件号
  If bCanScan = True Then Exit Sub  '如果正在扫描则退出程序
  FileNum = FreeFile '获得当前可以使用的文件号
  cdgSaveFile.FileName = "PortScan_" & Str$(Date) & ".txt"
  Debug.Print cdgSaveFile.FileName
  cdgSaveFile.ShowSave
  '如果扫描结果为空或文件保存路径为空，则不进行保存工作
  If cdgSaveFile.FileName = "" Or cdgSaveFile.FileName = "PortScan_" & Str$(Date) & ".txt" Then Exit Sub
  If txtReport.Text = "" Or txtReport.Text = "没有记录可清除" Then txtReport.Text = "程序作者：jhkdiy" & vbCrLf & "保存日期：" & Str$(Date) & vbCrLf & "没有扫描记录"
  '------------------------------------------------------------------------------
  '将扫描结果保存到文件中
  Open cdgSaveFile.FileName For Output Access Write As #FileNum
  Write #FileNum, Trim$(txtReport.Text)
  Close #FileNum
End Sub

Private Sub cmdStartScan_Click()
'开始扫描端口，根据扫描对象选择扫描方式
'在这里直接执行的是本机的扫描，远程扫描
'通过函数来执行，比较复杂。
On Error GoTo PortError
  Dim StartPort As String
  Dim EndPort As String
  Dim ConnectIP As String
  StartPort = txtStartPort.Text
  EndPort = txtEndPort.Text
  cmdEndScan.Enabled = True
  cmdStartScan.Caption = "扫描中..."
  cmdStartScan.Enabled = False
  bCanScan = True
  txtReport.Text = txtReport.Text & vbCrLf & "程序作者：jhkdiy" & vbCrLf & "扫描日期：" + Str$(Date) + vbCrLf + "扫描时间：" + Str$(Time) & vbCrLf & "扫描对象：" & IIf(OptLocalPort.Value, "本机", txtRemoteStartIP.Text & "--" & txtRemoteEndIP.Text) & vbCrLf & "端口范围：" & txtStartPort.Text & "--" & txtEndPort.Text & vbCrLf
  txtReport.Text = txtReport.Text & "开始扫描......" & vbCrLf & "------------------------------" & vbCrLf
  '扫描本地的端口，已侦听模式来扫描
  If OptLocalPort.Value = True Then
     SBScanStatus.Panels(1).Text = "扫描对象：本机"
     While Int(StartPort) <= Int(EndPort)
       If bCanScan = True Then
         WS1.Close
         'If StartPort = 0 Then StartPort = StartPort + 1
         DoEvents '扫描过程中程序可以相应其它事件，在这里很重要，必须加上
         WS1.LocalPort = Str$(StartPort) '要扫描的端口，这是个变量，端口号会累加
         DoEvents
         SBScanStatus.Panels(2).Text = "当前扫描端口：" & StartPort
         WS1.Listen  '侦听此端口，如果这个端口已被其它程序占用，则会产生错误，立即跳到OpenPort的错误处理段
         Debug.Print "当前PauseTime值为：" & Str$(PauseTime)
         Pause PauseTime '时间延迟
         DoEvents
         StartPort = StartPort + 1
       Else
         WS1.Close
         txtReport.Text = txtReport.Text & "------------------------------" & vbCrLf & "结束扫描......" & vbCrLf & "结束时间：" & Str$(Time) & vbCrLf
         cmdStartScan.Caption = "扫描(&S)"
         cmdStartScan.Enabled = True
         cmdEndScan.Enabled = False
         Exit Sub
       End If
     Wend
     bCanScan = False
     txtReport.Text = txtReport.Text & "------------------------------" & vbCrLf & "结束扫描......" & vbCrLf & "结束时间：" & Str$(Time) & vbCrLf
     cmdStartScan.Caption = "扫描(&S)"
     cmdStartScan.Enabled = True
     cmdEndScan.Enabled = False
     Exit Sub
  End If
  '扫描远程主机的端口，程序尝试连接同一个IP的
  '不同端口，如果能成功连接会产生Connect事件
  '即代表远程主机的当前端口已打开，然后关闭
  '连接进行下一个端口的尝试。
  If OptRemotePort.Value = True Then
     SBScanStatus.Panels(1).Text = "扫描对象：" & txtRemoteStartIP
     sldPauseTime.Value = 1
     '调用远程扫描函数：
     RemoteScanIP txtRemoteStartIP.Text, txtRemoteEndIP.Text, txtStartPort.Text, txtEndPort.Text
     bCanScan = False
     txtReport.Text = txtReport.Text & "------------------------------" & vbCrLf & "结束扫描......" & vbCrLf & "结束时间：" & Str$(Time) & vbCrLf
     cmdStartScan.Caption = "扫描(&S)"
     cmdStartScan.Enabled = True
     cmdEndScan.Enabled = False
  End If
PortError:
  'Debug.Print Err.Number
  '若是其它程序已占有此端口的错误则记录此端口，10048证明侦听的端口已被其它程序占用
  If Err.Number = 10048 Then
    If OptLocalPort.Value = True Then
       txtReport.Text = txtReport.Text & "本地端口 [" & WS1.LocalPort & "] " & "已打开" & vbCrLf
    End If
    Resume Next
  End If
End Sub
Private Sub Form_Click()
  '这里是做IP地址分解的测试
  ReDim ip(0 To 3) As String
  Debug.Print "要分解的IP是:" & txtRemoteStartIP.Text
  IPstrTOnum ByVal txtRemoteStartIP.Text, ip()
  Debug.Print ip(0)
  Debug.Print ip(1)
  Debug.Print ip(2)
  Debug.Print ip(3)
  'RemoteScan txtRemoteStartIP.Text, txtRemoteEndIP.Text
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  '如果程序正在扫描
  If bCanScan = True Then
     DoEvents
     If MsgBox("程序正在扫描，你确实要退出吗？", vbInformation + vbYesNo, "JHK警告") = vbYes Then
        WS1.Close
        End
     End If
  Else
     End
  End If
End Sub

Private Sub Form_Resize()
  If Me.WindowState = 1 Then Exit Sub
  If Me.Width <> 5580 Or Me.Height <> 6405 Then Beep: Me.Width = 5580: Me.Height = 6405
End Sub

Private Sub OptLocalPort_Click()
  '屏蔽输入IP
  txtRemoteStartIP.Enabled = False
  txtRemoteEndIP.Locked = True
  txtRemoteEndIP.Enabled = False
  txtRemoteEndIP.Locked = True
  Label3.Enabled = False
  Label4.Enabled = False
End Sub

Private Sub OptRemotePort_Click()
  '使输入IP地址可用
  txtRemoteStartIP.Enabled = True
  txtRemoteStartIP.Locked = False
  txtRemoteEndIP.Enabled = True
  txtRemoteEndIP.Locked = False
  Label3.Enabled = True
  Label4.Enabled = True
End Sub

Private Sub sldPauseTime_Change()
  '设置扫描的时间间隔，即扫描速度的快慢
  PauseTime = sldPauseTime.Value / 10
  Debug.Print "当前PauseTime值为：" & Str$(PauseTime)
End Sub

Private Sub txtEndPort_LostFocus()
  On Error Resume Next
  If txtEndPort.Text = "" Then txtEndPort.Text = "1024"
  If Int(txtEndPort.Text) < 1 Or Int(txtEndPort.Text) > 65535 Then
     MsgBox "输入的端口有误，请重新输入", vbOKOnly + vbInformation, "jhkdiy警告"
     txtStartPort.SetFocus
     txtStartPort.Text = ""
     txtEndPort.Text = ""
  End If
End Sub

Private Sub txtRemoteStartIP_Change()
  'IP输入同步
  txtRemoteEndIP.Text = txtRemoteStartIP.Text
End Sub
Private Sub txtReport_Change()
  '使文本动态滚动
  SendMessage txtReport.hwnd, EM_SCROLL, SB_BOTTOM, 0
  'txtReport.SetFocus
  'SendKeys "{PGDN}"
  'SendKeys "{PGDN}"
End Sub

Private Sub txtStartPort_LostFocus()
  On Error Resume Next
  If txtStartPort.Text = "" Then txtStartPort.Text = "1"
  If Int(txtStartPort.Text) < 1 Or Int(txtStartPort.Text) > 65535 Then
     MsgBox "输入的端口有误，请重新输入", vbOKOnly + vbInformation, "jhkdiy警告"
     txtStartPort.SetFocus
     txtStartPort.Text = ""
  End If
End Sub

Private Sub WS1_Connect()
  '若可以和远程主机连接则记录此连接端口
  'txtReport.SetFocus
  'PortNumber = PortNumber + 1
  txtReport.Text = txtReport.Text & WS1.RemoteHostIP & " 的端口 [" & WS1.RemotePort & "] " & "已打开" & vbCrLf
  '滚动文本
  SendMessage txtReport.hwnd, EM_SCROLL, SB_BOTTOM, 0
  'txtReport.SetFocus
  'SendKeys "{PGDN}"
  'SendKeys "{PGDN}"
End Sub