unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, clTcpServer, clFtpServer, clUserMgr, SyncObjs,
  clFtpFileHandler, clUtils;

type
  TMainForm = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    memLog: TMemo;
    edtPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    clFtpServer1: TclFtpServer;
    Label3: TLabel;
    edtRootDir: TEdit;
    clFtpFileHandler1: TclFtpFileHandler;
    Label4: TLabel;
    Label5: TLabel;
    procedure clFtpServer1Start(Sender: TObject);
    procedure clFtpServer1Stop(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure clFtpServer1SendResponse(Sender: TObject;
      AConnection: TclCommandConnection; const ACommand, AText: String);
    procedure clFtpServer1ReceiveCommand(Sender: TObject;
      AConnection: TclCommandConnection; const ACommand, AText: String);
    procedure clFtpServer1Authenticate(Sender: TObject;
      AConnection: TclFtpCommandConnection; Account: TclFtpUserAccountItem;
      const APassword: String; var IsAuthorized, Handled: Boolean);
    procedure clFtpServer1CloseConnection(Sender: TObject;
      AConnection: TclCommandConnection);
    procedure clFtpServer1AcceptConnection(Sender: TObject;
      AConnection: TclCommandConnection);
  private
    FSynchronizer: TCriticalSection;
    procedure PutLogMessage(const ALogMessage: string);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.clFtpServer1Start(Sender: TObject);
begin
  PutLogMessage('=================='#13#10'Start Server');
end;

procedure TMainForm.clFtpServer1Stop(Sender: TObject);
begin
  PutLogMessage('Stop Server');
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FSynchronizer := TCriticalSection.Create();
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FSynchronizer.Free();
end;

procedure TMainForm.PutLogMessage(const ALogMessage: string);
begin
  if not (csDestroying in ComponentState) then
  begin
    FSynchronizer.Enter();
    try
      memLog.Lines.Add(ALogMessage);
    finally
      FSynchronizer.Leave();
    end;
  end;
end;

procedure TMainForm.btnStartClick(Sender: TObject);
begin
  clFtpServer1.Port := StrToInt(edtPort.Text);
  clFtpServer1.RootDir := edtRootDir.Text;
  ForceFileDirectories(AddTrailingBackSlash(clFtpServer1.RootDir));
  clFtpServer1.Start();
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  clFtpServer1.Stop();
end;

procedure TMainForm.clFtpServer1SendResponse(Sender: TObject;
  AConnection: TclCommandConnection; const ACommand, AText: String);
begin
  PutLogMessage('Reply: ' + AText);
end;

procedure TMainForm.clFtpServer1ReceiveCommand(Sender: TObject;
  AConnection: TclCommandConnection; const ACommand, AText: String);
begin
  PutLogMessage('Command: ' + ACommand + ' ' + AText);
end;

procedure TMainForm.clFtpServer1Authenticate(Sender: TObject;
  AConnection: TclFtpCommandConnection; Account: TclFtpUserAccountItem;
  const APassword: String; var IsAuthorized, Handled: Boolean);
begin
  PutLogMessage('Authenticate user: ' + Account.UserName);
end;

procedure TMainForm.clFtpServer1CloseConnection(Sender: TObject;
  AConnection: TclCommandConnection);
begin
  PutLogMessage('Close Connection. Host: ' + AConnection.PeerName);
end;

procedure TMainForm.clFtpServer1AcceptConnection(Sender: TObject;
  AConnection: TclCommandConnection);
begin
  PutLogMessage('Accept Connection. Host: ' + AConnection.PeerName);
end;

end.