Закачать локальную директорию по FTP

Закачать локальную директорию по FTP

procedure uploadperftp;
procedure getdir(dir: string);
var
searchrec: tsearchrec;
details, nodetails: tstringlist;
k: integer;
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') or
(nodetails.strings[k] = '.') or
(nodetails.strings[k] = '..') then
begin
details.delete(k);
nodetails.delete(k);
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);
details.free;
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
hochgehen
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;
begin
//set some basic settings on your ftp client (tidftpclient)
with ftpclient do
begin
host := 'your_server.com'; // adjust your data here / hier gwunschte daten eintragen
username := 'your_username';
// adjust your data here
password := 'your_password';
// adjust your data here
passive := true; // adjust your data here
end;
ftpclient.connect;

//if you want to upload you data to an remote-directory, enter it below (does not matter if 'dirdir' or 'dir/dir')
dir := stringreplace('your/remote_directory', '', '/', [rfreplaceall]);
// adjust your data here

//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
//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') or
(nodetails.strings[k] = '.') or
(nodetails.strings[k] = '..') then
begin
details.delete(k);
nodetails.delete(k);
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));
details.free;
nodetails.free;
end;
end;

//ftp client is ready in your remote-directory
//begin to upload our local directory
dir := 'c:yourlocaldirectory';
// adjust your data here
if dir[length(dir)] <> '' then dir := dir + '';
getdir(dir);
ftpclient.disconnect;
end;

Автор: marco senn
http://tooldesign.ch/
Источник: http://www.swissdelphicenter.ch

Эта запись была добавлена в Понедельник, 12 мая, 2008 - 4:21 В разделы Операционная система, Сети, интернет. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.