中国开发网: 论坛: 程序员情感CBD: 贴子 620252
UnKnow365: [技术贴]各位有用delphi实现的上传整个目录的代码嘛?
参考网上找到的代码用indy控件做了一个,测试是可以的就是运行不稳定,上传整个目录有时可用有时传到一半死掉了。
现用代码如下:
//上传本地目录到FTP服务器指定目录
procedure UploadPerFTP(sSourceDir,sTargetDir:string;FtpClient:TidFtp);
procedure GetDir(dir: string);
var
SearchRec: TSearchRec;
details, nodetails: TStringList;
k: Integer;
s:string;
begin
//检测给定的目录iterate through directory given
if FindFirst(dir + '*.*', faAnyFile, SearchRec) = 0 then
begin
//循环将源目录及子目录文件上传服务器
repeat
//删除空目录和'.''..'目录get rid of the both "dummy-directories" ’.’ and ’..’
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
//找到源目录的一个子目录if we found a folder
if (SearchRec.Attr and faDirectory) = faDirectory then
begin
//从服务器取当前目录内容get folder contents from ftp. one with details, one without
details := TStringList.Create;
nodetails := TStringList.Create;
FTPClient.List(details, '', True);
//FTPClient.List(nodetails, '', False);

//获取没有'.''..'目录的目录列表we only want to have directories in the list (without ’.’ and ’..’)
for k := details.Count - 1 downto 0 do
begin
if details.Strings[k] <> '' then
begin
if (details.Strings[k][1] = 'd') then //文件
begin
s := Copy(details.Strings[k],56,1000);
if (s <> '.') and (s <> '..') then
nodetails.Add(s);
end;
end;
end;

//如果目录在服务器不存在则创建if our directory does not exists on the server, create it
if nodetails.IndexOf(SearchRec.Name) = -1 then
begin
FTPClient.MakeDir(SearchRec.Name);
end;

//进入创建//的目录change into next directory on server
FTPClient.ChangeDir(SearchRec.Name);
nodetails.Free;

//继续处理子目录and also locally go into the next subfolder
GetDir(dir + SearchRec.Name + '\');

//离开递归调用必需回到//上一级目录we have to go one directory up after leaving the recursion
FTPClient.ChangeDirUp;
end
else
begin
//文件,上传到当前目录if it’s only a file, upload it to the current directory
FTPClient.Put(dir + SearchRec.Name, SearchRec.Name);
end;
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
var
dir: string;
details, nodetails: TStringList;
k: Integer;
s: string;
begin
//对IdFTPClient控件设置一些基本参数
if FTPClient.Connected then FTPClient.Disconnect;
with FTPClient do
begin
AutoLogin := True;
Passive := True;
Host := pvs_Ftp_Host;
Username := pvs_Ftp_userName;
Password := pvs_Ftp_Password;
TransferType := ftBinary;
TransferTimeout := 30000;
ReadTimeout := 30000;
ConnectTimeout := 30000;
end;
try
FTPClient.Connect;
except
LogAlarmToText('连接FTP服务器失败!');
Exit;
end;

//如果想上传数据到远程目录,指定目录(格式'dir dir' 或 'dir/dir')
dir := StringReplace(sTargetDir,' ', '/', [rfReplaceAll]);

//以下代码用于在服务器上创建指定的目标目录
//************************************************************
//移除第一个'/' remove first ’/’ if there’s one
if dir <> '' then
begin
if dir[1] = '/' then Delete(dir, 1, 1);
//增加一个'/'在目录最后面(如果没有'/') but add a '/' at the end
if dir[Length(dir)] <> '/' then dir := dir + '/';

//遍历远程目录loop through our remote-directories
while Pos('/', dir) > 0 do
begin
//从FTP取目录内容get folder contents from ftp. one with details, one without
details := TStringList.Create;
nodetails := TStringList.Create;
FTPClient.List(details, '', True);
//FTPClient.List(nodetails, '', False);

//获取没有'.''..'目录的目录列表we only want to have directories in the list (without ’.’ and ’..’)
for k := details.Count - 1 downto 0 do
begin
if details.Strings[k] <> '' then
begin
if (details.Strings[k][1] = 'd') then //文件
begin
s := Copy(details.Strings[k],56,1000);
if (s <> '.') and (s <> '..') then
nodetails.Add(s);
end;
end;
end;

//如果服务器目标目录不存在则创建if our directory does not exists on the server, create it
if nodetails.IndexOf(Copy(dir, 1, Pos('/', dir) - 1)) = -1 then
begin
FTPClient.MakeDir(Copy(dir, 1, Pos('/', dir) - 1));
end;

//进入创建的目标目录change to our directory on server
FTPClient.ChangeDir(Copy(dir, 1, Pos('/', dir) - 1));

//删除第一层目录remove first directory from path (’your/directory/subdir/’ --> ’directory/subdir/’)
Delete(dir, 1, Pos('/', dir));//循环处理目录下的子目录
nodetails.Free;
end;
end;
//******************************************************************
//创建服务器目标目录完毕

//服务器远程目录已经准备完毕ftp client is ready in your remote-directory
//开始上传本地目录begin to upload our local directory
dir := sSourceDir;//'C:\OA_Backup_Server';
//if dir[Length(dir)] <> ' ' then dir := dir + ' ';//在目录串后面加一个空格(?)
if RightStr(dir,1) <> '\' then dir := dir + '\';
GetDir(dir);
FTPClient.Disconnect;
end;
日出东海落西山,愁也一天,喜也一天;遇事不钻牛角尖,人也舒坦,心也舒坦。

相关信息:


欢迎光临本社区,您还没有登录,不能发贴子。请在 这里登录