FTP Server fast* fertig

[mb1996]

Hi Leute,
ich wollte einen FTP Server programmieren und habe angefangen einenn nach dieser Website zu programmieren. Aber wenn ich über Filezilla Daten hochladen möchte dann meint er die Datei gibt es schon. Wenn ich die ,,Datei", die es nicht gibt, überschreibe ist die Datei hochgeladen und funktioniert. Außerdem kann ich nicht in Ordnern navigieren. Ich weiß nicht woran das liegt :(

Tut mir leid, dass ich jetzt den ganzen Quellcode poste :shock:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdContext, IdIntercept, IdServerInterceptLogBase,
  IdServerInterceptLogFile, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdTCPServer, IdCmdTCPServer, IdExplicitTLSClientServerBase, IdFTPServer,
  IdFTPList, IdFTPListOutput, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    Server: TIdFTPServer;
    logfile1: TIdServerInterceptLogFile;
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ServerDeleteFile(ASender: TIdFTPServerContext;
      const APathName: string);
    procedure ServerFileExistCheck(ASender: TIdFTPServerContext;
      const APathName: string; var VExist: Boolean);
    procedure ServerGetFileDate(ASender: TIdFTPServerContext;
      const AFilename: string; var VFileDate: TDateTime);
    procedure ServerGetFileSize(ASender: TIdFTPServerContext;
      const AFilename: string; var VFileSize: Int64);
    procedure ServerListDirectory(ASender: TIdFTPServerContext;
      const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
      ASwitches: string);
    procedure ServerMakeDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure ServerRetrieveFile(ASender: TIdFTPServerContext;
      const AFileName: string; var VStream: TStream);
    procedure ServerRenameFile(ASender: TIdFTPServerContext;
      const ARenameFromFile, ARenameToFile: string);
    procedure ServerRemoveDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername,
      APassword: string; var AAuthenticated: Boolean);
    procedure ServerStoreFile(ASender: TIdFTPServerContext;
      const AFileName: string; AAppend: Boolean; var VStream: TStream);
    procedure ServerStat(ASender: TIdFTPServerContext; AStatusInfo: TStrings);
    procedure FormCreate(Sender: TObject);
    procedure ServerExecute(AContext: TIdContext);
    procedure ServerStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  user: Integer;
  homedir: String;
implementation

{$R *.dfm}

function setSlashes(APath: String):String;
var
slash: String;
begin
slash:= StringReplace(APath, '/', '', [rfReplaceAll]);
slash:= StringReplace(slash, '', '', [rfReplaceAll]);
Result:=slash;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Server.DefaultPort:=strtoint(edit3.Text);
Server.Active:=True;
Memo1.Lines.Add(datetostr(Date)+ ' | ' + timetostr(time)+ ' : Server gestartet.');

Button1.Enabled:=False;
Button2.Enabled:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Server.Active:=False;

Button1.Enabled:=True;
Button2.Enabled:=False;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Button2.Click;
Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//Ordner:
homedir:='f:';
end;

procedure TForm1.ServerDeleteFile(ASender: TIdFTPServerContext;
  const APathName: string);
begin
if FileExists(APathName) then
begin
  DeleteFile(APathName);
end;
end;

procedure TForm1.ServerExecute(AContext: TIdContext);
begin
logfile1.DoLogWriteString(AContext.Connection.IOHandler.AllData);
end;

procedure TForm1.ServerFileExistCheck(ASender: TIdFTPServerContext;
  const APathName: string; var VExist: Boolean);
begin
if FileExists(APathName) then
begin
  VExist:=True;
end
else
begin
  VExist:=False;
end;
end;

procedure TForm1.ServerGetFileDate(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileDate: TDateTime);
var
fdate: TDateTime;
begin
fdate:=FileAge(AFilename); //Dateialter in eine Variabel schreiben
if not (fdate=-1) then
begin
  VFileDate:=fdate;
end;
end;

procedure TForm1.ServerGetFileSize(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileSize: Int64);
var lfile:String;
rec: TSearchRec;
ASize: Int64;
begin
LFile:=setSlashes(homedir + AFilename);
try
if FindFirst(lfile, faAnyFile, rec) = 0 then repeat
             ASize:=rec.Size;
                                             until FindNext(rec) <> 0;
finally
  FindClose(rec);
end;

if ASize >1 then
VFileSize:=Asize
else
VFileSize:=0;
end;

procedure TForm1.ServerListDirectory(ASender: TIdFTPServerContext;
  const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
  ASwitches: string);
var LFTPItem :TIdFTPListItem;
SR: TSearchRec;
SRI: Integer;
begin
ADirectoryListing.DirFormat:=doUnix;
SRI:=FindFirst(homedir + APath+'*.*',
faAnyFile - faHidden - faSysFile, SR);
while SRI= 0 do
begin
  LFTPItem:=ADirectoryListing.Add;
  LFTPItem.FileName:=SR.Name;
  LFTPItem.Size:=SR.Size;
  LFTPItem.ModifiedDate:=FileDateToDateTime(SR.Time);
  if SR.Attr=faDirectory then
  LFTPItem.ItemType:=ditDirectory
  else
  LFTPItem.ItemType:=ditFile;
  SRI:=FindNext(SR);
end;

FindClose(SR);
SetCurrentDir(homedir + APath + '...');
end;

procedure TForm1.ServerMakeDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
var ldir: String;
begin
ldir:= setSlashes(homedir + VDirectory);
if not DirectoryExists(ldir) then
if not CreateDir(ldir) then
raise Exception.Create('Verzeichniss '+ldir +'kann nicht erstellt werden.');
end;

procedure TForm1.ServerRemoveDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
var LFile: String;
begin
LFile:=setSlashes(homedir + VDirectory);
if DirectoryExists(LFile) then
begin
  RemoveDir(LFile);
end
else
begin
  raise Exception.Create('Verzeichniss konnte nicht gelöscht werden.');
end;

end;

procedure TForm1.ServerRenameFile(ASender: TIdFTPServerContext;
  const ARenameFromFile, ARenameToFile: string);
begin
if not RenameFile(ARenameFromFile, ARenameToFile) then
begin
  raise Exception.Create('Datei konnte nicht umgenannt werden.');
end;
end;

procedure TForm1.ServerRetrieveFile(ASender: TIdFTPServerContext;
  const AFileName: string; var VStream: TStream);
begin
VStream:=TFileStream.Create(setSlashes(homedir + AFileName), fmOpenRead);
end;

procedure TForm1.ServerStat(ASender: TIdFTPServerContext;
  AStatusInfo: TStrings);
var i:Integer;
begin
for I := 0 to AStatusInfo.Count - 1 do
Memo1.Lines.Add(AStatusInfo.Strings[i]);
end;

procedure TForm1.ServerStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
Memo1.Lines.Add(AStatusText);
end;

procedure TForm1.ServerStoreFile(ASender: TIdFTPServerContext;
  const AFileName: string; AAppend: Boolean; var VStream: TStream);
begin
if not AAppend then
VStream:=TFileStream.Create(AFileName, fmCreate)
else
VStream:=TFileStream.Create(AFileName, fmOpenRead);
end;

procedure TForm1.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername,
  APassword: string; var AAuthenticated: Boolean);
begin
if (AUsername=Edit1.Text) and (APassword=Edit2.Text) then
begin
  AAuthenticated:=True;
end
else
begin
  AAuthenticated:=False;
end;
end;

end.

Danke, dass du mein Post ganz durchgelesen hast :thumb:

[sx2008]

Du gehst recht fahrlässig mit deinen Pfaden und Dateinamen um.
Zunächst einmal braucht jeder FTP-Server ein Basisverzeichnis (z.B. C:\Ftpdaten\).
Ich schätze mal, das ist in der Variablen homedir gespeichert.

Dann ist es ja so, dass bei FTP das /-Zeichen als Verzeichnistrenner verwendet wird,
während unter Windows ein Backslash gilt.
Du brauchst also eine Funktion, die Slashes in Backslashes wandelt.
Und deine Funktion setSlashes() scheint mir da nicht korrekt zu sein.

Das heisst dann also, dass du bei jedem Zugriff auf eine Datei zuerst den
Basispfad homedir hernehmen musst und dann den FTP-Pfad dranhängen und die Verzeichnistrenner anpassen musst.
Es gibt übrigens eine ganze Reihe von Funktionen für die Pfadbearbeitung.

[jaenicke]

Zitat:

Zitat von sx2008 (Beitrag 1107655)

Dann ist es ja so, dass bei FTP das /-Zeichen als Verzeichnistrenner verwendet wird, während unter Windows ein Backslash gilt.

Das stimmt so nicht ganz, es gilt nicht nur der Backslash. Der Backslash ist zwar unter Windows üblich und sollte per Konvention verwendet werden, aber es funktionieren Slash und Backslash gleichermaßen.

Wenn man also wie hier unixoide bzw. internetbasierte Verzeichnisnamen hat, muss man das nicht unbedingt umwandeln.

// EDIT:
Aber du hast natürlich Recht, dass setSlashes Blödsinn macht, denn es eliminiert ja jeglichen Backslash statt ihn in einen Slash zu verwandeln...

Dann noch ein Fehler:
In StoreFile fehlt die Prüfung, ob die Datei existiert... Man darf natürlich nicht davon ausgehen, dass Append immer korrekt angegeben wurde, das provoziert ja geradezu Fehler...

Was das Problem angeht:
Was sagt denn das FileZilla Log oben im Fenster was vom Server zurückkommt an der Stelle?