frmscaner.frm

一个简单的端口扫描程序： addstr = "发现端口" & Str(port) & "打开" & Space(5) Select Case port Case 7 plus = "ECHO服务"

         Top             =   1320
         Width           =   180
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "少"
         Height          =   180
         Left            =   -74760
         TabIndex        =   11
         Top             =   1320
         Width           =   180
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "线程数量:"
         Height          =   180
         Left            =   -74760
         TabIndex        =   9
         Top             =   480
         Width           =   810
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "终止端口:"
         Height          =   180
         Left            =   240
         TabIndex        =   6
         Top             =   1920
         Width           =   810
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "起始端口:"
         Height          =   180
         Left            =   240
         TabIndex        =   4
         Top             =   1320
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "主机地址:"
         Height          =   180
         Left            =   240
         TabIndex        =   2
         Top             =   720
         Width           =   810
      End
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   2130
      Left            =   0
      Picture         =   "FrmScaner.frx":0668
      ScaleHeight     =   2100
      ScaleWidth      =   4500
      TabIndex        =   22
      Top             =   3960
      Width           =   4530
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "+"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   240
         Left            =   4200
         TabIndex        =   27
         Top             =   480
         Width           =   120
      End
      Begin VB.Label AllPg 
         BackStyle       =   0  'Transparent
         Caption         =   "0"
         ForeColor       =   &H00FFFFFF&
         Height          =   180
         Left            =   2840
         TabIndex        =   26
         Top             =   240
         Width           =   450
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "% Completed"
         ForeColor       =   &H8000000E&
         Height          =   180
         Left            =   3120
         TabIndex        =   25
         Top             =   240
         Width           =   990
      End
   End
End
Attribute VB_Name = "FrmScaner"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim countline As Integer
Dim nowport As Integer
Dim lognum As Integer
Dim fso As New FileSystemObject
Dim flag As Boolean
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Const EM_GETLINECOUNT = &HBA
Const EM_GETLINE = &HC4



Private Sub Command1_Click()
Dim i
If Command1.Caption = "开始" Then
GoOnFlag = True
Command1.Caption = "停止"
WckNum = ThreadNUM.Value
StartPort = PORTSTART.Text
EndPort = PORTEND.Text
RemoteIP = IPADDRESS.Text
Fengzi = 0
Fengmu = EndPort - StartPort + 1
portscan StartPort, EndPort, WckNum
Else
Command1.Enabled = False
GoOnFlag = False
DoEvents
On Error Resume Next
For i = 1 To WckNum
Winsock(i).Close
Next i
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Sub paintstatus()
STATUS.Text = "========================================" & vbCrLf _
           & "             EastScan 1.0                " & vbCrLf _
           & "             by EastDark                 " & vbCrLf _
           & vbCrLf _
           & "      http://redleague.126.com          " & vbCrLf _
           & "========================================" & vbCrLf
End Sub

Private Sub Form_Load()

WckNum = ThreadNUM.Value
StartPort = PORTSTART.Text
EndPort = PORTEND.Text
PgBar.Value = 0
Call paintstatus
flag = True
End Sub

Private Sub Form_Resize()
STATUS.Width = Me.Width - 4830
End Sub

Private Sub Frame1_DblClick(Cancel As MSForms.ReturnBoolean)
If flag Then
Me.WindowState = 2
Else
Me.WindowState = 0
End If
End Sub

Private Sub Option1_Click()
ThreadNUM.Enabled = True
End Sub

Private Sub Option2_Click()
ThreadNUM.Value = 500
End Sub

Private Sub Option3_Click()
ThreadNUM.Value = 100
End Sub

Private Sub STATUS_Change()
countline = SendMessage(STATUS.hwnd, EM_GETLINECOUNT, 0, 0)
If countline > 26 Then
STATUS.Text = ""
End If
End Sub

Private Sub ThreadNUM_Change()
WckNum = ThreadNUM.Value
labelnumber.Caption = Str(WckNum)
End Sub

Private Sub Winsock_Connect(Index As Integer)
STATUS.Text = STATUS.Text & "(端口" & Str(Winsock(Index).RemotePort) & "开放)" & vbCrLf & vbCrLf
Addtolist Winsock(Index).RemotePort
End Sub

Sub Addtolist(port As Integer)
Dim addstr, plus As String
addstr = "发现端口" & Str(port) & "打开" & Space(5)
Select Case port
Case 7
plus = "ECHO服务"
Case 21
plus = "FTP服务★★★★★"
Case 25
plus = "SMTP服务★★"
Case 43
plus = "Whois服务"
Case 53
plus = "DNS服务☆"
Case 80
plus = "HTTP服务★★★★★"
Case 81
plus = "HOSTS2名称服务"
Case 99
plus = "NCX99后门★★★★★"
Case 110
plus = "POP3服务★★★★★"
Case 111
plus = "Sun RPC服务★★"
Case 135
plus = "本地服务"
Case 137
plus = "NETBIOS 名称服务/流影POP"
Case 138
plus = "NETBIOS 数据存储服务"
Case 139
plus = "NETBIOS 会议服务★★★"
Case 119
plus = "NNTP虚拟服务"
Case 163
plus = "SNMP服务"
Case 443
plus = "https服务"
Case 512
plus = "远程执行服务"
Case 513
plus = "login, remote login"
Case 514
plus = "cmd, exec with auto auth."
Case 600
plus = "Sun IPC服务器"
Case 1080
plus = "SOCKS代理服务★★★"
Case 1433
plus = "SQL服务器★★★"
Case 3128
plus = "HTTP代理服务"
Case 7626
plus = "木马冰河★★★★★"
Case 8080
plus = "HTTP代理服务"
Case Else
plus = "未知服务!"
End Select
OpenPortDlg.List1.AddItem (addstr & plus)
End Sub