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.