portscan.frm

一个综合的黑客程序

      BorderStyle     =   1  'Fixed Single
      Caption         =   "Port Control    Coded by: Dustin Davis    Bootleg Software Inc.    Http://www.warpnet.org/bsi"
      ForeColor       =   &H0000C000&
      Height          =   375
      Left            =   105
      TabIndex        =   40
      Top             =   9600
      Width           =   8295
   End
End
Attribute VB_Name = "frmPortScanner"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************************
'Port Control
'Coded by Dustin Davis
'Bootleg Software Inc.
'http://www.warpnet.org/bsi
'
'Please use this code to learn from, do not steal it. It took several hours to
'complete this damn thing. Do not just compile it and label it as your own.
'What kind of programmer would you be? You wouldnt! You'd be a thief. If you
'Use any of this code, please give credit where its due, Me! I hope you learn from this
'
' - Dustin Davis -
'
'**************************************************************************************

Public ScanOnOff As Boolean
Public TimerOnOff As Boolean

Private Sub Command1_Click()
ScanOnOff = True
If txtStart.Text = "" Then
    MsgBox "You Must Enter a Starting Port", vbExclamation, "HEY!"
    Exit Sub
ElseIf txtStop.Text = "" Then
    MsgBox "You Must Enter a Stoping Port", vbExclamation, "HEY!"
    Exit Sub
Else
    Call scan_multiple
End If
End Sub

Private Sub Command10_Click()
Winsock2.Close
Winsock3.Close
AddText txtIncoming, vbCrLf & Time & " Released Port: " & Winsock2.LocalPort
AddText txtIncoming, vbCrLf & Time & " Released Port: " & Winsock3.LocalPort
End Sub

Private Sub Command11_Click()
txtIncoming.Text = ""
End Sub

Private Sub Command12_Click()
Open "received.log" For Output As #1
    Write #1, txtIncoming.Text
Close #1
AddText txtIncoming, vbCrLf & Time & " Log Saved!"
End Sub

Private Sub Command2_Click()
If txtSelPort(0).Text = "" Then
    MsgBox "Must Enter at least ONE (1) port to scan", vbExclamation, "HEY!"
Else
    Call scan_selected
End If
End Sub

Private Sub Command3_Click()
TimerOnOff = True
Command4.Enabled = True
Timer1.interval = txtSeconds.Text * 1000
AddText Text1, vbCrLf & Time & "Timer Activated"
Command3.Enabled = False
End Sub

Private Sub Command4_Click()
TimerOnOff = False
Command3.Enabled = True
Timer1.interval = txtSeconds.Text * 1000
AddText Text1, vbCrLf & Time & "Timer Deactivated"
Command4.Enabled = False
End Sub

Private Sub Command5_Click()
ScanOnOff = False
AddText Text1, vbCrLf & Time & " Scan Stoped by User"
End Sub

Private Sub Command6_Click()
Text1.Text = ""
End Sub

Private Sub Command7_Click()
Open "portcontrol.log" For Output As #1
    Write #1, Text1.Text
Close #1
AddText Text1, vbCrLf & Time & " Log Saved!"
End Sub

Private Sub Command8_Click()
ScanOnOff = True
Call scan_all
End Sub

Private Sub Command9_Click()
On Error GoTo errors
If Not txtPortWatch(0).Text = "" Then
    Winsock2.LocalPort = txtPortWatch(0).Text
    Winsock2.Listen
    AddText txtIncoming, vbCrLf & Time & " Watching Port " & txtPortWatch(0).Text
Else
    txtPortWatch(0).Text = ""
End If

If Not txtPortWatch(1).Text = "" Then
    Winsock3.LocalPort = txtPortWatch(1).Text
    Winsock3.Listen
    AddText txtIncoming, vbCrLf & Time & " Watching Port " & txtPortWatch(1).Text
Else
    txtPortWatch(1).Text = ""
End If


errors:
    If Err.Number = 10048 Then
        AddText txtIncoming, vbCrLf & Time & " Port(s) already in use!"
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
Text1.Text = Time & " Port Scanner " & "Hacker`s Office 2000" & vbCrLf & vbCrLf
Text1.FontBold = True
Text1.ForeColor = &HFFFFF
txtIncoming.FontBold = True
Option1(0).Value = True
Command4.Enabled = False
Label6.FontBold = True
Label6.FontSize = 8
TimerOnOff = False
End Sub

Private Sub Timer1_Timer()
If TimerOnOff = True Then
    If Option1(0).Value = True Then
        ScanOnOff = True
            If txtStart.Text = "" Then
                MsgBox "You Must Enter a Starting Port", vbExclamation, "HEY!"
            ElseIf txtStop.Text = "" Then
                MsgBox "You Must Enter a Stoping Port", vbExclamation, "HEY!"
            Else
            Call scan_multiple
            End If
        Exit Sub
    ElseIf Option1(0).Value = False Then
        scan_selected
        Exit Sub
    End If
ElseIf TimerOnOff = False Then
    Exit Sub
End If
End Sub

Function AddText(textcontrol As Object, text2add As String)

'This function was obtained from Planet-source-code.com

    On Error GoTo errhandlr
    tmptxt$ = textcontrol.Text 'just in Case of an accident
    textcontrol.SelStart = Len(textcontrol.Text) ' move the "cursor" to the End of the text file
    textcontrol.SelLength = 0 ' highlight nothing (this becomes the selected text)
    textcontrol.SelText = text2add ' set the selected text ot text2add
    AddText = 1
    GoTo quitt ' goto the End of the Sub
    'error handlers
errhandlr:


    If Err.Number <> 438 Then 'check the Error number and restore the
        textcontrol.Text = tmptxt$ 'original text If the control supports it
    End If

    AddText = 0
    GoTo quitt
quitt:
    tmptxt$ = ""
End Function

Public Function scan_multiple()
Dim intStart As Long
Dim intStop As Long
intStart = txtStart.Text
intStop = txtStop.Text

On Error GoTo errors

AddText Text1, vbCrLf & Time & " Starting Scan from " & txtStart.Text & " to " & txtStop.Text
intStop = intStop + 1
intStart = intStart - 1

Do
    DoEvents
     intStart = intStart + 1
    If ScanOnOff = True Then
     Winsock1.Close
     DoEvents
     Label5.Caption = "Scanning: " & intStart
     DoEvents
     Winsock1.LocalPort = intStart
     DoEvents
     Winsock1.Listen
     DoEvents
    ElseIf ScanOnOff = False Then
        Exit Function
    ElseIf intStart >= intStop Then
        Exit Function
    End If
    DoEvents
Loop Until intStart >= intStop
AddText Text1, vbCrLf & Time & " Scan Done!"

errors:
    If Err.Number = 10048 Then
        AddText Text1, vbCrLf & Time & " Port " & Winsock1.LocalPort & " is in Use!"
        DoEvents
        Resume Next
    End If
End Function

Public Function scan_selected()

On Error GoTo errors

If txtSelPort(0).Text = "" Then
    txtSelPort(0).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(0).Text
    Winsock1.Listen
End If

If txtSelPort(1).Text = "" Then
    txtSelPort(1).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(1).Text
    Winsock1.Listen
End If

If txtSelPort(2).Text = "" Then
    txtSelPort(2).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(2).Text
    Winsock1.Listen
End If

If txtSelPort(3).Text = "" Then
    txtSelPort(3).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(3).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(4).Text = "" Then
    txtSelPort(4).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(4).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(5).Text = "" Then
    txtSelPort(5).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(5).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(6).Text = "" Then
    txtSelPort(6).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(6).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(7).Text = "" Then
    txtSelPort(7).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(7).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(8).Text = "" Then
    txtSelPort(8).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(8).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(9).Text = "" Then
    txtSelPort(9).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(9).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(10).Text = "" Then
    txtSelPort(10).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(10).Text
    Winsock1.Listen
    DoEvents
End If

If txtSelPort(11).Text = "" Then
    txtSelPort(11).Text = ""
Else
    Winsock1.Close
    Winsock1.LocalPort = txtSelPort(11).Text
    Winsock1.Listen
    DoEvents
End If

errors:
    If Err.Number = 10048 Then
        AddText Text1, vbCrLf & Time & " Port " & Winsock1.LocalPort & " is in Use!"
        DoEvents
        Resume Next
    End If
End Function

Public Function scan_all()
Dim inStart As Long
On Error GoTo errors

AddText Text1, vbCrLf & Time & " Scanning All Possible Ports" 'From 1 - 65530

Do
    DoEvents
     intStart = intStart + 1
    If ScanOnOff = True Then
        Winsock1.Close
        DoEvents
        Label5.Caption = "Scanning: " & intStart
        DoEvents
        Winsock1.LocalPort = intStart
        DoEvents
        Winsock1.Listen
        DoEvents
    ElseIf ScanOnOff = False Then
        Exit Function
    End If
    DoEvents
Loop Until inStart >= 65530

AddText Text1, vbCrLf & Time & "Scan Done!"

errors:
    If Err.Number = 10048 Then
        AddText Text1, vbCrLf & Time & " Port " & Winsock1.LocalPort & " is in Use!"
        DoEvents
        Resume Next
    End If
End Function

Private Sub Winsock2_Close()
AddText Text1, vbCrLf & Time & " Port " & Winsock2.RemotePort & " Is no longer blocked"
End Sub

Private Sub Winsock2_Connect()
AddText Text1, vbCrLf & Time & " Blocking Port " & Winsock2.RemotePort
End Sub

Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close
Winsock2.Accept requestID
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
Winsock2.GetData Data
AddText txtIncoming, vbCrLf & Time & " " & Data
End Sub

Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
AddText Text1, vbCrLf & Time & " Socket Error: " & Number & vbCrLf & "Error Description: " & Description
End Sub

Private Sub Winsock3_ConnectionRequest(ByVal requestID As Long)
Winsock3.Close
Winsock3.Accept requestID
End Sub