{******************************************************************************* Copyright (C), 2014-2020, aicaipiao File name: UFtpContentThd.pas Author: lipingchen Version: Date: 20140929 Description: Others: Function List: 解压缩文件 FTP遍历创建新目录 定时*******************************************************************************}unit UFtpContentThd;interfaceuses Classes,Forms,Dialogs,SysUtils,Windows,VCLZip,VCLUnZip,IdFTP,IdFTPList,IdFTPListParseWindowsNT,IdAllFTPListParsers;type TFtpContentThd = class(TThread) private protected ziper:TVCLZip; IdFTP: TIdFTP; Filename:string; //生成压缩文件名 FMessage: string; //消息 ZipUpLoadDir,ZipUpLoadDirTemp:string; //上传FTP的路径 FDeptID:string; //出票点ID public constructor Create; destructor Destroy;override; function CreatFtpDir(UpLoadDir:string): Boolean; //遍历当前FTP文件夹， 创建新目录或更改路径 //用法：Zip(压缩模式，压缩包大小，压缩或解压文件，解压或压缩目录，TVCLZip控件) //ZipMode为0：压缩；为1：解压缩 PackSize为0则不分包；否则为分包的大小 function Zip(ZipMode,packSize:Integer;ZipFile,UnzipDir:string):Boolean; protected procedure Execute; override; end;var FtpContentThd:TFtpContentThd;implementationuses UPubTypeVarCon;{ TFtpContentThd }constructor TFtpContentThd.Create;begin if not DirectoryExists(pub_ZipFileSaveDir) then //压缩包保存路径 CreateDir(pub_ZipFileSaveDir); try inherited Create(True); FreeOnTerminate := True; Resume; FDeptID:='6'; ziper:=TVCLZip.Create(nil); IdFTP:=TIdFTP.Create; LogMsg('创建FTP上传线程成功!',true,true); except on e:exception do begin FMessage:='创建FTP上传线程出错!'#13+e.Message; LogMsg(FMessage,true,true); end; end;end;procedure TFtpContentThd.Execute;begin while not Terminated do begin Filename:=FormatDateTime('yyyy',Now)+'.'+FDeptID+'.'+FormatDateTime('mmddhhnnss',Now)+'.zip'; ZipUpLoadDir:=FormatDateTime('yyyy',Now)+'\'+FDeptID+'\'+FormatDateTime('mm',Now) +'\'+FormatDateTime('dd',Now)+'\'+FormatDateTime('hh',Now); if not Zip(0,0,pub_ZipFileSaveDir+'\'+Filename,pub_UnZipFileSaveDir) then //将abc.zip解压到路径，若不存在会自动创建目录的。 begin //执行失败 Sleep(pub_FtpExecInterval * 1000); //等待一下 Continue; // exit； end; //发送 with IdFTP do begin if not Connected then begin Username:=pub_FtpUsername; Password:=pub_FtpPassword; try Connect(pub_FtpHost,pub_FtpPort); except on e:exception do begin FMessage:='连接FTP服务器出错!'#13+e.Message; LogMsg(FMessage,true,true); Break; end; end; end; if Connected then begin if ZipUpLoadDirTemp<>ZipUpLoadDir then //上传保存的路径改变，则创建新目录或更改路径。 begin ChangeDir(pub_ZipUpLoadRtDir); //先回到设定的根目录 CreatFtpDir(ZipUpLoadDir); end; try Put(pub_ZipFileSaveDir+'\'+Filename,Filename); Sleep(pub_FtpExecInterval * 1000); //等待中 deletefile(PChar(pub_ZipFileSaveDir+'\'+Filename)); //删除已上传的文件 except on e:exception do begin FMessage:='文件上传FTP服务器出错!'#13+e.Message; LogMsg(FMessage,true,true); Continue; end; end; end; end; ZipUpLoadDirTemp:=ZipUpLoadDir; end;end;function TFtpContentThd.Zip(ZipMode, packSize: Integer; ZipFile, UnzipDir: string): Boolean;begin if copy(UnzipDir,length(UnzipDir),1)='\'then UnzipDir:=copy(UnzipDir,1,length(UnzipDir)-1);//去除目录后的'\' try ziper.DoAll:=False;//加此设置将对分包文件解压缩无效 ziper.OverwriteMode:=Always;//总是覆盖模式 if PackSize<>0then //0则压缩成一个文件，否则压成多文件 begin ziper.MultiZipInfo.MultiMode:=mmBlocks;//设置分包模式 ziper.MultiZipInfo.SaveZipInfoOnFirstDisk:=True;//打包信息保存在第一文件中 ziper.MultiZipInfo.FirstBlockSize:=PackSize;//分包首文件大小 ziper.MultiZipInfo.BlockSize:=PackSize;//其他分包文件大小 end; ziper.FilesList.Clear; ziper.ZipName:=ZipFile;//获取压缩文件名 if ZipMode=0then //压缩 begin ziper.FilesList.Add(UnzipDir+'\*.txt'); //添加压缩文件列表 设定为|*.txt文档，若需压缩全部可\*.* Application.ProcessMessages; ziper.Zip; end else begin ziper.DestDir:=UnzipDir;//解压缩的目标目录 ziper.UnZip; //解压缩 end; Result:=True; except on ex:exception do begin Result:=False; FMessage := '文件解压缩异常'#13 + ex.Message; LogMsg(FMessage,True,True); end; end;end;function TFtpContentThd.CreatFtpDir(UpLoadDir: string): Boolean;var CreatDirList: TStringList; //DirList:TStringList; i,j,flag:Integer;begin CreatDirList:=TStringList.Create; //DirList:=TStringList.Create; CreatDirList.Delimiter :='\'; CreatDirList.DelimitedText :=UpLoadDir; for i := 0 to CreatDirList.Count - 1 do begin if CreatDirList[i]<>'' then begin flag:=0; IdFTP.List; //ShowMessage(IntToStr(IdFTP.DirectoryListing.Count)); //默认uses idftplistParse异常；要添加IdFTPListParseWindowsNT,IdAllFTPListParsers单元 for j := 0 to IdFTP.DirectoryListing.Count-1 do //indy10要添加IdFTPListParseWindowsNT,IdAllFTPListParsers单元 begin //介绍：http://blog.sunshow.net/2007/07/tidftp-directorylisting-usage/ if IdFTP.DirectoryListing.Items[j].ItemType = ditDirectory then //要添加单元IdFTPList begin if IdFTP.DirectoryListing.Items[j].FileName = CreatDirList[i] then begin flag:=1; //标志已经存在该目录 Break; end; end; end; if flag=0 then IdFTP.MakeDir(CreatDirList[i]); //新创建文件夹 IdFTP.ChangeDir(CreatDirList[i]); //更改目录 end; //***以下DirList内容有空格,IndexOf(CreatDirList[i])识别不了；也不严谨*** { if CreatDirList[i]<>'' then begin IdFTP.List(DirList,'',True); if (DirList.IndexOf(CreatDirList[i])=-1) then begin try IdFTP.MakeDir(CreatDirList[i]); except on ex:Exception do LogMsg('添加目录名:'+CreatDirList[i]+'出错,原因：'+ex.Message,True,True ); end; try IdFTP.ChangeDir(CreatDirList[i]); except on ex:Exception do LogMsg('变更目录名:'+CreatDirList[i]+'出错,原因：'+ex.Message,True,True ); end; end; end; } //***以下忽略异常，懒虫写法，*** { try IdFTP.ChangeDir(CreatDirList[i]); except IdFTP.MakeDir(CreatDirList[i]); IdFTP.ChangeDir(CreatDirList[i]); end;} //***以下忽略异常，懒虫写法，*** { try IdFTP.MakeDir(CreatDirList[i]); finally IdFTP.ChangeDir(CreatDirList[i]); end; } end; Result :=True;end;destructor TFtpContentThd.Destroy;begin //inherited; //继承会产生异常 为什么？？ ziper.Free; IdFTP.Free; try FtpContentThd.Terminate; WaitForSingleObject(FtpContentThd.Handle, 500); FtpContentThd := nil; except on ex:Exception do begin end; end; // LogMsg('FTP上传线程终止',False,true);end;initialization //finalization //end.