VB6.0 FTP文件上传器

FTP文件上传

Public StateStyle As Integer

Private Sub cmdDIR_Click()

StateStyle = 0

Inet1.AccessType = icUseDefault '设置与Internet连接的类型，默认值

Inet1.Protocol = icFTP

Inet1.RemotePort = 21

bln = False

Inet1.Execute txtURL.Text, "DIR " '检索目录

End Sub

Private Sub cmdSend_Click()

Dim myfilepath As String

myfilepath = File1.Path & "\" & File1.FileName

StateStyle = 1

Inet1.Execute txtURL.Text, "SEND " & myfilepath & " " & File1.FileName '上载文件

MsgBox "上传已成功！", , "系统提示"

StateStyle = 0

Inet1.AccessType = icUseDefault '设置与Internet连接的类型，默认值

Inet1.Protocol = icFTP

Inet1.RemotePort = 21

bln = False

Inet1.Execute txtURL.Text, "DIR " '检索目录

End Sub

Private Sub Dir1_Change()

File1.Path = Dir1.Path

End Sub

Private Sub Drive1_Change()

Dir1.Path = Drive1.Drive

End Sub

Private Sub Form_Load()

StateStyle = 0

lv.ColumnHeaders.Add , , "文件", lv.Width / 1.5

Inet1.Execute txtURL.Text, "DIR " '检索目录

End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)

' State = 12 时，用 GetChunk 方法检索服务器的响应。

Dim vtData As Variant

Dim inetdata

Dim i As Integer

Select Case state

Case icHostResolvingHost

Label2.Caption = "正在查询所指定的主机的 IP 地址"

Case icHostResolved

Label2.Caption = "已成功地找到所指定的主机的 IP 地址"

Case icConnecting

Label2.Caption = "正在与主机连接"

'...没有列举其他情况。

Case icResponseReceived

Label2.Caption = "已成功地接收到主机的响应"

Case icError '11

'出现错误时，返回 ResponseCode 和 ResponseInfo。

vtData = Inet1.ResponseCode & ":" & _

Inet1.ResponseInfo

Case icResponseCompleted '12

Select Case StateStyle

Case 0

lv.ListItems.Clear

inetdata = Inet1.GetChunk(1024, 0)

If Trim(inetdata) <> 0 Then

vtData = Split(inetdata, vbCrLf, , vbTextCompare)

i = 0

Do While i < UBound(vtData)

If vtData(i) <> "" Then

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

lv.ListItems.Add , , vtData(i), 2, 2

Else

lv.ListItems.Add , , Mid(vtData(i), 1, Len(vtData(i)) - 1), 1, 1

End If

End If

i = i + 1

Loop

End If

Case 1

inetdata = Inet1.GetChunk(1024, 0)

If Trim(inetdata) <> 0 Then

vtData = Split(inetdata, vbCrLf, , vbTextCompare)

i = 0

Do While i < UBound(vtData)

If vtData(i) <> "" Then

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

lv.ListItems.Add , , vtData(i), 2, 2

Else

lv.ListItems.Add , , Mid(vtData(i), 1, Len(vtData(i)) - 1), 1, 1

End If

End If

i = i + 1

Loop

End If

End Select

End Select

End Sub

Private Sub lv_DblClick()

Inet1.Execute txtURL.Text, "DIR " & "/" & lv.SelectedItem & "/" '检索目录

End Sub

度盘链接：链接：https://pan.删baidu.com/s/1N除rFUOb1u39nHdPkIQ5FFTQ

密码：30ul