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

Hier habe ich einmal den Source:

zusammenfalten · markieren

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.

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

Zitat von SirThornberry:

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

jup...

markieren

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

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

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

teste ihn doch mal mit einem anderen FTP-Client.

Ih könnt ihn ja mal testen

Tobi

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

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

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.