form1.frm

主要是网络和数据库的一些东东

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "端口扫描"
   ClientHeight    =   5010
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4575
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5010
   ScaleWidth      =   4575
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame2 
      Caption         =   "扫描设置"
      Height          =   1572
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   4335
      Begin VB.CommandButton cmdClose 
         Caption         =   "退出程序"
         Height          =   375
         Left            =   2760
         TabIndex        =   3
         Top             =   1080
         Width           =   1095
      End
      Begin VB.TextBox txtEndPort 
         Alignment       =   2  'Center
         Height          =   285
         Left            =   2880
         TabIndex        =   1
         Text            =   "65536"
         Top             =   600
         Width           =   1095
      End
      Begin VB.TextBox txtBeginPort 
         Alignment       =   2  'Center
         Height          =   285
         Left            =   240
         TabIndex        =   0
         Text            =   "1"
         Top             =   600
         Width           =   1095
      End
      Begin VB.CommandButton cmdStart 
         Caption         =   "开始扫描"
         Default         =   -1  'True
         Height          =   375
         Left            =   360
         TabIndex        =   2
         Top             =   1080
         Width           =   1095
      End
      Begin VB.CommandButton cmdStop 
         Caption         =   "停止扫描"
         Enabled         =   0   'False
         Height          =   375
         Left            =   1560
         TabIndex        =   4
         Top             =   1080
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "To"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1920
         TabIndex        =   11
         Top             =   600
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "端口扫描:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "当前端口号:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2160
         TabIndex        =   9
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label lblCurrent 
         Alignment       =   1  'Right Justify
         Caption         =   "0"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   3240
         TabIndex        =   8
         Top             =   240
         Width           =   855
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "扫描结果"
      Height          =   3015
      Left            =   120
      TabIndex        =   6
      Top             =   1800
      Width           =   4335
      Begin VB.TextBox txtStatus 
         Height          =   2655
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   240
         Width           =   4095
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   600
      Top             =   3000
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   120
      Top             =   3000
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim OnPort As Long
Dim LocalHost As Integer
Dim PortOpen As Long
Dim Host As String
Dim IP As String

Dim iReturn As Long, sLowByte As String, sHighByte As String
Dim sMsg As String, HostLen As Long
Dim Hostent As Hostent, PointerToPointer As Long, ListAddress As Long
Dim WSAdata As WSAdata, DotA As Long, DotAddr As String, ListAddr As Long
Dim MaxUDP As Long, MaxSockets As Long, i As Integer
Dim Description As String, Status As String
Dim bReturn As Boolean, hIP As Long
Dim szBuffer As String
Dim Addr As Long
Dim RCode As String
Dim RespondingHost As String
Dim TraceRT As Boolean
Dim TTL As Integer
Const WS_VERSION_MAJOR = &H101 \ &H100 And &HFF&
Const WS_VERSION_MINOR = &H101 And &HFF&
Const MIN_SOCKETS_REQD = 0

Private Sub cmdClose_Click()
End
End Sub

Private Sub cmdStart_Click()
txtBeginPort.Enabled = False
txtEndPort.Enabled = False
cmdStart.Enabled = False
cmdStop.Enabled = True
txtStatus = ""
OnPort = txtBeginPort
PortDone = 0
cmdStop.SetFocus
Call Scanner(txtBeginPort, txtEndPort)
End Sub

Sub Scanner(Begin As Long, ending As Long)

TotalPorts = 0
PortOpen = 0
Do Until OnPort = txtEndPort
Pause 0.05
If PortDone = 1 Then lblCurrent = lblCurrent - 1: Exit Sub
DoEvents
lblCurrent = OnPort
    If ScanPort(OnPort, Winsock1) = True Then
        TotalPorts = TotalPorts + 1
        PortOpen = PortOpen + 1
        If txtStatus = "" Then txtStatus = "端口 " & OnPort & " 正在使用中。": GoTo thisPart
        txtStatus = txtStatus & vbCrLf & "端口 " & OnPort & " 正在使用中。"
        txtStatus.SelStart = Len(txtStatus)
    End If

thisPart:
OnPort = OnPort + 1
Loop
lblCurrent = "扫描结束"
txtStatus = txtStatus & vbCrLf & OnPort - 1 & " 个端口扫描完毕。" _
    & vbCrLf & PortOpen & " 个端口正在使用中。"
txtStatus.SelStart = Len(txtStatus)
cmdStop.Enabled = False
txtBeginPort.Enabled = True
txtEndPort.Enabled = True
cmdStart.Enabled = True
cmdStart.SetFocus
End Sub

Private Sub cmdStop_Click()
cmdStop.Enabled = False
txtBeginPort.Enabled = True
txtEndPort.Enabled = True
cmdStart.Enabled = True
PortDone = 1
txtStatus = txtStatus & vbCrLf & OnPort - 1 & " 个端口扫描完毕，" _
    & vbCrLf & PortOpen & " 个端口正在使用中。"
txtStatus.SelStart = Len(txtStatus)
cmdStart.SetFocus
End Sub

Private Sub Form_Load()
OnPort = 1
optLocal = True
LocalHost = 1
lblCurrent = "0"
End Sub

Private Sub Form_Resize()
If Me.WindowState = vbNormal Then
Me.Height = 5670
Me.Width = 4695
ElseIf Me.WindowState = vbMaximized Then Me.WindowState = vbNormal
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Clean_Up
Winsock1.Close
End Sub

Private Sub optLocal_Click()
txtIP.Enabled = False
LocalHost = 1
End Sub

Private Sub optRemote_Click()
txtIP.Enabled = True
LocalHost = 2
End Sub

Private Sub Winsock1_Connect()
    txtStatus = txtStatus & vbCrLf & "Port " & OnPort & " is currently open."
    txtStatus.SelStart = Len(txtStatus)
    OnPort = OnPort + 1
    PortOpen = PortOpen + 1
End Sub
Public Sub vbGetHostByName()
    Dim szString As String
    Host = Trim$(Host)
    szString = String(64, &H0)
    Host = Host + Right$(szString, 64 - Len(Host))

    If gethostbyname(Host) = SOCKET_ERROR Then
        sMsg = "Winsock Error" & Str$(WSAGetLastError())
        MsgBox sMsg, 0, ""
    Else
        PointerToPointer = gethostbyname(Host)
        CopyMemory Hostent.h_name, ByVal _
        PointerToPointer, Len(Hostent)
        ListAddress = Hostent.h_addr_list
        CopyMemory ListAddr, ByVal ListAddress, 4
        CopyMemory IPLong5, ByVal ListAddr, 4
        CopyMemory Addr, ByVal ListAddr, 4
        IP = Trim$(CStr(Asc(IPLong5.Byte4)) + "." + CStr(Asc(IPLong5.Byte3)) _
        + "." + CStr(Asc(IPLong5.Byte2)) + "." + CStr(Asc(IPLong5.Byte1)))
    End If
End Sub

Sub Clean_Up()
On Error Resume Next
lblCurrent = 1
PortDone = 1
txtStatus = ""
cmdStop.Enabled = False
txtBeginPort.Enabled = True
txtEndPort.Enabled = True
cmdStart.Enabled = True
End Sub