indy FTP Server Beispiel funktioniert nicht...

[EDatabaseError]

Ich habe mir die indy FTP Server Demo herruntergeladen. Leider funktioniert sie nicht wirklich...

Hier habe ich einmal den Source:

Delphi-Quellcode:

unit uFTPServer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, IdCmdTCPServer, IdFTPList,
  IdExplicitTLSClientServerBase, IdFTPServer, StdCtrls, IdFTPListOutput;

type
  TForm1 = class(TForm)
    btnClose: TButton;
    moNotes: TMemo;
    procedure IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
      const AUsername, APassword: string; var AAuthenticated: Boolean);
    procedure IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
      const AFileName: string; var VStream: TStream);
    procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
      const AFilename: string; var VFileSize: Int64);
    procedure IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
      const AFileName: string; AAppend: Boolean; var VStream: TStream);
    procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
      const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
      ASwitches: string);
    procedure FormCreate(Sender: TObject);
    procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
      const APathName: string);
    procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure btnCloseClick(Sender: TObject);
  private
    function ReplaceChars(APath: String): String;
    function GetSizeOfFile(AFile : String) : Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  IdFTPServer1: TIdFTPServer;
  AppDir      : String;

implementation
{$R *.DFM}

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  IdFTPServer1.Active := false;
  close;
end;

function TForm1.ReplaceChars(APath:String):String;
var
 s:string;
begin
  s := StringReplace(APath, '/', '\', [rfReplaceAll]);
  s := StringReplace(s, '\\', '\', [rfReplaceAll]);
  Result := s;
end;

function TForm1.GetSizeOfFile(AFile : String) : Integer;
var
 FStream : TFileStream;
begin
Try
 FStream := TFileStream.Create(AFile, fmOpenRead);
 Try
  Result := FStream.Size;
 Finally
  FreeAndNil(FStream);
 End;
Except
 Result := 0;
End;
end;

procedure TForm1.IdFTPServer1ChangeDirectory(
  ASender: TIdFTPServerContext; var VDirectory: string);
begin
  ASender.CurrentDir := VDirectory;
end;

procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
  const APathName: string);
begin
  DeleteFile(ReplaceChars(AppDir+ASender.CurrentDir+'\'+APathname));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 idftpserver1 := tidftpserver.create(self);
 with idftpserver1 do
  begin
    Active := True;
//    Bindings := [];
    DefaultPort := 21;
//    CommandHandlers := [];
    ExceptionReply.Code := '500';
    ExceptionReply.Text.Add('Unknown Internal Error');
    Greeting.Code := '220';
    Greeting.Text.Add('Indy FTP Server ready.');
    HelpReply.Text.Add('Help follows');
    MaxConnectionReply.Code := '300';
    MaxConnectionReply.Text.Add('Too many connections. Try again later.');
//  ReplyTexts = <>
    ReplyUnknownCommand.Code := '500';
    ReplyUnknownCommand.Text.Add('Syntax error, command unrecognized.');
    AllowAnonymousLogin := True;
    AnonymousAccounts.Add('anonymous');
    AnonymousAccounts.Add('ftp');
    AnonymousAccounts.Add('guest');
    AnonymousPassStrictCheck := False;
    SystemType := 'WIN32';
    OnChangeDirectory := IdFTPServer1ChangeDirectory;
    OnGetFileSize := IdFTPServer1GetFileSize;
    OnUserLogin := IdFTPServer1UserLogin;
    OnListDirectory := IdFTPServer1ListDirectory;
    OnDeleteFile := IdFTPServer1DeleteFile;
    OnRetrieveFile := IdFTPServer1RetrieveFile;
    OnStoreFile := IdFTPServer1StoreFile;
    OnMakeDirectory := IdFTPServer1MakeDirectory;
    OnRemoveDirectory := IdFTPServer1RemoveDirectory;
//    SITECommands = <>
    MLSDFacts := [];
    ReplyUnknownSITCommand.Code := '500';
    ReplyUnknownSITCommand.Text.Add('Invalid SITE command.');

   {Active := true;
   Bindings :=;
   OnUserLogin       := IdFTPServer1UserLogin;
   OnRemoveDirectory := IdFTPServer1RemoveDirectory;
   OnMakeDirectory   := IdFTPServer1MakeDirectory;
   OnRetrieveFile    := IdFTPServer1RetrieveFile;
   OnGetFileSize     := IdFTPServer1GetFileSize;
   OnStoreFile       := IdFTPServer1StoreFile;
   OnListDirectory   := IdFTPServer1ListDirectory;
   OnDeleteFile      := IdFTPServer1DeleteFile;
   OnChangeDirectory := IdFTPServer1ChangeDirectory;   }
  end;
 AppDir := ExtractFilePath(Application.Exename);
end;

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
  const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
  ASwitches: string);
var
 LFTPItem :TIdFTPListItem;
 SR : TSearchRec;
 SRI : Integer;
begin
  ADirectoryListing.DirFormat := doUnix;
  SRI := FindFirst(AppDir + 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(AppDir + APath + '\..');
end;

procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
  const AFileName: string; AAppend: Boolean; var VStream: TStream);
begin
 if not Aappend then
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmCreate)
 else
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenWrite)
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileSize: Int64);
Var
 LFile : String;
begin
 LFile := ReplaceChars( AppDir + AFilename );
 try
 If FileExists(LFile) then
   VFileSize :=  GetSizeOfFile(LFile)
 else
   VFileSize := 0;
 except
   VFileSize := 0;
 end;
end;

procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
  const AFileName: string; var VStream: TStream);
begin
  VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenRead);
end;

procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
begin
  if not ForceDirectories(ReplaceChars(AppDir + VDirectory)) then
  begin
    Raise Exception.Create('Unable to create directory');
  end;
end;

procedure TForm1.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
Var
 LFile : String;
begin
  LFile := ReplaceChars(AppDir + VDirectory);
  // You should delete the directory here.
  // TODO
end;

procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
  const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
 // We just set AAuthenticated to true so any username / password is accepted
 // You should check them here - AUsername and APassword
 showmessage('asd');
 AAuthenticated := True;
end;

end.

Bitte schaut mal drüber...

Tobi


//Edit : Es kommt ein Timeout beim herstellen der Verbindung.

[SirThornberry]

eine timeout deutet darauf hinn das der server nicht aktiv ist. Hast du ihn irgendwo auf aktiv gesetzt?

[EDatabaseError]

Zitat von SirThornberry:

eine timeout deutet darauf hinn das der server nicht aktiv ist. Hast du ihn irgendwo auf aktiv gesetzt?

jup...

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject); 
begin 
idftpserver1 := tidftpserver.create(self); 
with idftpserver1 do 
  begin 
    Active := True; ////////////////////////////////////////////////hier
//    Bindings := []; 
    DefaultPort := 21; 
//    CommandHandlers := []; 
    ExceptionReply.Code := '500';

Tobi

[SirThornberry]

ich hatte auch mal nen ftp-server mit source gepostet, hast du den mal probiert?

[EDatabaseError]

ja...aber der läuft nur mit indy 9 ...ich hab indy 10... da geht er nich...

aber was mich wundert ich hab das offizielle indy 10 beispiel...und das läuft nicht...

tobi

[inherited]

teste ihn doch mal mit einem anderen FTP-Client.

[EDatabaseError]

Ih könnt ihn ja mal testen

Tobi

[EDatabaseError]

Wenn ich es über localhost versuche bekomme ich gleich die Meldung das die Verbindung nicht erfolgreich seie...



//edit
hier mal die sourcen...bitte testen...ich schaffe es nicht

[inherited]

Funktioniert bei mir Wunderbar: Server gestartet, Firefox auf und ftp://localhost:21 rein. Fertig.

[EDatabaseError]

Zitat von inherited:

Funktioniert bei mir Wunderbar: Server gestartet, Firefox auf und ftp://localhost:21 rein. Fertig.

hmmm...kannst du mal deine EXE posten. Bei mir tuts nämlich nich.