idFTP - Einen Ordner hochladen

F34r0fTh3D4rk · Verfasst: Fr 06.01.06 19:44

Hallo, ich suche schon die ganze Zeit hier im Forum, aber habe nichts gefunden.

Ich möchte mit idFTP einen Ordner mit all seinen Dateien und Unterordnern auf einen FTP hochladen, jedoch gibt es Probleme dabei. So bliebe mir nichts anderes übrig als eine umfangreiche rekurisiv suche mit ordner prüfen, erstellen etc zu schreiben. Das wäre ziemlich aufwendig, gibt es da nicht eine möglichkeit ? oder schon etwas fertiges ?

hier ein source ausschnitt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

procedure ListFiles(const List: TStrings; Directory: string);
var
  SR: TSearchRec;
begin
  if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then
  try
    repeat
      List.Add(Directory + SR.Name)
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
end;

  flist := TStringList.Create;
  try
    ListFiles(flist, extractpath);
    flist.Delete(0);
    flist.Delete(0);
    for j := 0 to flist.count - 1 do
      MainForm.idFTP.Put(flist[j]);
  finally
    flist.free;
  end;

bei den beiden markierten zeilen bin ich nicht sicher, es löscht die ersten beiden einträge in der liste, weil ich glaube, dass sie überflüssig sind.

(ok ich mach mich schonmal an den rek. algo)

EDIT: ich habs so probiert

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

procedure UploadDir(ADir: String);
  procedure ScanDir(const Directory: String);
  var
    SR: TSearchRec;
    buf: string;
  begin
    buf := '';
    if FindFirst(Directory + '*.*', faAnyFile - faDirectory, SR) = 0 then
    try
      repeat
        MainForm.idFTP.Put(Directory + SR.Name);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
    if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Attr = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
           begin
             buf := Directory;
             buf := copy(directory, length(zippath), length(directory) - length(ADir));
             MainForm.idFTP.MakeDir(buf + SR.Name + '\');
             ScanDir(Directory + SR.Name + '\');
           end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
begin
  if ADir = '' then Exit;
  if ADir[Length(ADir)] <> '\' then
    ADir := ADir + '\';
  ScanDir(ADir);
end;

dann hängt sich das ganze programm auf.
muss ich eigentlich prüfen, ob ein verzeichnis existiert, bevor ich es erstelle ? (weil ich dafür ja alle dateien auflisten müsste - sieht so aus ^^)

EDIT: Jetzt passiert garnischt mehr Oo

EDIT: Jetzt hängt es Oo

vielen dank schonmal

Jailbird · Beiträge: 127 Windows XP Pro SP2 Delphi 7 Professional

www.swissdelphicente...showcode.php?id=2201

F34r0fTh3D4rk · Verfasst: Sa 07.01.06 15:40

vielen dank

das funzt nur noch nicht so ganz erste sahne, es wird nämlich komplett die ordnerstruktur übernommen, also c:\... ich will ja eigentlich nur einen ordner mit seiner struktur hochladen. außerdem gibt es fehler, wenn eine datei schon existiert, die sollte dann am besten überschrieben werden.

ich hab das ein wenig gekürzt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:

procedure UploadPerFTP(var Directory: string);
  procedure GetDir(dir: string);
  var
    SearchRec: TSearchRec;
    details, nodetails: TStringList;
    k: Integer;
  begin
    Application.ProcessMessages;
    if FindFirst(dir + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          if (SearchRec.Attr and faDirectory) = faDirectory then
          begin
            details   := TStringList.Create;
            nodetails := TStringList.Create;
            MainForm.IdFTP.List(details, '', True);
            MainForm.IdFTP.List(nodetails, '', False);
            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 nodetails.IndexOf(SearchRec.Name) = -1 then
            begin
              MainForm.IdFTP.MakeDir(SearchRec.Name);
            end;
            MainForm.IdFTP.ChangeDir(SearchRec.Name);
            details.Free;
            nodetails.Free;
            GetDir(dir + SearchRec.Name + '\');
            MainForm.IdFTP.ChangeDirUp;
          end 
          else 
          begin
            MainForm.IdFTP.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
  {dir := StringReplace(path, '\', '/', [rfReplaceAll]);
  if dir <> '' then
  begin
    if dir[1] = '/' then Delete(dir, 1, 1);
    if dir[Length(dir)] <> '/' then dir := dir + '/';
    while Pos('/', dir) > 0 do
    begin
      details   := TStringList.Create;
      nodetails := TStringList.Create;
      MainForm.IdFTP.List(details, '', True);
      MainForm.IdFTP.List(nodetails, '', False);
      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 nodetails.IndexOf(Copy(dir, 1, Pos('/', dir) - 1)) = -1 then
      begin
        MainForm.IdFTP.MakeDir(Copy(dir, 1, Pos('/', dir) - 1));
      end;
      MainForm.IdFTP.ChangeDir(Copy(dir, 1, Pos('/', dir) - 1));
      Delete(dir, 1, Pos('/', dir));
      details.Free;
      nodetails.Free;
    end;
  end;
  dir := directory;
  if dir[Length(dir)] <> '\' then dir := dir + '\';}

  dir := directory;

  GetDir(dir);
end;

dann erstellt er wenigstens nicht C:\bla\bla\usw.

und ich möchte gerne einen unterordner angeben können in den das hochgeladen werden soll

Heiko · Beiträge: 3169 Erhaltene Danke: 11

@Überschreiben: Den Befehl Put gibt es in mehreren Varianten (wie du vlt. mitbekommen hast). Bei mind. einer gibt es noch den Paramater AApend, der dafür steht, ob bei vorhanden sein der Datei das hochladen nicht erfolgen soll. Den also einfahc auf false setzten:

markieren

Delphi-Quelltext

1:	MainForm.IdFTP.Put(dir + SearchRec.Name, SearchRec.Name, false);

Ein kleiner zusätzlicher Hin weis noch, wie du performance sparen kannst. Liste mit SearchRec zu erst alle Files auf einen Ordner auf und dann die vom FTP-Server. Danach lädst du die erst hoch, wodurch mehrmaliges Auflisten der FTP-Dateien entfällt (was immer lange braucht

).

mfg
Heiko

F34r0fTh3D4rk · Verfasst: Sa 07.01.06 16:32

das versteh ich nicht ganz, könntest du das vielleicht nochmal anhand eines beispieles erläutern ?

Heiko · Beiträge: 3169 Erhaltene Danke: 11

Am Bsp. eines Quelltextes oder so? Und welchen Bereich, dass mit Put oder mit dem Performanceverbesserungsvorschlag?

F34r0fTh3D4rk · Verfasst: Sa 07.01.06 20:57

das 2.

F34r0fTh3D4rk · Verfasst: Di 10.01.06 20:53

ich hab jetzt diesen code

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:

procedure UploadPerFTP(var Directory: string);
  procedure GetDir(dir: string);
  var
    SearchRec: TSearchRec;
    details, nodetails: TStringList;
    k: Integer;
  begin
    if FindFirst(dir + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          if (SearchRec.Attr and faDirectory) = faDirectory then
          begin
            details   := TStringList.Create;
            nodetails := TStringList.Create;
            MainForm.IdFTP.List(details, '', True);
            MainForm.IdFTP.List(nodetails, '', False);
            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 nodetails.IndexOf(SearchRec.Name) = -1 then
            begin
              MainForm.IdFTP.MakeDir(SearchRec.Name);
            end;
            MainForm.IdFTP.ChangeDir(SearchRec.Name);
            details.Free;
            nodetails.Free;
            GetDir(dir + SearchRec.Name + '\');
            MainForm.IdFTP.ChangeDirUp;
          end 
          else 
          begin
            MainForm.L_File.Caption := 'Datei: ' + SearchRec.Name;
            MainForm.IdFTP.Put(dir + SearchRec.Name, SearchRec.Name, false);
            Application.ProcessMessages; 
          end;
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
  end;
begin
  GetDir(directory);
end;

und möchte das ganze in einen unterordner hochladen, also ich möchte zum beispiel bla/blubb/ angeben können, und da soll das dann landen, außerdem müsste ich möglichst effizient prüfen ob eine datei schon existiert, weil das programm sonst abschmiert, danke

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme