frmmain.frm

一个非常完整的扫描工具

    StatusBar "Creating " & lngWinSocks & " Winsocks..."
    Me.pgbrPorts.Min = 0
    Me.pgbrPorts.Max = lngWinSocks
    Me.pgbrPorts.Value = 0
    Do Until Me.tcpClient.Count = lngWinSocks
        Load Me.tcpClient(Me.tcpClient.Count)
        Me.tcpClient(Me.tcpClient.Count - 1).Tag = Timer
        Me.pgbrPorts.Value = Me.tcpClient.Count
        DoEvents
        If blStop Then Exit Do
    Loop
    lngCurrentWinsock = 0
    StatusBar "Scanning Ports..."
    Me.pgbrPorts.Max = lngEndPort
    Me.pgbrPorts.Min = lngStartPort
    Me.pgbrPorts.Value = lngStartPort
    With Me.tvwScans.Nodes
        .Clear
        .Add , , "H", "Open Hosts"
        .Add , , "R", "Possible Registed Ports"
        .Add , , "T", "Possible Trojans/Backdoors"
    End With
    On Error GoTo Error_ScanPorts
    If Me.optPortOptions(2).Value = True Then   'Manual
        lngStartTime = Timer()
        Me.pgbrPorts.Max = lngEndPort
        Me.pgbrPorts.Min = lngStartPort
        Me.pgbrPorts.Value = lngStartPort
        For lngPort = lngStartPort To lngEndPort
            Me.pgbrPorts.Value = lngPort
            If lngTime > 0 And lngTime < Timer Then Exit For
    
            For lngHex = lngStartHex To lngEndHex
                If lngTime > 0 And lngTime < Timer Then Exit For
                Do
                    DoEvents
                    If Me.tcpClient(lngCurrentWinsock).State = sckClosed Then
                        'Doubles scan time.
                        'StatusBar "winsock(" & lngCurrentWinsock & ") " & strSub & lngHex & ":" & lngPort
                        Me.tcpClient(lngCurrentWinsock).RemoteHost = strSub & lngHex
                        Me.tcpClient(lngCurrentWinsock).RemotePort = lngPort
                        Me.tcpClient(lngCurrentWinsock).LocalPort = 0
                        Me.tcpClient(lngCurrentWinsock).Tag = "" & Timer + TimeOut
                        Me.tcpClient(lngCurrentWinsock).Connect
                        If iHex = 255 And lngPort = 200 Then blStop = True
                        Exit Do
                    End If
                    If tcpClient(lngCurrentWinsock).State = sckConnected Then
                        AddPortToTree Me.tcpClient(lngCurrentWinsock).RemoteHostIP, Me.tcpClient(lngCurrentWinsock).RemotePort
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    If tcpClient(lngCurrentWinsock).State = sckError Then
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    If tcpClient(lngCurrentWinsock).State >= sckResolvingHost And tcpClient(lngCurrentWinsock).State <= sckConnecting And tcpClient(lngCurrentWinsock).Tag < Timer Then
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    lngCurrentWinsock = lngCurrentWinsock + 1
                    If lngCurrentWinsock = lngWinSocks Then lngCurrentWinsock = 0
                    If blStop Then
                        If lngTime = 0 Then lngTime = Timer + 2
                    End If
                    If lngTime > 0 And lngTime < Timer Then Exit Do
                Loop
            Next lngHex
        Next lngPort
        MsgBox "Scan took " & Timer() - lngStartTime & " seconds", vbInformation, "Scan Finished"
    Else
        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
        rs.CursorType = adOpenDynamic
        If Me.optPortOptions(1).Value = True Then
            rs.Open "SELECT DISTINCT fldPort FROM tblTrojanPorts WHERE fldType = 'TCP' ORDER BY fldPort", cn, adOpenDynamic, adLockReadOnly
        Else
            rs.Open "SELECT DISTINCT fldPort FROM tblRegisteredPorts WHERE fldType = 'TCP' ORDER BY fldPort", cn, adOpenDynamic, adLockReadOnly
        End If
        If Not rs.EOF Then
            rs.MoveLast
            rs.MoveFirst
        End If
        Me.pgbrPorts.Max = rs.RecordCount
        Me.pgbrPorts.Min = 0
        lngStartTime = Timer
        Do Until rs.EOF
            Me.pgbrPorts.Value = rs.AbsolutePosition
            lngPort = rs.Fields("fldPort")
            If lngTime > 0 And lngTime < Timer Then Exit Do
    
            For lngHex = lngStartHex To lngEndHex
                If lngTime > 0 And lngTime < Timer Then Exit For
                Do
                    DoEvents
                    If Me.tcpClient(lngCurrentWinsock).State = sckClosed Then
                        'Doubles scan time.
                        'StatusBar "winsock(" & lngCurrentWinsock & ") " & strSub & lngHex & ":" & lngPort
                        Me.tcpClient(lngCurrentWinsock).RemoteHost = strSub & lngHex
                        Me.tcpClient(lngCurrentWinsock).RemotePort = lngPort
                        Me.tcpClient(lngCurrentWinsock).LocalPort = 0
                        Me.tcpClient(lngCurrentWinsock).Tag = "" & Timer + TimeOut
                        Me.tcpClient(lngCurrentWinsock).Connect
                        If iHex = 255 And lngPort = 200 Then blStop = True
                        Exit Do
                    End If
                    If tcpClient(lngCurrentWinsock).State = sckConnected Then
                        AddPortToTree Me.tcpClient(lngCurrentWinsock).RemoteHostIP, Me.tcpClient(lngCurrentWinsock).RemotePort
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    If tcpClient(lngCurrentWinsock).State = sckError Then
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    If tcpClient(lngCurrentWinsock).State >= sckResolvingHost And tcpClient(lngCurrentWinsock).State <= sckConnecting And tcpClient(lngCurrentWinsock).Tag < Timer Then
                        tcpClient(lngCurrentWinsock).Close
                    End If
                    lngCurrentWinsock = lngCurrentWinsock + 1
                    If lngCurrentWinsock = lngWinSocks Then lngCurrentWinsock = 0
                    If blStop Then
                        If lngTime = 0 Then lngTime = Timer + 2
                    End If
                    If lngTime > 0 And lngTime < Timer Then Exit Do
                Loop
            Next lngHex
            rs.MoveNext
        Loop
        MsgBox "Scan took " & Timer() - lngStartTime & " seconds", vbInformation, "Scan Finished"
    End If
    StatusBar "Disolving " & lngWinSocks & " Winsocks..."
    Me.pgbrPorts.Min = 0
    Me.pgbrPorts.Max = Me.tcpClient.Count
    Me.pgbrPorts.Value = Me.tcpClient.Count
    Do Until Me.tcpClient.Count = 1
        If tcpClient(Me.tcpClient.Count - 1).State = sckConnected Then
            AddPortToTree Me.tcpClient(Me.tcpClient.Count - 1).RemoteHostIP, Me.tcpClient(Me.tcpClient.Count - 1).RemotePort
            tcpClient(Me.tcpClient.Count - 1).Close
        End If
        Unload Me.tcpClient(Me.tcpClient.Count - 1)
        Me.pgbrPorts.Value = Me.tcpClient.Count
        DoEvents
    Loop
    blRefreshing = False
    blStop = False
    Me.Caption = "Port Scanner"
    Me.MousePointer = vbNormal
    Me.Frame1(0).Enabled = True
    Me.Frame1(1).Enabled = True
    Me.framePortsToScan.Enabled = True
    Progbar False
    StatusBar "Ready"
    Me.cmdScan.Caption = "Scan"
    Exit Sub
    
Error_ScanPorts:
    blStop = True
    Debug.Print Err.Number; ":" & Err.Description
    Resume Next
End Sub

Private Sub AddPortToTree(strIP As String, lngOpenPort As Long)
    Dim strHost As String
    Dim strPartialKey As String
    Dim objNode As Node
    Dim objNodes As Nodes
    Dim objParentNode As Node
    Dim strTemp As String

    strHost = strIP & " " & iphDNS.AddressToName(strIP)
    strPartialKey = strIP & ":" & lngOpenPort
    Set objNodes = Me.tvwScans.Nodes
    
    Set objParentNode = AddNodeToParent(objNodes("H"), "H" & strIP, strHost)
    Set objNode = AddNodeToParent(objNodes("H" & strIP), strPartialKey, "Port " & lngOpenPort)
    If rsReg.State = adStateOpen Then
        rsReg.Filter = "fldPort = " & lngOpenPort
        Do Until rsReg.EOF
            If strTemp <> rsReg.Fields("fldRegisterName") Then
                Set objParentNode = AddNodeToParent(objNodes("R"), "R" & rsReg.Fields("fldID"), lngOpenPort & ":" & rsReg.Fields("fldRegisterName"))
                Set objNode = AddNodeToParent(objNodes("R" & rsReg.Fields("fldID")), "R" & rsReg.Fields("fldID") & strPartialKey, strHost)
                strTemp = rsReg.Fields("fldRegisterName")
            End If
'            AddRegisteredToTree rsReg.Fields("fldID"), rsReg.Fields("fldRegisterName"), strHost, lngOpenPort
            rsReg.MoveNext
        Loop
    End If
    
    If rsTroj.State = adStateOpen Then
        rsTroj.Filter = "fldPort = " & lngOpenPort
        Do Until rsTroj.EOF
            If strTemp <> rsTroj.Fields("fldTrojanName") Then
                Set objParentNode = AddNodeToParent(objNodes("T"), "T" & rsTroj.Fields("fldID"), lngOpenPort & ":" & rsTroj.Fields("fldTrojanName"))
                Set objNode = AddNodeToParent(objNodes("T" & rsTroj.Fields("fldID")), "T" & rsTroj.Fields("fldID") & strPartialKey, strHost)
                strTemp = rsTroj.Fields("fldTrojanName")
            End If
'            AddTrojanToTree rsTroj.Fields("fldID"), rsTroj.Fields("fldTrojanName"), strHost, lngOpenPort
            rsTroj.MoveNext
        Loop
    End If


End Sub

Private Function AddNodeToParent(objParentNode As Node, strKey As String, strText As String) As Node
    On Error Resume Next
    Set AddNodeToParent = Me.tvwScans.Nodes.Add(objParentNode, tvwChild, strKey, strText)
End Function

Private Sub AddTrojanToTree(lngKey As Long, strTrojan As String, strHost As String, lngOpenPort As Long)

End Sub

Private Sub AddRegisteredToTree(lngKey As Long, strRegistered As String, strHost As String, lngOpenPort As Long)

End Sub

Private Sub cmdScan_Click()
    If blRefreshing Then
        blStop = True
    Else
        ScanPorts
    End If
End Sub

Private Sub Form_Resize()
    If Me.WindowState = vbMinimized Then Exit Sub
    Me.tvwScans.Width = Me.ScaleWidth - Me.tvwScans.Left * 2
    Me.tvwScans.Height = Me.ScaleHeight - Me.framePortsToScan.Top - Me.framePortsToScan.Height - (Me.tvwScans.Top - Me.framePortsToScan.Top - Me.framePortsToScan.Height) * 2 - Me.sbMain.Height
    If Me.pgbrPorts.Visible Then Progbar True
'    Me.pgbrPorts.Width = Me.ScaleWidth - Me.pgbrPorts.Left * 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If blRefreshing Then
        MsgBox "You must halt the scan before closing"
        Cancel = -1
        Exit Sub
    End If
    
    If rsPorts.State = adStateOpen Then rsPorts.Close
    Set rsPorts = Nothing
    
    If rsTroj.State = adStateOpen Then rsTroj.Close
    Set rsTroj = Nothing
    
    If rsReg.State = adStateOpen Then rsReg.Close
    Set rsReg = Nothing
    
    If cn.State = adStateOpen Then cn.Close
    Set cn = Nothing
End Sub

Private Function getRegisteredForPort(Port As Long) As String
    If rsReg.State <> adStateOpen Then Exit Function
    rsReg.Filter = "fldPort = " & Port
    Do Until rsReg.EOF
        getRegisteredForPort = getRegisteredForPort & IIf(getRegisteredForPort = "", "", ", ") & rsReg.Fields("fldRegisterName")
        rsReg.MoveNext
    Loop
End Function

Private Function getTrojansForPort(Port As Long) As String
    If rsTroj.State <> adStateOpen Then Exit Function
    rsTroj.Filter = "fldPort = " & Port
    Do Until rsTroj.EOF
        getTrojansForPort = getTrojansForPort & IIf(getTrojansForPort = "", "", ", ") & rsTroj.Fields("fldTrojanName")
        rsTroj.MoveNext
    Loop
End Function

Private Function GetConnectionString() As String
    GetConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\scanner.mdb"
End Function

Private Function MakeConnection() As ADODB.Connection
    Dim cn As ADODB.Connection
    Dim strCon As String
    On Error GoTo Error_MakeConnection
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    strCon = GetConnectionString()
    cn.Open strCon
    Set MakeConnection = cn
    Exit Function

Error_MakeConnection:
    MsgBox Err.Number & ":" & Err.Description
End Function

Private Sub Label2_Click()

End Sub

Private Sub optPortOptions_Click(Index As Integer)
    Me.txtFromPort.Enabled = Me.optPortOptions(2)
    Me.txtToPort.Enabled = Me.optPortOptions(2)
End Sub

Private Sub txtStartIP_Validate(Cancel As Boolean)
    Me.txtEndIP.Text = Left(Me.tcpClient(0).LocalIP, InStrRev(Me.tcpClient(0).LocalIP, ".")) & "255"
End Sub

Private Sub StatusBar(Info As String)
    Me.sbMain.Panels("Info").Text = Info
End Sub

Private Sub Progbar(ProgBarVisible As Boolean)
    If ProgBarVisible Then
        Me.pgbrPorts.Left = Me.sbMain.Left + Me.sbMain.Panels("Date").Left
        Me.pgbrPorts.Top = Me.sbMain.Top
        Me.pgbrPorts.Height = Me.sbMain.Height
        Me.pgbrPorts.Width = Me.sbMain.Panels("Time").Left + Me.sbMain.Panels("Time").Width - Me.sbMain.Panels("Date").Left
        Me.pgbrPorts.Visible = True
    Else
        Me.pgbrPorts.Visible = False
    End If
End Sub