我做的可上传下载控件,欢迎使用。
发表于:2007-06-30来源:作者:点击数:
标签:
这是控件的源程序: 工程名:MY 控件名:TESTFTP Dim FileName As String Dim connect As Boolean Private Sub CmdCd_Click() Call Link ‘’ .net 1.Execute , cd c2000 connect = True End Sub Private Sub CmdList_Click() If connect = True Then Inet1.E
这是控件的源程序:
工程名:MY
控件名:TESTFTP
Dim FileName As String
Dim connect As Boolean
Private Sub CmdCd_Click()
Call Link
‘’
.net1.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
.A
clearcase/" target="_blank" >ccessType = 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文件后再注册一下。
在网页里的调用:
<html>
<head>
<meta http-equiv="Content-Type"
content="text/html; charset=gb_2312-80">
<meta name="GENERATOR" content="Microsoft FrontPage Express 2.0">
<title>我的控件</title>
</head>
<body bgcolor="#FFFFFF">
<p><object id="1" name="1"
classid="clsid:282433B5-27DA-11D4-BE9B-0050BADA248E"
align="baseline" border="0" width="320" height="240"></object></p>
</body>
</html>
试用结果应该不错的。
原文转自:http://www.ltesting.net