我做的可上传下载控件,欢迎使用。

发表于: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
    .Aclearcase/" 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