来自: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\"