Type TsFTPBackup = Class public host; port; username; password; dataInfo; ftpObj; logPath; defaultConfig; msg; Function Create(); Begin defaultConfig := TsFTPBackupConfig(); dataInfo := array(); End; Function Run(); Begin if not Host then Host := defaultConfig['Host']; if not port then port := defaultConfig['Port']; if not port then port := 990; if not username then username := defaultConfig['username']; if not password then password := defaultConfig['password']; if not initFtpObj() then return 0; for i,v in dataInfo do begin src := v['src']; destPath := v['destPath']; recursive := v['recursive']; if ifnil(recursive) then recursive := defaultConfig['recursive']; if not ifstring(src) or not src or not ifstring(destPath) or not destPath then begin msg := '配置有误,跳过,src='+tostn(src)+' destPath='+tostn(destPath); log(msg,'error'); continue; end; destPath := ReplaceStr(destPath,'/','\\'); if not IsPathDelimiter(destPath,length(destPath)) then begin msg := '配置有误,destPath应为目录,跳过'+src+'的备份!destPath='+destPath; log(msg,'error'); continue; end; destPath := ReplaceStr(destPath,'\\','/'); backupPath(src,destPath,recursive); end; return 1; End; Function backupPath(src,destPath,recursive); Begin path := ExtractFilePath(src); files := filelist('',src); if not files then begin msg := 'filelist('+src+')为空。'; log(msg,'note'); return 2; end; try ftpObj.MakeDir(destPath); except end; for j,f in files do begin if f['FileName']='.' or f['FileName']='..' then continue; if pos('D',f['Attr']) then begin if recursive then begin backupPath(path+'\\'+f['FileName']+"\\*",destPath+f['FileName']+'/',recursive); end; end else if f['Attr']='A' then begin backup(path+f['FileName'],destPath+f['FileName']); end; end; End; Function initFtpObj(); Begin ftpObj := CreateObject('FTP'); if not ftpObj then begin msg := "创建FTP对象出错"; log(msg,'error'); return 0; end; if not username or not password then begin msg := "用户名或密码为空"; log(msg,'error'); return 0; end; ftpObj.Host := Host; ftpObj.Username := username; ftpObj.Password := password; ftpObj.UseTLS := true; ftpObj.Port := port; try ftpObj.connect(); except msg := "连接出错,请检查地址端口帐号等信息是否正确或更新FileMgr.dll!"; log(msg,'error'); return 0; end; return 1; End; Function backup(srcfile,destfile); Begin size_s := filesize('',srcfile); size_d := ftpObj.Size(destfile); if size_s=size_d then begin msg := '源文件('+srcfile+')与目标文件('+destfile+')大小一致,跳过。'; log(msg); return 2; end; st_put:=CreateObject("TFileStream","",srcfile,0); try ret := ftpObj.Put(st_put,destfile,0); except msg := '源文件('+srcfile+')->目标文件('+destfile+')上传失败。'; log(msg,'error'); return 0; end; size_d := ftpObj.Size(destfile); if size_s=size_d then begin msg := '源文件('+srcfile+')->目标文件('+destfile+')上传成功。'; log(msg); return 1; end else begin msg := '源文件('+srcfile+')->目标文件('+destfile+')上传有误。'; log(msg,'error'); return 0; end; End; Function log(context,tag); Begin if not tag or not ifstring(tag) then tag := 'info'; context := Datetimetostr(now())+' ['+tag+'] '+context+"\r\n"; write(context); if not logPath then logPath := defaultConfig['logPath']; if not logPath then logPath := ExtractFilePath(SysExecName())+"log\\TsFTPBackup"; logfile := IncludeTrailingPathDelimiter(logPath)+datetostr(today())+".log"; pos := Filesize('',logfile); if pos<0 then pos := 0; ret := writefile(rwraw(),'',logfile,pos,length(context),context); if ret<>true then writeln('写日志出错!logfile='+logfile+',err='+ret); End; End;