[delphi] FTP mappen doorlopen

Pagina: 1
Acties:
  • 855 views sinds 30-01-2008
  • Reageer

  • Erpenator2
  • Registratie: Augustus 2003
  • Laatst online: 06-01 11:27
Hallo,

Ik ben op dit moment bezig een Delphi FTP programma te maken wat moet gaan dienen als backup applicatie. Ik wil graag dat wanneer mijn programma gestart is vanuit de root map van een FTP server zelf alle mappen doorloopt en deze download inclusief alle bestanden die zich daar in kunnen bevinden.

Op dit moment lukt het me om met deze code handmatig door directorys te lopen en wanneer het een bestand is zal het zonder melding het bestand downloaden. Wanneer ik dit met wat for loopjes wil doen gaat het steeds mis.

Weet iemand een manier om door alle directories te lopen op een ftp server en dan alle bestanden en directories te downloaden?


code:
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP, idFTPCommon, idFTPList;

type
  TForm1 = class(TForm)
    FTP: TIdFTP;
    Button1: TButton;
    DirectoryListBox: TListBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure DirectoryListBoxClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ChangeDir(DirName: String);
    procedure isDirectory(Dirname: String);
    procedure isFile(FileName: String);
    procedure AutoDownload();
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//Knop om in te loggen
procedure TForm1.Button1Click(Sender: TObject);
begin
  FTP.Username := 'anonymous';
  FTP.Password := 'have@none.com';
  FTP.Host := 'ftp.xs4all.nl';
  ftp.Connect();
  ChangeDir('/');
end;

//Procedure om een directory dieper te gaan
procedure TForm1.ChangeDir(DirName: String);
var LS: TStringList;
    iIndex, I: Integer;
    StrFilename: String;
begin
  LS := TStringList.Create;
  DirectoryListBox.Items.Clear;
  FTP.ChangeDir(DirName);
  FTP.TransferType := ftASCII;
  FTP.List(LS);
  For iIndex := 0 to LS.Count - 1 do
  begin
    StrFilename := LS[ iIndex ];
      For I := Length( StrFilename ) downto 1 do
        If StrFilename[ I ] = ' ' then
            Break;
       Delete( StrFilename, 1, I );
       DirectoryListBox.Items.Add(StrFilename)
    End;
  if DirectoryListBox.Items.Count > 0 then
    if AnsiPos('total', DirectoryListBox.Items[0]) > 0 then DirectoryListBox.Items.Delete(0);
  LS.Free;
  AutoDownload();
end;

//Procedure die alle bestanden automatisch moet downloaden
procedure TForm1.AutoDownload();
var Name : String;
  I : integer;
  DirList: TIdFTPListItems;
begin
  if not FTP.Connected then exit;
  DirList := FTP.DirectoryListing;

  for I := 0 to DirList.Count - 1 Do
  begin
   Name := FTP.DirectoryListing.Items[i].FileName;
   if FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory
    then
      ChangeDir(Name)
    else begin
    IsFile(Name);
  end
  end
end;


//Wanneer je in de listbox klikt kijken of het een bestand of direcory is en downloaden of een map dieper gaan
procedure TForm1.DirectoryListBoxClick(Sender: TObject);
var Name : String;
begin
  if not FTP.Connected then exit;
  Name := FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory
    then
      ChangeDir(Name)
  else begin
    IsFile(Name);
  end
end;

//Kijken of het een directory is
procedure TForm1.IsDirectory(DirName : String);
var Name : String;
begin
  if not FTP.Connected then exit;
  Name := FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then
      ChangeDir(Name)
   else begin
       IsFile(Name)
  end
end;

//kijken of het een bestand is
procedure TForm1.IsFile(FileName : String);
var Name : String;
begin
  FTP.TransferType := ftBinary;
  //BytesToTransfer := FTP.Size(FileName);

  if FileExists(FileName) then
  begin
    case MessageDlg('Bestand bestaat al, toch downloaden?', mtConfirmation, mbYesNoCancel,0)
    of
    mrYes:
    begin
      //BytesToTrasnfer := BytesToTransfer - FileSizeByName(FileName);
      FTP.Get(FileName, FileName, false, true);
    end;
    mrNo:
    begin
      FTP.Get(FileName,FileName,true);
    end;
    mrCancel:
    begin
      exit;
    end;
  end;
  end
  else begin
    FTP.Get(FileName,FileName,true,true);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

end;

end.

Verwijderd

Simpel stukje recursief programmeren.

in pseudo-code :
code:
1
2
3
4
5
6
7
8
function VerwerkDirectory ( currentdir )
  for each D in ( Directories in currentdir )
    VerwerkDirectory (D)
  next
  for in F in ( Files in currentdir )
    indien nodig dan download
  next
end

Verwijderd

Wat je nu handmatig doet kan je toch ook omzetten naar iets dat m.b.v. code de directory ophoogd?

Daarnaast zie ik dat je niet threaded werkt. Lijkt mij niet de meest ideale manier om te gaan downloaden met indy.

Kan jij trouwens met indy van een user ftp (van xs4all) site de directory structuur ophalen? Dat is mij met indy nooit gelukt :'( . (Dus niet van de normale ftp site.)

*Fate zal nog eens even naar zijn eigen stoffige projectje kijken of er iets bruikbaars tussen ligt.

  • Reptile209
  • Registratie: Juni 2001
  • Laatst online: 23:31

Reptile209

- gers -

En als je in regel 83 de index nou eens aanpast van DirectoryListBox.ItemIndex naar I (van de lus die je daar doorloopt...). Volgens mij is dat het enige echte verschil tussen de klik-versie en de autodownload.

Nog een tip trouwens: noem de procedures IsFile en IsDirectory anders. Ik zat daar te wachten op een functie die een boolean teruggeeft en niet een procedure die 'm afhandelt. Het is natuurlijk een kwestie van stijl en smaak, maar ik zou ze respectivelijk ProcessFile en ProcessDirectory noemen. Wat bovendien maf is, is dat IsDirectory nog een keer extra controleert of het om een dir gaat, en dat IsFile dat niet doet :).
Maak je code op deze manier wat overzichtelijker, dat programmeert makkelijker... ;)

Zo scherp als een voetbal!


  • Delphi32
  • Registratie: Juli 2001
  • Laatst online: 22:08

Delphi32

Heading for the gates of Eden

^^^ Eens is.
Bovendien wordt IsDirectory nergens gebruikt in dit stukje code :)

  • Erpenator2
  • Registratie: Augustus 2003
  • Laatst online: 06-01 11:27
offtopic:
[quote]Verwijderd schreef op 22 maart 2004 @ 14:23:
Wat je nu handmatig doet kan je toch ook omzetten naar iets dat m.b.v. code de directory ophoogd?

Daarnaast zie ik dat je niet threaded werkt. Lijkt mij niet de meest ideale manier om te gaan downloaden met indy.

Kan jij trouwens met indy van een user ftp (van xs4all) site de directory structuur ophalen? Dat is mij met indy nooit gelukt :'( . (Dus niet van de normale ftp site.)

*Fate zal nog eens even naar zijn eigen stoffige projectje kijken of er iets bruikbaars tussen ligt.[/quote]


Ik heb net even geprobeerd om op mijn users account in te loggen met de bovenstaande code en dat werkt gewoon. Krijg netjes alles te zien.

  • Reptile209
  • Registratie: Juni 2001
  • Laatst online: 23:31

Reptile209

- gers -

Erpenator2 schreef op 22 maart 2004 @ 14:48:
offtopic:
Ik heb net even geprobeerd om op mijn users account in te loggen met de bovenstaande code en dat werkt gewoon. Krijg netjes alles te zien.
Ik denk dat * Reptile209 * bedoelt dat het hem niet lukte om recursief de directories te doorlopen. Met jouw code en mijn tip van daarnet moet dat inderdaad werken als een trein. :)

Hint:
Reptile209 schreef op 22 maart 2004 @ 14:39:
En als je in regel 83 de index nou eens aanpast van DirectoryListBox.ItemIndex naar I (van de lus die je daar doorloopt...). Volgens mij is dat het enige echte verschil tussen de klik-versie en de autodownload.
:X

Zo scherp als een voetbal!


  • Erpenator2
  • Registratie: Augustus 2003
  • Laatst online: 06-01 11:27
Ik heb de eerste tip uitgeprobeerd en volgens mij ben ik er bijna. Ik zal straks als het allemaal werkt de namen van de procedures veranderen en de oplossing plaatsen met alle tips.

Ik zit op dit moment nog vast met hoe dat ik VerwerkDirectory() aan moet roepen
En waar ?

Oh en reptile, helaas lukte het niet met jou tip. Ik kreeg een index out of bounds error naar verloop van tijd.


Klopt de rest wel zo ?


code:
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP, idFTPCommon, idFTPList;

type
  TForm1 = class(TForm)
    FTP: TIdFTP;
    Button1: TButton;
    DirectoryListBox: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure DirectoryListBoxClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ChangeDir(DirName: String);
    procedure isDirectory(Dirname: String);
    procedure isFile(FileName: String);
    procedure VerwerkDirectory(CurrentDir : TidFTPListItem);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//Knop om in te loggen
procedure TForm1.Button1Click(Sender: TObject);
begin
  FTP.Username := 'anonymous';
  FTP.Password := 'have@none.com';
  FTP.Host := 'ftp.xs4all.nl';
  ftp.Connect();
  ChangeDir('/');
end;

//Procedure om een directory dieper te gaan
procedure TForm1.ChangeDir(DirName: String);
var LS: TStringList;
    iIndex, I: Integer;
    StrFilename: String;
begin
  LS := TStringList.Create;
  DirectoryListBox.Items.Clear;
  FTP.ChangeDir(DirName);
  FTP.TransferType := ftASCII;
  FTP.List(LS);
  For iIndex := 0 to LS.Count - 1 do
  begin
    StrFilename := LS[ iIndex ];
      For I := Length( StrFilename ) downto 1 do
        If StrFilename[ I ] = ' ' then
            Break;
       Delete( StrFilename, 1, I );
       DirectoryListBox.Items.Add(StrFilename)
    End;
  if DirectoryListBox.Items.Count > 0 then
    if AnsiPos('total', DirectoryListBox.Items[0]) > 0 then DirectoryListBox.Items.Delete(0);
  LS.Free;
  //VerwerkDirectory(DirName);
end;

procedure TForm1.VerwerkDirectory(currentdir: TidFTPListItem );
var I : integer;
DirList: TIdFTPListItems;
begin
   for I := 0 to DirList.Count - 1 Do
    begin
      if FTP.DirectoryListing.Items[i].ItemType = ditDirectory then
      verwerkDirectory( FTP.DirectoryListing.Items[i])
      else begin
        //Downloadfile
      end
  end;
end;

//Wanneer je in de listbox klikt kijken of het een bestand of direcory is en downloaden of een map dieper gaan
procedure TForm1.DirectoryListBoxClick(Sender: TObject);
var Name : String;
begin
  if not FTP.Connected then exit;
  Name := FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory
    then
      ChangeDir(Name)
  else begin
    IsFile(Name);
  end
end;

//Kijken of het een directory is
procedure TForm1.IsDirectory(DirName : String);
var Name : String;
begin
  if not FTP.Connected then exit;
  Name := FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].FileName;
  if FTP.DirectoryListing.Items[DirectoryListBox.ItemIndex].ItemType = ditDirectory then
      ChangeDir(Name)
   else begin
       IsFile(Name)
  end
end;

//kijken of het een bestand is
procedure TForm1.IsFile(FileName : String);
var Name : String;
begin
  FTP.TransferType := ftBinary;
  //BytesToTransfer := FTP.Size(FileName);

  if FileExists(FileName) then
  begin
    case MessageDlg('Bestand bestaat al, toch downloaden?', mtConfirmation, mbYesNoCancel,0)
    of
    mrYes:
    begin
      //BytesToTrasnfer := BytesToTransfer - FileSizeByName(FileName);
      FTP.Get(FileName, FileName, false, true);
    end;
    mrNo:
    begin
      FTP.Get(FileName,FileName,true);
    end;
    mrCancel:
    begin
      exit;
    end;
  end;
  end
  else begin
    FTP.Get(FileName,FileName,true,true);
    end;
end;

end.

[ Voor 5% gewijzigd door Erpenator2 op 22-03-2004 15:22 ]


Verwijderd

Het recursief directories ophalen lukt me wel. Maar bij xs4all wordt het iets te recursief :'( .

Voorbeeld:
http://www.xs4all.nl/~verdouw2/Project1.zip

Ik haal trouwens op deze manier de data op.
Dit is voor gebruik in een treeview (zie voorbeeld) dus vandaar die nodes.

code:
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
98
99
100
101
102
procedure GetStringFTP.AddDirectoryList;
var
  i, i1, i2, i3 : integer;
  sl, sl1 : tstringlist;
  s1 : string;
begin
  sl := TstringList.Create;
  sl1 := TstringList.Create;
  form2.IdFTP1.ChangeDir('/' + FirstStringDirectory1);
  form2.IdFTP1.List(sl);
  i := 0;
  i1 := form2.IdFTP1.DirectoryListing.Count - 1;
  Synchronize(SetImages6);
  while i <= i1 do begin
    if form2.IdFTP1.DirectoryListing[i].ItemType = ditDirectory then begin
      if (form3.Label8.Caption = '1') then begin
        File4 := form2.IdFTP1.DirectoryListing[i].FileName;
        Synchronize(SetImages4);
      end else begin
        s1 := form2.IdFTP1.DirectoryListing[i].FileName;
        sl1.Add(s1);
      end;
    end else begin
      File2 := form2.IdFTP1.DirectoryListing[i].FileName;
      Synchronize(SetImages2);
    end;
    if (i1 = i) and (form3.Label8.Caption = '2') then begin
      i2 := 0;
      i3 := sl1.Count - 1;
      sl1.Sort;
      while i2 <= i3 do begin
        GlobalNode2 := GlobalNode1;
        FirstStringDirectory2 := sl1.Strings[i2];
        AddDirectoryList2;
        i2 := i2 + 1;
      end;
      break;
    end;
    i := i + 1;
  end;
  sl.Free;
  sl1.Free;
end;

procedure GetStringFTP.execute;
var
  i, i1, i2, i3 : integer;
  sl, sl1 : TStringList;
  s1 : string;
begin
  try
    form1.CannotProceed := 2;
    Synchronize(ShowFormForDownload);
    sl := TStringList.Create;
    sl1 := TStringList.Create;
    form2.IdFTP1.ChangeDir('/');
    form2.IdFTP1.List(sl);
    i := 0;
    i1 := form2.IdFTP1.DirectoryListing.Count - 1 ;
    while i <= i1 do begin
      if form2.IdFTP1.DirectoryListing[i].ItemType = ditDirectory then begin
        s1 := form2.IdFTP1.DirectoryListing[i].FileName;
        sl1.Add(s1);
      end else begin
        File1 := form2.IdFTP1.DirectoryListing[i].FileName;
        Synchronize(SetImages1);
      end;
      if (i = i1) then begin
        i2 := 0;
        i3 := sl1.Count - 1;
        sl1.Sort;
        while i2 <= i3 do begin
          GlobalNode1 := nil;
          FirstStringDirectory1 := sl1.Strings[i2];
          AddDirectoryList;
          i2 := i2 + 1;
        end;
        sl.Free;
        sl1.Free;
        form2.IdFTP1.TransferType := ftbinary;
        form1.StatusBar1.Panels.Items[2].Text := 'Mode: Binary';
        form1.TreeView2.CustomSort(@MyCustomSortProc2,0,true);
        Synchronize(ShowFormForDownload);
        Synchronize(SetSelectedTV2);
        form1.CannotProceed := 1;
        exit;
      end;
      i := i + 1;
    end;
    sl.Free;
    sl1.Free;
    form2.IdFTP1.TransferType := ftbinary;
    form1.StatusBar1.Panels.Items[2].Text := 'Mode: Binary';
    form1.TreeView2.CustomSort(@MyCustomSortProc2,0,true);
    Synchronize(ShowFormForDownload);
    Synchronize(SetSelectedTV2);
    form1.CannotProceed := 1;
  except
    form1.CannotProceed := 1;
    synchronize(ExceptStatements);
  end;
end;


[edit]
FirstStringDirectory2 is net zoals 1 ongeveer maar iets minder geavanceerd.

Wauw.. voor de code freaks genoeg leesvoer in dit topic :)

[ Voor 6% gewijzigd door Verwijderd op 22-03-2004 15:29 ]


  • Erpenator2
  • Registratie: Augustus 2003
  • Laatst online: 06-01 11:27
Ik ben nu tot deze code gekomen en het gaat na 2 of 3 keer toch nog mis. Iemand een idee waarom ?

code:
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
procedure TForm1.VerwerkDirectory(currentdir: TidFTPListItem );
var I : integer;
OldDir : String;
DirList: TIdFTPListItems;
begin
   FTP.ChangeDir(currentdir.Filename);
   DirList := FTP.DirectoryListing;
   //showMessage('Voor iflus');
   if not (DirList = nil) then
   begin
    for I := 0 to DirList.Count - 1 Do
     begin
       if FTP.DirectoryListing.Items[i].ItemType = ditDirectory then
       Begin
       OldDir := currentdir.FileName;
       verwerkDirectory( FTP.DirectoryListing.Items[i]);
       FTP.ChangeDir(OldDir);
       end
       else begin
         //Downloadfile
         showMessage('Download');
       end
   end;
   end;
end;

  • LordLarry
  • Registratie: Juli 2001
  • Niet online

LordLarry

Aut disce aut discede

Probeer eens te debuggen en trek een conclusie. Wat gaat er mis?

We adore chaos because we like to restore order - M.C. Escher


  • Erpenator2
  • Registratie: Augustus 2003
  • Laatst online: 06-01 11:27
Ik ben opnieuw begonnen en ik heb een werkde versie voor windows NT ftp's maar helaas knalt hij er bij unix ftp servers nog uit.

Omdat er meer mensen mee bezig zijn ( gezien deze post) plaats ik de code in de hoop dat iemand hem kan aanpassen zodat het ook voor unix ftp servers werkt, mocht ik het zelf voor elkaar krijgen pas ik het nog wel aan.


code:
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
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP,idFTPCommon,idFTPList ;

type
  TForm1 = class(TForm)
    FTP: TIdFTP;
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ListDir(Remote : String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}




procedure TForm1.Button1Click(Sender: TObject);
begin
  FTP.Username := 'anonymous';
  FTP.Password := 'anonymous@anonymous';
  FTP.Host := 'ftp.xs4all.nl';
  ftp.Connect();
  ListDir('/');
end;

procedure TForm1.ListDir(Remote: String);
var
  LS: TStringList;
  i: integer;
  ListItems: TIdFTPListItems;
begin

  LS:=TStringList.Create;
  FTP.ChangeDir(Remote);
  FTP.List(LS);
  ListItems:=TIdFTPListItems.Create;
  ListItems.Assign(FTP.DirectoryListing);
  if ListItems.Count>0 then
    for i:=0 to FTP.DirectoryListing.Count-1 do
     if not (ListItems[i].FileName = '.') and not (ListItems[i].FileName ='..') then begin
      if ListItems[i].ItemType=ditDirectory then begin
        Memo1.Lines.Add(ListItems[i].FileName);
        ListDir(ListItems[i].FileName);
        FTP.ChangeDirUp;
      end
      else
        Memo1.Lines.Add(ListItems[i].FileName);
     end;
  ListItems.Free;
  LS.Free;
end;

end.
Pagina: 1