你可以Shell运行以下程序,也可以翻译成Delphi
'这个程序复制一个目录到目标目录,用于定时系统备份任务
'它的特点是对于不变的文件不复制,对变的都复制。源文件删除,目标文件也删除
'它必须有两个参数 源目录 目标目录
' CopyRight by Pan maolin At 2002.01
' Version 1
Option Explicit
'检查是新文件或者已经被修改
'返回 n 是新建 m 是修改
Function FCheckModify(ff,ffiles)
dim bf,f
bf = "n"
for each f in ffiles
if (ff.name = f.name) then
if (ff.DateLastModified=f.DateLastModified) then
bf = " "
else
bf = "m"
end if
exit for
end if
next
FCheckModify = bf
end function
'检查文件在文件夹中
Function FinFiles(ff,ffiles)
dim bf,f
bf = false
for each f in ffiles
if (ff.name = f.name) then
bf = true
exit for
end if
next
FinFiles = bf
end function
'同步目的目录与源中的文件
sub synFiles(source,destination)
dim fso,f,fsfiles,fdfiles
dim bUpdate
dim iVal
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
if not(fso.FolderExists(source)) then
exit sub
end if
'如果没有目标目录,创建它
if not(fso.FolderExists(destination)) then
Set f = fso.CreateFolder(destination)
end if
'创建文件集合
Set f = fso.GetFolder(source)
Set fsfiles = f.files
Set f = fso.GetFolder(destination)
Set fdfiles = f.files
'删除目的中文件在源中不存在文件
for each f in fdfiles
if not FinFiles(f,fsfiles) then
fso.DeleteFile(destination+"/"+f.name)
end if
next
'更新文件
For Each f In fsfiles
bUpdate = FCheckModify(f,fdfiles)
if bUpdate <> " " then
Err.Clear '清除错误。
fso.CopyFile source+"/"+f.name,destination+"/"+f.name,true
If Err.Number<>0 then
iVal = MsgBox(Err.Description,vbExclamation+vbOKOnly,"文件复制")
writelog(CDate(Now)&" 无法复制文件"&source&"/"&f.name&"到"&destination&"/"&f.name)
End If
End If
next
end sub
'同步目的目录
sub synForders(source,destination)
'同步文件
call synfiles(source,destination)
'处理目录
dim fso,f,fsfiles,fdfiles
Set fso = CreateObject("Scripting.FileSystemObject")
if not(fso.FolderExists(source)) then
exit sub
end if
'如果没有目标目录,创建它
if not(fso.FolderExists(destination)) then
Set f = fso.CreateFolder(destination)
end if
'创建目录集合
Set f = fso.GetFolder(source)
Set fsfiles = f.SubFolders
Set f = fso.GetFolder(destination)
Set fdfiles = f.SubFolders
'删除目的中在源中不存在目录
for each f in fdfiles
if not FinFiles(f,fsfiles) then
fso.DeleteFolder destination+"/"+f.name , true
end if
next
'更新目录
for each f in fsfiles
call synForders(source+"/"+f.name,destination+"/"+f.name)
next
end sub
'日志处理程序
sub writelog(logstr)
dim logfile
dim fso,f
logfile = WScript.ScriptName
if instr(logfile,".") <> 0 then
logfile = left(logfile, instr(logfile,".")-1)
end if
logfile = logfile & "_err.log"
Set fso = CreateObject("Scripting.FileSystemObject")
set f = fs
penTextFile(logfile, 8 , True)
f.writeline(logstr)
f.close
end sub
'主程序
sub main
dim args,i
dim source,destination
dim fso,f
set args = WScript.Arguments
if args.count < 2 then
WScript.Echo "没有足够的参数"+ vbCRLF + "参数是 源目录 目标目录"
exit sub
end if
source = args(0)
destination = args(1)
writelog(CDate(Now)&" 开始同步 "&source&" 到 "&destination)
Set fso = CreateObject("Scripting.FileSystemObject")
if not(fso.FolderExists(source)) then
WScript.Echo "没有正确源目录"
exit sub
end if
'如果没有目标目录,创建它
if not(fso.FolderExists(destination)) then
Set f = fso.CreateFolder(destination)
end if
if not(fso.FolderExists(destination)) then
WScript.Echo "没有正确目标目录"
exit sub
end if
call synForders(source,destination)
end sub
main
writelog(CDate(Now)&" ok")