...einen lokalen Verzeichnis auf einem FTP-Server uploaden?

procedure UploadPerFTP;
  procedure GetDir(dir: string);
  var
    SearchRec: TSearchRec;
    details, nodetails: TStringList;
    k: Integer;
  begin
    //iterate through directory given
    //schleife über alle dateien im ordner
    if FindFirst(dir + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat

        //get rid of the both "dummy-directories" '.' and '..'
        //die ordner '.' und '..' brauchen man nicht
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          //if we found a folder
          //falls wir einen ordner haben
          if (SearchRec.Attr and faDirectory) = faDirectory then
          begin
            //get folder contents from ftp. one with details, one without
            //holen wir uns den ordnerinhalt mit details und einmal ohne vom server
            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 '..')
            //nun filtern wir das nach den ordnern (ohne '.' und '..')
            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
            //falls unser ordner auf dem server noch nicht existiert, legen wir ihn an
            if nodetails.IndexOf(SearchRec.Name) = -1 then
            begin
              FTPClient.MakeDir(SearchRec.Name);
            end;

            //change into next directory on server
            //nun wechseln wir in den nächsten ordner
            FTPClient.ChangeDir(SearchRec.Name);
            details.Free;
            nodetails.Free;

            //and also locally go into the next subfolder
            //und suchen lokal im nächsten unterordner weiter
            GetDir(dir + SearchRec.Name + '\');

            //we have to go one directory up after leaving the recursion
            //wenn die rekursion zurück ist, müssen wir wieder eine ordnerstufe hochgehen
            FTPClient.ChangeDirUp;
          end 
          else 
          begin
            //if it's only a file, upload it to the current directory
            //falls wir eine datei angetroffen haben, können wir diese uploaden
            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)
  //hier kommen die grundangaben für unseren ftp client hin (TIdFTPClient)
  with FTPClient do
  begin
    Host     := 'your_server.com';            // Adjust your data here / Hier gwünschte Daten eintragen
    Username := 'your_username';
    // Adjust your data here / Hier gwünschte Daten eintragen
    Password := 'your_password';
    // Adjust your data here / Hier gwünschte Daten eintragen
    Passive := True;                      // Adjust your data here / Hier gwünschte Daten eintragen
  end;
  FTPClient.Connect;

  //if you want to upload you data to an remote-directory, enter it below (does not matter if 'dir\dir' or 'dir/dir')
  //falls die daten in ein remote-directory heraufgeladen werden sollen, kann es hier angegeben werden (egal ob 'dir\dir' oder 'dir/dir')
  dir := StringReplace('your/remote_directory', '\', '/', [rfReplaceAll]);
  // Adjust your data here / Hier gwünschte Daten eintragen

  //remove first '/' if there's one
  //wir löschen das erste '/', falls eines existiert
  if dir <> '' then
  begin
    if dir[1] = '/' then Delete(dir, 1, 1);

    //but add a '/' at the end
    //aber am ende fügen wir ein '/' hinzu
    if dir[Length(dir)] <> '/' then dir := dir + '/';

    //loop through our remote-directories
    //schleife über alle remote-directories
    while Pos('/', dir) > 0 do
    begin
      //get folder contents from ftp. one with details, one without
      //runterladen der aktuellen ordnerinhalte vom server (mit und ohne details)
      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 '..')
      //wir wollen wieder nur ordner ohne '.' und '..'
      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
      //falls der ordner nicht existiert, legen wir ihn an
      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
      //nun wechseln wir in den nächsten ordner auf dem server
      FTPClient.ChangeDir(Copy(dir, 1, Pos('/', dir) - 1));

      //remove first directory from path ('your/directory/subdir/' --> 'directory/subdir/')
      //wir schneiden den ersten ordner vom pfad ab ('dein/ordner/unterordner/' --> 'ordner/unterordner/')
      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
  //der ftp client ist nun im remote-directory bereit
  //wür können anfangen unseren lokalen ordner raufzuladen
  dir := 'C:\your\local\directory\';
  // Adjust your data here / Hier gwünschte Daten eintragen
  if dir[Length(dir)] <> '\' then dir := dir + '\';
  GetDir(dir);
  FTPClient.Disconnect;
end;

printed from
www.swissdelphicenter.ch
developers knowledge base