VBS DIAVIew 实现FTP 上传与下载

效果动画演示

 实现步骤

第一步：搭建局域网或本机的FTP 服务器 Win10

a） 进入控制面板==>程序和功能

b)  选择“启用或关闭Windows功能”==>对“Internet Information Services ” 下面对应的选项大打√==>点击“确定”安装成功==>重启电脑，然后进行 c 步骤。

c)  我的电脑==>右击选择“管理”

d)  网站==>右击添加“FTP站点”

 

e) 点击下一步，进入 FTP 绑定IP 和端口号==》点击下一步，进入“身份证和授权信息”==》点击完成，进入 f 步骤

f) 进行访问 ftp 服务地址 ，在浏览器网址中输入ftp所在服务器的地址如：“ftp://192.168.1.65”，进入登录界面。输入服务器的登录账号和密码即可。

 第二步：创建组态DIAView工程来实现FTP的上传于下载

a) 创建窗口如下：

b)  按钮“上传”==>事件“左键按下”

'FTP IP地址如：192.168.1.65 或 ftp.wwww.baidu.com
FTP_HOST=Trim(txtftpip.Text)
'FTP 登录用户名
FTP_USER=Trim(txtftpuser.Text)
'FTP 登录用户密码
FTP_PWD=Trim(txtftppwd.Text)
'被上传的文件目录
LOCAL_FOLDER =Trim(txtlocalpath.Text)
'被上传的文件名称 多个用英文逗号隔开；*好表示全部文件
strFileName =Trim(txtlocalfile.Text)
strFTPFolder=Trim(txtftpfolder.Text)
'strNewFileName=Sys.Year&Sys.Month&Sys.Day&Sys.Hour&Sys.Minute&Sys.Second&Sys.Millisecond

'Application
Set objShell = Createobject("Shell.Application")
'FileSystemobject
Set objFs = Createobject("Scripting.FileSystemobject")

strFtpUrl = "ftp://" & FTP_USER & ":" & FTP_PWD & "@" & FTP_HOST & "/" & strFTPFolder
Set obj2=objShell.NameSpace(LOCAL_FOLDER)
Set objFolderItems = obj2.Items()

For i = 0 To objFolderItems.Count - 1
    Set ofitem = objFolderItems.Item(i)
    'filePath=ofitem.path
    'filePathArray=Split(filePath,".",-1,1)
    'fileExt=filePathArray(UBound(filePathArray))
    'strFtpUrl=strFtpUrl&"/"&strNewFileName&"."&fileExt
    '表示上传全部
    If strFileName="*" then
        Set FD = objShell.NameSpace(strFtpUrl)
        FD.CopyHere ofitem,4096 '如果存在并覆盖
    End If
    If strFileName<>"*"  And  strFileName = ofitem.Name Then
        'strFtpUrl=strFtpUrl&strNewFileName&
        Set FD = objShell.NameSpace(strFtpUrl)
        FD.CopyHere ofitem,4096 '如果存在并覆盖
    End If
    
Next

MsgBox "上传成功！"

c)  按钮“下载”==>事件“左键按下”

 

'FTP IP地址如：192.168.1.65 或 ftp.wwww.baidu.com
str_server=Trim(txtftpip.Text)
'FTP 登录用户名
str_user=Trim(txtftpuser.Text)
'FTP 登录用户密码
str_password=Trim(txtftppwd.Text)
'被上传的文件目录
str_localDir =Trim(txtlocalpath0.Text)
'被上传的文件名称 多个用英文逗号隔开；*好表示全部文件
str_remoteFiles =Trim(txtlocalfile0.Text)
'FTP下载目录
str_remoteDir="\"&Trim(txtftpfolder0.Text)

ftp_configFile = "listfiles.ini"
Set ws = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")

'处理路径中的空格
str_remoteDir = Trim(str_remoteDir)
If InStr(str_remoteDir," ")>0 Then
    If Left(str_remoteDir,1)<> """" And Right(str_remoteDir,1) <> """" Then
        str_remoteDir = """" &str_remoteDir& """"
    End If
End If

'设置工作路径
originalWorkingDirectory = ws.CurrentDirectory
ws.CurrentDirectory = str_localDir

'生成ftp命令
ftpScript_str = ""
ftpScript_str = ftpScript_str & "USER " & str_user & vbCrLf 
ftpScript_str = ftpScript_str & str_password & vbCrLf 
ftpScript_str = ftpScript_str & "cd " & str_remoteDir & vbCrLf 
ftpScript_str = ftpScript_str & "binary" & vbCrLf 
ftpScript_str = ftpScript_str & "prompt off" & vbCrLf 

remoteFiles_obj = Split(str_remoteFiles,",")    
For Each remoteFile_str In remoteFiles_obj
    'remoteFile_str = Left(remoteFile_str,Len(remoteFile_str)-1)    '去除回车符（为什么会有换行符？）
    If InStr(remoteFile_str, " ")>0 Then
        remoteFile_str = """" & remoteFile_str & """"
    End If
    ftpScript_str = ftpScript_str & "get " & remoteFile_str & vbCrLf    
Next

ftpScript_str = ftpScript_str & "bye" & vbCrLf & "quit" & vbCrLf & "quit" & vbCrLf 

'创建临时文件
tempDir_str = ws.ExpandEnvironmentStrings("%TEMP%")
scriptFilePath_str = tempDir_str& "\" &fs.GetTempName
ftpResultPath_str = tempDir_str& "\" &fs.GetTempName

'临时ftp脚本文件
Set scriptFile_obj = fs.OpenTextFile(scriptFilePath_str,2,True)
scriptFile_obj.Write(ftpScript_str)
scriptFile_obj.Close

'执行ftp脚本
'logFileObject.WriteLine Time & "  Downloading files from ftp..."
ws.Run "%comspec% /c FTP -n -s:" &""""&scriptFilePath_str&""""& " " &str_server& " > " &ftpResultPath_str,0,True
'WScript.Sleep 1000

'临时ftp结果文件
Set resultFile_obj = fs.OpenTextFile(ftpResultPath_str,1)
successDownloadCount_int = 0
failToDownloadCount_int = 0
'WScript.Echo scriptFilePath_str & "  " &ftpResultPath_str
'WScript.Echo ftpScript_str

Do Until resultFile_obj.AtEndOfStream
currLine_str = resultFile_obj.ReadLine
'WScript.Echo currLine_str

'       If InStr(currLine_str,"get ")>0 And InStr(currLine_str,"forme")>0 Then 
If InStr(currLine_str,"get ")>0 Then
    currLine_str = Right(currLine_str,Len(currLine_str)-(InStr(currLine_str,"get ")+3))
    nextLine_str = resultFile_obj.ReadLine
    nextLine_str = resultFile_obj.ReadLine
    nextLine_str = resultFile_obj.ReadLine
    
    If InStr(nextLine_str,"226 Transfer complete")>0 Then
        successDownloadCount_int = successDownloadCount_int + 1
        'logFileObject.WriteLine Time & "  Finish downloading file(" &currLine_str& ")"
    Else
        failToDownloadCount_int = failToDownloadCount_int + 1
        'logFileObject.WriteLine Time & "  Error：Fail to download file(" &currLine_str& ")"
    End If
End If
Loop
resultFile_obj.Close

'logFileObject.WriteLine Time & "  Complete(" &successDownloadCount_int& ")    Failed(" &failToDownloadCount_int& ")"
'logFileObject.WriteBlankLines 1

MsgBox "下载完成！"