可上传下载控件(转)

这是控件的源程序：
工程名：MY
控件名：TESTFTP

Dim FileName As String
Dim connect As Boolean


Private Sub CmdCd_Click()

Call Link
'Inet1.Execute , "cd c2000"
connect = True

End Sub

Private Sub CmdList_Click()

If connect = True Then
Inet1.Execute , "LS"
Else
Label1.Caption = "please click connect first!"
End If

End Sub


Private Sub Combo1_Click()

FileName = Combo1.Text 'file name of download file

End Sub

Private Sub CmdDown_Click()

Dim FileLast As String 'last name of file
Dim SaveFileName As String 'file name in ftpserver
Call Link

If FileName = "" Then
Label1.Caption = "please select file to download!"
Else
FileLast = ""
For i = 1 To Len(FileName)
If Mid(FileName, i, 1) <> "." Then
FileLast = FileLast + Mid(FileName, i, 1)
Else
FileLast = ""
End If
Next
REDO: CommonDialog1.ShowSave

If InStr(1, CommonDialog1.FileName, " ", 1) > 0 Then
Label1.Caption = "The file can't include space!"
MyVar = MsgBox("Redo it?", 65, "Download file")
If MyVar = "1" Then
GoTo REDO:
Else
GoTo NODO:
End If
End If

SaveFileName = CommonDialog1.FileName & "." & FileLast
Inet1.Execute , "GET " & FileName & " " & SaveFileName
End If
NODO:

End Sub

Private Sub CmdUpload_Click()

Dim SaveFileName As String
Dim UpFileName As String 'file name of upload file include path
Dim MyVar
SaveFileName = ""
Call Link

REDO:CommonDialog1.ShowOpen

If InStr(1, CommonDialog1.FileName, " ", 1) > 0 Then
MsgBox "The file can't include space!"
MyVar = MsgBox("Redo it?", 65, "Upload file")
If MyVar = "1" Then
GoTo REDO:
Else
GoTo NODO:
End If
End If

UpFileName = CommonDialog1.FileName
'MsgBox UpFileName

For i = 1 To Len(UpFileName)
If Mid(UpFileName, i, 1) <> "" Then
SaveFileName = SaveFileName + Mid(UpFileName, i, 1)
Else
SaveFileName = ""
End If
Next

If SaveFileName = "" Then
Label1.Caption = "no file!"
Else
Inet1.Execute , "PUT " & UpFileName & " " & SaveFileName
End If
NODO:

End Sub




Private Sub Inet1_StateChanged(ByVal State As Integer)

Select Case State
Case 1
Label1.Caption = "正在查询所指定的主机的 IP 地址"
Case 2
Label1.Caption = "成功地找到所指定的主机的 IP 地址。"
Case 3
Label1.Caption = "正在与主机连接"
Case 4
Label1.Caption = "连接成功"
Case 5
Label1.Caption = "正在向主机发送请求"
Case 6
Label1.Caption = "发送请求已成功"
Case 7
Label1.Caption = "正在接收主机的响应"
Case 8
Label1.Caption = "成功地接收到主机的响应"
Case 11
Label1.Caption = "出现了错误。"
Case 12
Label1.Caption = "该请求已经完成，并且所有数据均已接收到"
Dim vtData As Variant '数据变量。
Dim strData As String: strData = ""
Dim bDone As Boolean: bDone = False
Dim LenStr As Integer 'the length of liststr
Dim ListStr As String 'get string from ftpserver
Dim ItemStr As String 'the item file name of liststr
Dim i As Integer
'取得第一块。
vtData = Inet1.GetChunk(1024, icString)
DoEvents
Do While Not bDone
strData = strData & vtData
DoEvents
'取得下一块。
vtData = Inet1.GetChunk(1024, icString)
If Len(vtData) = 0 Then
bDone = True
End If
Loop
Combo1.Clear
ListStr = strData
LenStr = Len(ListStr)
For i = 1 To LenStr
If Mid(ListStr, i, 1) <> Chr(13) Then
ItemStr = ItemStr + Mid(ListStr, i, 1)
Else
If Left(ItemStr, 1) = Chr(10) Then
ItemStr = Mid(ItemStr, 2)
End If
If Right(ItemStr, 1) <> "/" Then
Combo1.AddItem ItemStr
End If
ItemStr = ""
End If
Next
End Select

End Sub


Private Sub Link()

With Inet1
.AccessType = 0
.URL = "http://10.132.16.135"
.UserName = "root"
.Password = "super"
.Protocol = icFTP
.RequestTimeout = 10
End With

End Sub


Private Sub UserControl_Terminate()

Inet1.Execute , "close"

End Sub

说明：有关主机名称，用户及口令等要改为你实际使用的。
生成OCX文件后再注册一下。
在网页里的调用：



content="text/html; charset=gb_2312-80">

我的控件

classid="clsid:282433B5-27DA-11D4-BE9B-0050BADA248E"
align="baseline" border="0" width="320" height="240">

试用结果应该不错的。

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/7178747/viewspace-161985/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/7178747/viewspace-161985/