CuteFTP上传脚本(VBS)
08月13日
Option Explicit ' 强制显式声明变量。
'************************************************* *******************
'* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'* CuteFTP Pro Script
'* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'*
'* 作者：张博
'*
'CuteFTP脚本(VBScript)，上传到多个服务器
'必须首先安装CuteFTP软件的较新版本（早期版本存在严重BUG，6.0版没有问题）
'运行脚本时可能需要首先关闭CuteFTP窗口（某些版本有此问题）
'需要配置的内容：
'变量appname 应用的名字，脚本执行过程中会显示
'变量LocalDir 用作中转的本地绝对路径，若不存在会自动创建
'数组RemoteInfo 目标服务器的信息，包括域名（IP）、用户、口令、基本路径
'对象MySite MySite2 的各项属性，连接源FTP和目标FTP的CuteFTP对象，需要配置站点域名或IP、用户名、口令
'数组JobInfo 要传输的文件的相对路径和文件名
' 相对路径可以为""或多级目录"dir1/dir2"
' 文件名可以带通配符，带通配符可能会连子目录一起操作，UNIX机要区分大小写
'执行时第一次提示任务名称，第二次提示要执行的任务（此时可以取消任务），确定后实际执行任务，最后提示任务完成
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''
'通用函数
'改变本地工作路径
Function lChangeDir(varTE,vardir)
If ""=vardir Then Exit Function
If (Not (varTE.LocalExists(vardir))) Then
varTE.CreateLocalFolder vardir
End If
varTE.LocalFolder = vardir
End Function
'改变远程工作路径
Function rChangeDir(varTE,vardir)
Dim b
If ""=vardir Then Exit Function
b = varTE.RemoteExists(vardir)
If (Not Cbool(b)) Then
varTE.CreateRemoteFolder vardir
End If
varTE.RemoteFolder = vardir
End Function
'同时改变本地和远程工作路径
Function lrChangeDir(varTE,lbasedir,rbasedir,lrdir)
lChangeDir varTE , lbasedir
lChangeDir varTE , lrdir
'varTE.RemoteCommand "CD"
rChangeDir varTE , rbasedir
rChangeDir varTE , lrdir
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''
'属于特定应用的函数
Function AddRemoteInfo(infoarray,host,login,pass,basedir)
if infoarray(0,0) >= UBound(infoarray) then
MsgBox "AddRemoteInfo : array fulled"
Quit 1
End If
infoarray(0,0) = infoarray(0,0) + 1
infoarray(infoarray(0,0),0)=host
infoarray(infoarray(0,0),1)=login
infoarray(infoarray(0,0),2)=pass
infoarray(infoarray(0,0),3)=basedir
End Function
Function AddJobInfo(infoarray,reldir,file)
if infoarray(0,0) >= UBound(infoarray) then
MsgBox "AddRemoteInfo : array fulled"
Quit 1
End If
infoarray(0,0) = infoarray(0,0) + 1
infoarray(infoarray(0,0),0)=reldir
infoarray(infoarray(0,0),1)=file
End Function
Function InitTEObj(teobj,infoarray,i)
teobj.Protocol = "FTP"
teobj.Host = infoarray(i,0)
teobj.Login = infoarray(i,1)
teobj.Password = infoarray(i,2)
teobj.UseProxy = "OFF"
teobj.MaxConnections = 5
teobj.TransferType = "ASCII"
End Function
Dim appname '应用名称
Dim report '报告
Dim i,j '通用循环变量
appname = "省集中 文件发布"
report = ""
MsgBox "CuteFTP pro VBS 脚本 启动 - " & appname
Dim MySite 'FTP站点
Dim LocalDir '本地基本路径 必须是绝对路径
'创建CuteFtp 对象
Set MySite = CreateObject("CuteFTPPro.TEConnection")
'下标0用于记录有效数据的个数
Dim RemoteInfo(100,3) '数组下标基于0并且定义的是最大下标，因此可用的为（0-100，0-3）
'第二维依次为主机名、登录名、口令、基础路径，不使用第一维的0
Dim JobInfo(100,1) '不使用第一维的0，第二维依次为相对路径、文件名
RemoteInfo(0,0)=0
JobInfo(0,0)=0
'本地基本路径
LocalDir="本地根目录" '必须是绝对路径
'站点信息，只能添加一个远程站点，添加多个未经测试
AddRemoteInfo RemoteInfo,"ip地址","用户名","密码","远程根目录"
'任务信息
'AddJobInfo JobInfo,"相对路径","文件名，可带通配符，递归的"
'AddJobInfo JobInfo,"相对路径","文件名，可带通配符"
'AddJobInfo JobInfo,"相对路径","文件名，可带通配符"
'AddJobInfo JobInfo,"相对路径","文件名，可带通配符"
report = "即将执行下列任务:" & Chr(13) & Chr(10)
For i=1 To JobInfo(0,0)
report = report & Chr(13) & Chr(10) & JobInfo(i,0) & " - " & JobInfo(i,1)
Next
report = report & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "本地路径: " & Chr(13) & Chr(10) & LocalDir
report = report & Chr(13) & Chr(10) & "目的: "
For i=1 To RemoteInfo(0,0)
report = report & Chr(13) & Chr(10) & RemoteInfo(i,0) & ":" & RemoteInfo(i,3)
Next
If vbCancel = MsgBox(report,vbOKCancel) Then
Quit 1
End If
report = ""
For i=1 To RemoteInfo(0,0)
InitTEObj MySite,RemoteInfo,i
'连接到站点
MySite.Connect
If (Not Cbool(MySite.IsConnected)) Then
MsgBox "Could not connect to: " & MySite.Host & " Aborting!" &MySite.ErrorDescription
Quit(1)
End If
For j=1 To JobInfo(0,0)
lrChangeDir MySite,LocalDir,RemoteInfo(i,3),JobInfo(j,0)
MySite.Upload JobInfo(j,1)
Next
'关闭连接
MySite.Close
report = report & Chr(13) & Chr(10) & RemoteInfo(i,0)
Next
MsgBox "CuteFTP pro VBS 脚本 结束 - " & appname & Chr(13) & Chr(10) & report
