VB中用inet控件通过FTP实现单个文件和多个文件的上传

来源:互联网 发布:淘宝店铺暂停营业 编辑:程序博客网 时间:2024/05/02 02:54

来自:http://lihb810.blog.163.com/blog/static/59451162200810275926721/


公司里有个VB开发的软件要做个ftp上传文件功能,基本实现方法如下:

1、inet控件添加:

   打开VB,新建一个工程,新建一个窗体Form1,点击VB6.0上面的工程-部件-控件-选择“Microsoft Internet Transfer 6.0 (SP4)”-应用-确定;

   这样,把inet控件添加到了左侧的工具栏

2、界面控件添加:

   在FORM1窗体中添加4个控件

    (1)iinet1   (这个就是刚添加的inet控件)

     (2)Command1

    (3)label3

    (4)text1

3、建文件目录:

    FTP目录:ftp://192.192.0.35 用户名:ftpID 密码:ftpPWD

   本地要上传的文件目录:D:\Vbinet

   (向D:\Vbinet目录下添加文件DD.txt用于测试)

4、代码:

Option Explicit

Private Sub Command1_Click()

Dim filename, putfile As String

 

'设置FTP的地址、协议类型、用户名、密码

Inet1.URL = "ftp://192.192.0.35"  'FTP的地址

Inet1.Protocol = icFTP

'协议类型

Inet1.UserName = "ftpID"   'FTP的用户名

Inet1.Password = "ftpPWD"  'FTP的密码

 

'以下是同一文件夹下多文件上传

'

(把D:\VBinet文件夹下的所有txt文件上传到ftp://192.192.0.35的receive目录下)

filename = Dir("D:\VBinet\*.txt")

' If filename <> "" Then

Do While filename <> ""

Text1.Text = filename & vbCrLf & Text1.Text

putfile = "put D:\VBinet\" & filename & " " & "receive\" & filename

Inet1.Execute , putfile

Do While Inet1.StillExecuting

DoEvents

Loop

filename = Dir

Loop

 

'以下是单文件上传

'

(把D:\VBinet文件夹下的DD.txt文件上传到ftp://192.192.0.35的receive目录下)

'Inet1.Execute , "put D:\VBinet\DD.txt receive\DD.txt"

'Do While Inet1.StillExecuting

'

DoEvents

'Loop

End Sub

 

Private Sub Inet1_StateChanged(ByVal State As Integer)

Dim temp As String

 

Select Case State

Case icNone

Case icResolvingHost

temp = "正在查找"

Case icHostResolved

temp = "已找到IP地址"

Case icConnecting

temp = "正在连接。。。。"

Case icConnected

temp = "连接成功"

Case icRequesting

temp = "正在发送请求。。。。"

Case icRequestSent

temp = "发送请求成功"

Case icReceivingResponse

temp = "正在接受 主机的响应"

Case icResponseReceived

temp = "已经接受主机的响应"

Case icDisconnecting

temp = "正在解除与主机的连接。。。"

Case icDisconnected

temp = "已解除与主机的连接。"

Case icError

temp = Inet1.ResponseCode & Inet1.ResponseInfo

Case icResponseCompleted

temp = "已经接收到数据"

End Select

Label3.Caption = temp

End Sub

 

 

另外:

  如果想获得当前文件的目录:

  这个需要先引用 Microsoft Scripting Runtime

 

Dim FS,Folder,FolderFiles As String

Set FS = CreateObject("Scripting.FileSystemObject")

(FS的定义和实例化可以用  Dim FS As new FileSystemObject)

 

Set Folder = FS.GetFolder(App.Path)        'OBJECT得到目录

Set FolderFiles = Folder.Files                     'OBJECT目录文件集

如果目录不存在,则创建

If Dir(strCSend, vbDirectory) = "" Then FS.CreateFolder (strCSend)

If Dir(strCSendBak, vbDirectory) = "" Then FS.CreateFolder (strCSendBak)

If Right(strCSend, 1) <> "\" Then

strCSend = strCSend+ "\"

End If

strCSend = strCSend+ "\send\"

strCSendBak = strCSend+ "\send\BAK\"