clstestftp.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsLinkToFTP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'这个类的作用就是看看某个用户名、密码能不能登陆FTP服务器。
'至于FTP的RFC，参照：http://www.faqs.org/rfcs/rfc959.html
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private WithEvents wscControl As MSWinsockLib.Winsock  '这是个没有界面的WinSock ：）
Attribute wscControl.VB_VarHelpID = -1
Dim m_StrLastErr As String  '用来返回错误
Dim m_Step As String      '存储现在到哪一步了

Public Function link(strIP As String, strUserName As String, strPassWord As String, LngOutTime As Long) As Boolean
    '这个函数探测特定用户名、密码是否能登陆
    '登陆成功返回True，否则返回False
    m_StrLastErr = ""
    m_Step = ""
    link = False

    If wscControl Is Nothing Then
        Set wscControl = New MSWinsockLib.Winsock ' 创建这个对象。：）
    End If
    m_Step = "等待欢迎信息"
    
    wscControl.Close   '关闭Winsock
    wscControl.Connect strIP, 21 '开始TCP连接

    Dim lngTime As Long
    lngTime = GetTickCount
    Do Until lngTime + LngOutTime < GetTickCount Or wscControl.State = sckConnected
    '循环一直到连接成功或者超时
        DoEvents
    Loop
    
    If wscControl.State <> sckConnected Then
        m_StrLastErr = "建立TCP连接超时！"
        Exit Function
    End If
    
    '连接成功，等待欢迎信息
    lngTime = GetTickCount
    Do Until lngTime + LngOutTime < GetTickCount Or m_Step = "已收到欢迎信息"
    '循环一直到收到欢迎信息或者超时
        DoEvents
    Loop
    
    '开始发送用户名
    m_Step = "正在发送用户名"
    wscControl.SendData "user " & strUserName & vbCrLf
    lngTime = GetTickCount
    Do Until lngTime + LngOutTime < GetTickCount Or m_Step = "等待发送密码"
    '循环一直到收到331或者超时
        DoEvents
    Loop
    
    If m_Step <> "等待发送密码" Then
        m_StrLastErr = "发送用户名超时！"
        Exit Function
    End If

    '用户名发送成功，开始发送密码
    m_Step = "正在发送密码"
    wscControl.SendData "pass " & strPassWord & vbCrLf
    lngTime = GetTickCount
    Do Until lngTime + LngOutTime < GetTickCount Or m_Step = "密码正确" Or m_Step = "密码错误"
    '循环一直到收到230 或者 530或者超时
        DoEvents
    Loop
    
    Select Case m_Step
        Case "密码正确"
            link = True  '恭喜！连接成功啦！
        Case "密码错误"
            m_StrLastErr = "密码错误！"
        Case Else
            m_StrLastErr = "发送密码超时！"
    End Select

    wscControl.Close
End Function


Public Function GetLastErr() As String
'这个方法返回错误
    GetLastErr = m_StrLastErr
End Function

Private Sub wscControl_DataArrival(ByVal bytesTotal As Long)
'这个过程收数据啦！
    Dim str As String
    If wscControl.State <> sckConnected Then
        Exit Sub
    End If
    
    wscControl.GetData str, vbString
    
    Select Case m_Step
        Case "等待欢迎信息"
            m_Step = "已收到欢迎信息"
        Case "正在发送用户名"
            If Left(str, 3) = "331" Then
                m_Step = "等待发送密码"
            End If
        Case "正在发送密码"
            If Left(str, 3) = "230" Then
                m_Step = "密码正确"
            End If
            If Left(str, 3) = "530" Then
                m_Step = "密码错误"
            End If
    End Select
End Sub