Option Explicit

Dim inetdata As Variant

Dim currentserverdir As String

Dim xpos As Long, ypos As Long

Dim operationstyle As Integer

Private Sub Check1_Click()

If Check1.Value = 0 Then

txtuser.Enabled = True

txtpassword.Enabled = True

End If

End Sub

Private Sub cmd0_Click(index As Integer)

If index = 0 Then

With Inet1

If Left(Trim(Txturl.Text), 6) <> "ftp://" Then

.URL = "ftp://" & Trim(Txturl.Text)

End If

If txtport.Text <> "" Then

.RemotePort = CInt(Trim(txtport.Text))

Else

.RemotePort = 21

End If

If Check1.Value = 1 Then

.UserName = ""

Else

.UserName = Trim(txtuser.Text)

.Password = Trim(txtpassword.Text)

End If

End With

currentserverdir = "/"

If Inet.StillExecuting Then

MsgBox "无法断开保持连接"

Exit Sub

End If

listserver

cmd1.Enabled = True

cmd2.Enabled = True

End If

If index = 1 Then

Inet1.Cancel

ListView1.ListItems.Clear

cmd2.Enabled = False

End If

If index = 2 Then

If currentserverdir <> "" Then

If Inet1.StillExecuting Then

MsgBox "还没有执行完毕！"

Else

operationstyle = 2

Inet1.Execute , "CD../"

upserverdir

End If

Else

MsgBox "已经到了最上一层目录！"

End If

End If

End Sub

Private Sub Form_Load()

Check1.Value = 1

Txturl.Text = "192.168.0.1"

txtport.Text = "21"

txtuser.Text = ""

txtpassword.Text = ""

txtstatus.Text = ""

txtuser.Enabled = False

txtpassword.Enabled = False

txtpassword.PasswordChar = "*"

Combo1.Text = ""

cmd0.Enabled = True

cmd1.Enabled = False

cmd2.Enabled = False

ListView1.ColumnHeaders.Add 1

End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)

Dim temparray As Variant

Dim i As Integer

Dim filesize As Variant

Dim itmX As ListItem

On Error Resume Next

Select Case State

Case 0

Case 1

txtstatus.Text = txtstatus.Text & vbCrLf & "正在查询所指定的主机的IP地址"

Case 2

txtstatus.Text = txtstatus.Text & vbCrLf & "已成功找到所指定的主机的IP地址"

Case 3

txtstatus.Text = txtstatus.Text & vbCrLf & "正在与主机连接"

Case 4

txtstatus.Text = txtstatus.Text & vbCrLf & "已与主机连接成功"

Case 5

txtstatus.Text = txtstatus.Text & vbCrLf & "正在向主机发送请求"

Case 6

txtstatus.Text = txtstatus.Text & vbCrLf & "发送请求已成功"

Case 7

txtstatus.Text = txtstatus.Text & vbCrLf & "正在接收主机的响应"

Case 9

txtstatus.Text = txtstatus.Text & vbCrLf & "正在解除与主机的连接"

Case 10

txtstatus.Text = txtstatus.Text & vbCrLf & "已成功解除与主机的连接"

Case 11

txtstatus.Text = txtstatus.Text & vbCrLf & "与主机通信时出现了错误"

txtstatus.Text = txtstatus.Text & vbCrLf & "错误" & Inet1.ResponseCode & ":" & Inet1.ResponseInfo

Case 8, 12

Select Case operationstyle

Case 1

txtstatus.Text = txtstatus.Text & vbCrLf & "成功列出目录内容"

ListView1.ListItems.Clear

inetdata = Inet1.GetChunk(1024, 0)

Combo1.Text = currentserverdir

If Trim(inetdata) <> 0 Then

temparray = Split(inetdata, vbCrLf, , vbTextCompare)

i = 0

Do While i < UBound(temparray)

If temparray(i) <> "" Then

deallist (temparray(i))

End If

i = i + 1

Loop

End If

Case 2

txtstatus.Text = txtstatus.Text & vbCrLf & "成功改变目录"

listserver

Case Else

End Select

End Select

txtstaus.SelLength = Len(txtstatus.Text)

End Sub

Private Sub ListView1_DblClick()

Dim item As ListItem

If ListView1.HitTest(xpos, ypos) Is Nothing Then

Exit Sub

Else

Set item = ListView1.HitTest(xpos, ypos)

End If

Select Case item.Icon

Case 1

Case 2

operationstyle = 2

If item.Text = "./" Then

ElseIf item.Text = "../" Then

Inet1.Execute , "CD../"

upserverdir

Else

currentserverdir = currentserverdir & item

Inet1.Execute , "CD" & currentserverdir

End If

End Select

End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

xpos = x

ypos = y

End Sub

Private Sub upserverdir()

Dim temppos1 As Integer

On Error Resume Next

If currentserverdir <> "/" Then

temppso1 = InStrRev(currentserverdir, "/", Len(currentserverdir) - 1, vbTextCompare)

currentserverdir = Mid(currentserverdir, 1, temppos1)

End If

End Sub

Private Sub deallist(tempstr As String)

If Right(Trim(tempstr), 1) <> "/" Then

addfiletolist (tempstr)

Else

adddirtolist (tempstr)

End If

End Sub

Private Sub addfiletolist(tempstr As String)

Dim itmX As ListItem

Set itmX = ListView1.ListItems.Add(, , tempstr)

itmX.Icon = 1

itmX.SmallIcon = 1

End Sub

Private Sub adddirtolist(tempstr As String)

Dim itmX As ListItem

Set itmX = ListView1.ListItems.Add(, , tempstr)

itmX.Icon = 2

itmX.SmallIcon = 2

End Sub

Private Sub listserver()

On Error GoTo errorH

If Not Inet1.StillExecuting Then

operationstyle = 1

Inet1.Execute , "dir"

End If

Exit Sub

End Sub