TsFTPBackup/TsFTP/TsFTPBackup.tsf

129 lines
4.1 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 := 21;
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);
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
try
ftpObj.MakeDir(destPath+f['FileName']+'/');
except
end;
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);
ret := ftpObj.Put(st_put,destfile,0);
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;