form1.frm

简单的ftp密码探查,基本上有效,就是不太方便

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5325
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5955
   LinkTopic       =   "Form1"
   ScaleHeight     =   5325
   ScaleWidth      =   5955
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox TxtErr 
      Height          =   1455
      Left            =   3120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   13
      Top             =   3480
      Width           =   2535
   End
   Begin VB.TextBox TxtResult 
      Height          =   1455
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   12
      Top             =   3480
      Width           =   2175
   End
   Begin VB.CommandButton CmdStop 
      Caption         =   "停止"
      Height          =   375
      Left            =   2880
      TabIndex        =   6
      Top             =   2040
      Width           =   1215
   End
   Begin VB.CommandButton CmdStart 
      Caption         =   "开始"
      Height          =   375
      Left            =   1320
      TabIndex        =   5
      Top             =   2040
      Width           =   1215
   End
   Begin VB.TextBox TxtServerName 
      Height          =   375
      Left            =   1680
      TabIndex        =   0
      Top             =   240
      Width           =   2535
   End
   Begin VB.CommandButton CmdPassWordFile 
      Caption         =   "浏览..."
      Height          =   375
      Left            =   4440
      TabIndex        =   4
      Top             =   1440
      Width           =   975
   End
   Begin VB.CommandButton CmdUserNameFile 
      Caption         =   "浏览..."
      Height          =   375
      Left            =   4440
      TabIndex        =   2
      Top             =   840
      Width           =   975
   End
   Begin VB.TextBox TxtPassWordFile 
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   1440
      Width           =   2535
   End
   Begin VB.TextBox TxtUserNameFile 
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   840
      Width           =   2535
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5280
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label5 
      Caption         =   "错误信息："
      Height          =   255
      Left            =   3120
      TabIndex        =   14
      Top             =   3120
      Width           =   1095
   End
   Begin VB.Label Label4 
      Caption         =   "探测结果："
      Height          =   255
      Left            =   480
      TabIndex        =   11
      Top             =   3120
      Width           =   1815
   End
   Begin VB.Label LblStatus 
      Height          =   375
      Left            =   720
      TabIndex        =   10
      Top             =   2520
      Width           =   4575
   End
   Begin VB.Label Label3 
      Caption         =   "服务器IP："
      Height          =   255
      Left            =   600
      TabIndex        =   9
      Top             =   360
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "密码文件："
      Height          =   255
      Left            =   600
      TabIndex        =   8
      Top             =   1440
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "用户名文件："
      Height          =   255
      Left            =   480
      TabIndex        =   7
      Top             =   840
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bStop As Boolean '用来停止探测

Private Sub CmdPassWordFile_Click()
'选择密码
    CommonDialog1.ShowOpen
    TxtPassWordFile.Text = CommonDialog1.FileName
End Sub

Private Sub CmdStart_Click()
    If Trim(TxtServerName.Text) = "" Or Trim(TxtUserNameFile.Text) = "" Or Trim(TxtPassWordFile.Text) = "" Then
        MsgBox "拜托填完！"
        Exit Sub
    End If
    
    CmdStop.Enabled = True
    CmdStart.Enabled = False
    bStop = False
    
    '开始探测
    Call ScanFTP(TxtServerName.Text, TxtUserNameFile.Text, TxtPassWordFile.Text)
    
    LblStatus.Caption = "探测完成。"
    CmdStart.Enabled = True
    CmdStop.Enabled = False
End Sub

Private Sub CmdStop_Click()
    bStop = True
End Sub

Private Sub CmdUserNameFile_Click()
'选择用户名文件
    CommonDialog1.ShowOpen
    TxtUserNameFile.Text = CommonDialog1.FileName
End Sub

Private Sub Form_Load()
    CmdStart.Enabled = True
    CmdStop.Enabled = False

End Sub

Private Sub ScanFTP(ServerName As String, UserNameFile As String, PassWordFile As String)
    
    Dim FileNumber As Integer
    Dim arrayUserName() As String '存放用户名的数组，是动态的哦！
    Dim arrayPassWord() As String '存放密码的数组，是动态的哦！
    

    Dim LineCount As Long '文件行
    
    '第一步，读取用户名文件到arrayUserName数组
    FileNumber = FreeFile()
    Open UserNameFile For Input As FileNumber
    LineCount = 0
    Do While Not EOF(FileNumber)   ' 循环至文件尾。
          ReDim Preserve arrayUserName(0 To LineCount) '把数组弄大点了～
          Line Input #FileNumber, arrayUserName(LineCount)
          LineCount = LineCount + 1
    Loop
    Close FileNumber   ' 关闭文件。
    
    
    '第二步，读取密码文件到arrayPassWord数组
    FileNumber = FreeFile()
    Open PassWordFile For Input As FileNumber
    LineCount = 0
    Do While Not EOF(FileNumber)   ' 循环至文件尾。
          ReDim Preserve arrayPassWord(0 To LineCount) '把数组弄大点了～
          Line Input #FileNumber, arrayPassWord(LineCount)
          LineCount = LineCount + 1
    Loop
    Close FileNumber   ' 关闭文件。
    
    '第三步，开始探测了！：）

   Dim objLinkToFtp As ClsLinkToFTP  'ClsLinkToFTP是我自己写的一个类。
   Set objLinkToFtp = New ClsLinkToFTP '创建这个对象
   
   
   TxtResult.Text = ""
   TxtErr.Text = ""
    Dim i As Long
    Dim j As Long
    For i = 0 To UBound(arrayUserName)
        For j = 0 To UBound(arrayPassWord)
            DoEvents  '释放控制权
            If bStop Then '用户按了停止
                Exit Sub
            End If
            LblStatus.Caption = "正在探测 " & arrayUserName(i) & "/" & arrayPassWord(j) & "..."
            
            If objLinkToFtp.link(ServerName, arrayUserName(i), arrayPassWord(j), 1000) Then  '探测！！！超时时间是1秒
                '登陆成功！
                TxtResult.Text = TxtResult.Text & vbCrLf & arrayUserName(i) & "/" & arrayPassWord(j)
                TxtResult.SelStart = Len(TxtResult.Text)
            Else
                '失败！
                TxtErr.Text = TxtErr.Text & vbCrLf & objLinkToFtp.GetLastErr _
                              & arrayUserName(i) & "/" & arrayPassWord(j)
                TxtErr.SelStart = Len(TxtErr.Text)
                
            End If
        Next j
    Next i
End Sub