unit uFTPServer;

interface

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

type
  TForm1 = class(TForm)
    IdFTPServer1: TIdFTPServer;
    btnClose: TButton;
    moNotes: TMemo;
    cbEnabled: TCheckBox;
  //  IdCompressorZLibEx1: TIdCompressorZLibEx;
    procedure IdFTPServer1SiteUTIME(ASender: TIdFTPServerContext;
      const AFileName: string; var VLastAccessTime, VLastModTime,
      VCreateDate: TDateTime; var VAUth: Boolean);
    procedure IdFTPServer1RenameFile(ASender: TIdFTPServerContext;
      const ARenameFromFile, ARenameToFile: string);
    procedure IdFTPServer1MLST(ASender: TIdFTPServerContext;
      const APath: string; ADirectoryListing: TIdFTPListOutput);
    procedure IdFTPServer1CombineFiles(ASender: TIdFTPServerContext;
      const ATargetFileName: string; AParts: TStrings);
    procedure IdFTPServer1Stat(ASender: TIdFTPServerContext;
      AStatusInfo: TStrings);
    procedure IdFTPServer1SetATTRIB(ASender: TIdFTPServerContext;
      var VAttr: Cardinal; const AFileName: string; var VAUth: Boolean);
    procedure IdFTPServer1FileExistCheck(ASender: TIdFTPServerContext;
      const APathName: string; var VExist: Boolean);
    procedure IdFTPServer1SetCreationTime(ASender: TIdFTPServerContext;
      const AFileName: string; var AFileTime: TDateTime);
    procedure IdFTPServer1SetModifiedTime(ASender: TIdFTPServerContext;
      const AFileName: string; var AFileTime: TDateTime);
    procedure IdFTPServer1GetFileDate(ASender: TIdFTPServerContext;
      const AFilename: string; var VFileDate: TDateTime);
    procedure IdFTPServer1AfterUserLogin(ASender: TIdFTPServerContext);
    procedure IdFTPServer1CRCFile(ASender: TIdFTPServerContext;
      const AFileName: string; var VStream: TStream);
    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);
    procedure cbEnabledClick(Sender: TObject);
  private
    function RemoveTrailingPathDel(const AData : String) : String;
    function ReplaceChars(APath: String): String;
    function GetSizeOfFile(AFile : String) : Integer;
    function GetFileDate(AFile : String) : TDateTime;
    function TDateTimeToFileTime(const ADateTime : TDateTime) : TFileTime;
    function FileTimeToTDateTime(const AFileTime : TFileTime) : TDateTime;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  AppDir      : String;

implementation

//IdFTPCommon is needed for a few functions and types.
//IdFTPServerContextBase - needed for the UserType enumeration
//IdStack is needed for GStack Symbol - we will use that to do a reverse DNS
//query on the client in the STAT command
uses IdFTPCommon,IdFTPServerContextBase, IdStack, IdThreadSafe;
{$R *.DFM}

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

function TForm1.RemoveTrailingPathDel(const AData : String) : String;
begin
  Result := AData;

    repeat
      if Result='' then
      begin
        Break;
      end;
      if (Result[Length(Result)] = '/') or (Result[Length(Result)] = '\') then
      begin
        System.Delete(Result,Length(Result),1);
      end
      else
      begin
        Break;
      end;
    until False;

end;

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

procedure TForm1.cbEnabledClick(Sender: TObject);
begin

IdFTPServer1.Active:=cbEnabled.Checked;

if IdFTPServer1.Active then Caption:='Enabled' else
Caption:='Disabled';

end;

function TForm1.FileTimeToTDateTime(const AFileTime: TFileTime): TDateTime;
var   LDosTime : LongInt;
begin
  Result := 0;
  if Windows.FileTimeToDosDateTime(AFileTime, LongRec(LDosTime).Hi,
      LongRec(LDosTime).Lo) then
  begin
    Result := SysUtils.FileDateToDateTime(LDosTime);
  end
  else
  begin
     SysUtils.RaiseLastOSError;
  end;
end;

function TForm1.TDateTimeToFileTime(const ADateTime: TDateTime): TFileTime;
var   LDosTime : LongInt;
begin
  Result.dwLowDateTime := 0;
  Result.dwHighDateTime := 0;
  LDosTime := SysUtils.DateTimeToFileDate(ADateTime);
  DosDateTimeToFileTime(LongRec(LDosTime).Hi, LongRec(LDosTime).Lo, Result);
end;

function TForm1.GetFileDate(AFile: String): TDateTime;
//You can't use the Borland Standard RTL FileAge function because
//that returns the time as the local time.  MDTM requires that the time
//be returned in GMT.
var LHandle : THandle;
  LModDate : TFileTime;

begin
  LHandle :=   Windows.CreateFile(PChar(AFile),GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if LHandle = INVALID_HANDLE_VALUE then
  begin
    SysUtils.RaiseLastOSError;
  end;
  try
    //GetFileTime parameters that are nil.
    //Creation Time/ last access time
     Windows.GetFileTime(LHandle,nil,nil,@LModDate);
  finally
    Windows.CloseHandle(LHandle);
  end;
  Result := FileTimeToTDateTime(LModDate);
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);
var Msg : String;
begin
  //Note that you really should have a way a way of preventing
  //a CWD command from accessing something higher than your intended hiearchy.
  //
  //That's a BIG security flaw that some attackers will exploit.
  //
  //You also should have a way of preventing the "VDirectory" from reflecting
  //your real computer directory structure.
  if  SysUtils.DirectoryExists(ReplaceChars(AppDir+'\'+VDirectory)) then
  begin
  end
  else
  begin
    //You do NOT want to expose the directory name if an error happens.
    //Sometimes, that can tell a trouble maker quite a bit about your system.
    //On other hand, durring development, you probably want to know.
    Msg :=  VDirectory;
    VDirectory := ASender.CurrentDir;
    raise Exception.Create('Directory '+Msg+' not found');
  end;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
 AppDir := ExtractFilePath(Application.Exename);
end;

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
  const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
  ASwitches: string);
var
 LFTPItem :TIdFTPListOutputItem;
 SR : TSearchRec;
 SRI : Integer;
 LTmpPath : String;

begin
 //You should at least honor the laT switches because are listed in the FEAT
 //reply.
 //

  if Pos('s',ASwitches)>0 then
  begin
    ADirectoryListing.Switches := ADirectoryListing.Switches + 's';
  end;


    // we do it this way because if a dir such as /pub is passed as a parameter,
    //You probably want the contents of it.
    LTmpPath := ReplaceChars(AppDir +ASender.HomeDir + APath);

    if DirectoryExists(LTmpPath) then
    begin
      LTmpPath := LTmpPath + '\*.*';
    end
    else
    begin
      LTmpPath := LTmpPath + '*.*';
    end;

  SRI := FindFirst(LTmpPath, faAnyFile , SR);// - faHidden - faSysFile, SR);

  While SRI = 0 do
  begin
    LFTPItem := ADirectoryListing.Add;
    LFTPItem.FileName := SR.Name;

    //This is necessary because the Borland RTL FindData Size is an Integer and can't handle
    //anything greater than 2GB.
    LFTPItem.Size := Int64(SR.FindData.nFileSizeHigh shl 32) + SR.FindData.nFileSizeLow;
    //for Unix lists, you should get a block count.  In Win32 with CygWin, that's
    //the size of the file div 1024 and rounded up.
    //not only do need to support it with the -s switch but it's listed in the "total" header
    //in a Unix listing
    LFTPItem.NumberBlocks := LFTPItem.Size div 1024;
    if LFTPItem.Size mod 1024 > 0 then
    begin

      LFTPItem.NumberBlocks := LFTPItem.NumberBlocks + 1;
    end;
    //We don't use the DosDate from Borland's FindFirst, FindNext for two reasons:
    //1: We should be dealing with GMT time in all cases.  For Unix and WinNT style lists,
    //   it will be converted to LocalTime.
    //2: The Win32_FIND_DATA record has more information than simply the last modified date
    //   and the MLSD/MLST command permits us to return all of this in a standardized way.
    //   Indy can support a "Create", "Modified" and "windows.lastaccess" fact.
    //   For Linux, the POSIX filesystem, you would want to support only the Modified fact
    //   for file dates.
    LFTPItem.ModifiedDateGMT := FileTimeToTDateTime( SR.FindData.ftLastWriteTime);
    LFTPItem.CreationDateGMT := FileTimeToTDateTime( SR.FindData.ftCreationTime);
    LFTPItem.LastAccessDateGMT := FileTimeToTDateTime( SR.FindData.ftLastAccessTime);
    LFTPItem.WinAttribs := SR.FindData.dwFileAttributes;
    if SR.Attr and faDirectory > 0 then
    begin
      LFTPItem.ItemType   := ditDirectory;
      if SR.Attr and faReadOnly=faReadOnly then
      begin
        LFTPItem.UnixOwnerPermissions := 'r-x';
        LFTPItem.UnixGroupPermissions := 'r-x';
        LFTPItem.UnixOtherPermissions := 'r-x';
      end
      else
      begin
        LFTPItem.UnixOwnerPermissions := 'rwx';
        LFTPItem.UnixGroupPermissions := 'rwx';
        LFTPItem.UnixOtherPermissions := 'rwx';
      end;
    end
    else
    begin
      LFTPItem.ItemType   := ditFile;
      if SR.Attr and faReadOnly=faReadOnly then
      begin
        LFTPItem.UnixOwnerPermissions := 'r--';
        LFTPItem.UnixGroupPermissions := 'r--';
        LFTPItem.UnixOtherPermissions := 'r--';
      end
      else
      begin
        LFTPItem.UnixOwnerPermissions := 'rw-';
        LFTPItem.UnixGroupPermissions := 'rw-';
        LFTPItem.UnixOtherPermissions := 'rw-';
      end;
    end;
    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
 begin
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmCreate)
 end
 else
 begin
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenWrite)
 end;
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileSize: Int64);
Var
 LFile : String;
begin
  //we return -1 for an error
  LFile := ReplaceChars( AppDir + AFilename );
  try
    If FileExists(LFile) then
      VFileSize :=  GetSizeOfFile(LFile)
    else
      VFileSize := -1;
    except
      VFileSize := -1;
   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
  if not RemoveDir(LFile) then
  begin
    Raise Exception.Create('Unable to remove directory');
  end;
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
  AAuthenticated := True;
end;

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

procedure TForm1.IdFTPServer1AfterUserLogin(ASender: TIdFTPServerContext);
begin
//important - you really do need to set a currect directory it will drive
//some GUI FTP clients bonkers.
  ASender.CurrentDir := '/';
  ASender.HomeDir := '/';
end;

procedure TForm1.IdFTPServer1FileExistCheck(ASender: TIdFTPServerContext;
  const APathName: string; var VExist: Boolean);
begin
  //This event is necessary because MDTM is used in two different ways.
  //Officially, the MDTM command retreives the date and time and has a syntax such as:
  //
  //MDTM filename
  //
  //the second usage is an abuse of that command by using it to set the time.
  //on a file and the syntax is usually:
  //
  //MDTM timestamp filename
  //
  //This causes an abiguity because you can't be sure uf a command such as:
  //
  //MDTM 20050714233400 myfile.exe
  //
  //means get the timestamp for "20050714233400 myfile.exe"
  //
  //or set the file timestamp of myfile.exe to July 14, 2005 11:34 pm
  //
  //about the best you can do is use this event for ambigous cases and if the filename
  //"20050714233400 myfile.exe", assume that the person wanted the date of that file.
  //
  VExist := FileExists(ReplaceChars(AppDir+ASender.CurrentDir+'\'+APathName));
end;

procedure TForm1.IdFTPServer1GetFileDate(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileDate: TDateTime);
begin
  //You really should support the MDTM command for getting the file's last modified date
  //because of some file-synchronization programs.
  //
  //Note also that you must return the modified time as GMT so you can't use
  //Borland's FileAge function here.
  VFileDate := GetFileDate( ReplaceChars(AppDir+'\'+AFilename));
end;

procedure TForm1.IdFTPServer1SetModifiedTime(ASender: TIdFTPServerContext;
  const AFileName: string; var AFileTime: TDateTime);
//This looks odd because you have to return the date after you modify it in the
//command reply.
//
//That's part of the MFF, MFCT, and MFMT commands which are defined by:
//
//http://ftp.netzmafia.de/rfc/internet-drafts/draft-somers-ftp-mfxx-01.txt
//http://www.trevezel.com/downloads/draft-somers-ftp-mfxx-00.html
//
//I know that this draft expired but it really is a shame because there is a large
//need for this.  This is a more eligant solution than simply abusing the MDTM
//command to set a file date.
var LHandle : THandle;
  LModDate : TFileTime;
begin
//We use the Win32 API instead of Borland's RTL because this is based on GMT.
//This is based on:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=855

  LHandle := CreateFile(PChar(ReplaceChars(AppDir+'\'+AFileName)),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     nil,
                     OPEN_EXISTING,
                     FILE_FLAG_BACKUP_SEMANTICS,
                     0);
  if LHandle <> INVALID_HANDLE_VALUE then
  begin
    try
      LModDate := TDateTimeToFileTime(AFileTime);
      if Windows.SetFileTime(LHandle,nil,nil,@LModDate) then
      begin
        //now that we set the date, we need to return what it was
        //set to because different file systems have different resolutions.
        if Windows.GetFileTime(LHandle,nil,nil,@LModDate) then
        begin
          AFileTime := FileTimeToTDateTime(LModDate);
        end;
      end
      else
      begin
        raise Exception.Create('File Operation Aborted');
      end;
    finally
      CloseHandle(LHandle);
    end;
  end
end;

procedure TForm1.IdFTPServer1SetCreationTime(ASender: TIdFTPServerContext;
  const AFileName: string; var AFileTime: TDateTime);
var LHandle : THandle;
  LCreateDate : TFileTime;
begin
//We use the Win32 API instead of Borland's RTL because this is based on GMT.
//This is based on:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=855

  LHandle := CreateFile(PChar( ReplaceChars(AppDir+'\'+AFileName)),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     nil,
                     OPEN_EXISTING,
                     FILE_FLAG_BACKUP_SEMANTICS,
                     0);
  if LHandle <> INVALID_HANDLE_VALUE then
  begin
    try
      LCreateDate := TDateTimeToFileTime(AFileTime);
      if Windows.SetFileTime(LHandle,@LCreateDate,nil,nil) then
      begin
        //now that we set the date, we need to return what it was
        //set to because different file systems have different resolutions.
        if Windows.GetFileTime(LHandle,@LCreateDate,nil,nil) then
        begin
          AFileTime := FileTimeToTDateTime(LCreateDate);
        end;
      end
      else
      begin
        raise Exception.Create('File Operation Aborted');
      end;
    finally
      CloseHandle(LHandle);
    end;
  end
end;

procedure TForm1.IdFTPServer1SetATTRIB(ASender: TIdFTPServerContext;
  var VAttr: Cardinal; const AFileName: string; var VAUth: Boolean);
var LFileName : String;
begin
  LFileName := ReplaceChars(AppDir+AFilename);
  FileSetAttr( LFileName,VAttr);
  VAttr := FileGetAttr(LFileName)
end;

procedure TForm1.IdFTPServer1Stat(ASender: TIdFTPServerContext;
  AStatusInfo: TStrings);
//it is a good idea to support STAT
var Line : String;
begin
  AStatusInfo.Add('Connected to '+
    GStack.HostByAddress(ASender.Connection.Socket.Binding.PeerIP) );
  Line := 'Logged in as ';
  if (ASender.UserType = utAnonymousUser) then
  begin
    Line := Line + ASender.Password;
  end
  else
  begin
    Line := Line + ASender.Username;
  end;
  AStatusInfo.Add(Line);
  Line := 'TYPE: ';
  case ASender.DataType of
    ftASCII  : Line := Line + 'ASCII';
    ftBinary : Line := Line + 'BINARY';
  end;
  Line := Line + ', FORM: Nonprint; STRUcture: ';
  case ASender.DataStruct of
    dsFile   : Line := Line + 'File';
    dsRecord : Line := Line + 'Record';
    dsPage   : Line := Line + 'Page';
  end;
  Line := Line + '; transfer MODE: ';
  case ASender.DataMode of
    dmStream     : Line := Line + 'STREAM';
    dmDeflate    : Line := Line + 'DEFLATE';
  end;
  AStatusInfo.Add(Line);
  if Assigned(ASender.DataChannel) then
  begin
    AStatusInfo.Add('Data Connection Active');
  end
  else
  begin
    AStatusInfo.Add('No Data Connection');
  end;
end;

procedure TForm1.IdFTPServer1CombineFiles(ASender: TIdFTPServerContext;
  const ATargetFileName: string; AParts: TStrings);

var i : Integer;
  LSource, LDest : TStream;
begin
  if FileExists(ReplaceChars(AppDir+'\'+ ATargetFileName )) then
  begin
    LDest := TFileStream.Create(ReplaceChars(AppDir+'\'+ ATargetFileName ) ,fmOpenReadWrite or fmShareExclusive);
    LDest.Seek(0,soFromEnd);
  end
  else
  begin
    LDest := TFileStream.Create(ReplaceChars(AppDir+'\'+ ATargetFileName )   ,fmCreate);
  end;
  try
    for i := 0 to AParts.Count -1 do
    begin
      LSource := TFileStream.Create( ReplaceChars(AppDir+'\' + AParts[i] ) ,
        fmopenread or fmShareDenyWrite);
      LDest.CopyFrom(LSource,0);
      FreeAndNil(LSource);
    end;
    //Do this separately in case there was a failure to find a source file part
    for i := 0 to AParts.Count-1 do
    begin
      IdFTPServer1DeleteFile(ASender,AParts[i]);
    end;
  finally
    FreeAndNil(LSource);
    FreeAndNil(LDest);
  end;
end;

procedure TForm1.IdFTPServer1MLST(ASender: TIdFTPServerContext;
  const APath: string; ADirectoryListing: TIdFTPListOutput);
var
 LFTPItem :TIdFTPListOutputItem;
 SR : TSearchRec;
 SRI : Integer;
 LTmpPath : String;
begin
//for this, we return information only about the item, not the contents
    LTmpPath := RemoveTrailingPathDel ( ReplaceChars(AppDir  + APath));
    if LTmpPath = '' then
    begin
      LFTPItem := ADirectoryListing.Add;
      LFTPItem.ItemType   := ditDirectory;
      LFTPItem.FileName := '/';
      Exit;
    end;
    SRI := FindFirst(LTmpPath, faAnyFile , SR);// - faHidden - faSysFile, SR);
    if SRI = 0 then
    begin
      LFTPItem := ADirectoryListing.Add;
      //This is necessary because the Borland RTL FindData Size is an Integer and can't handle
      //anything greater than 2GB.
      LFTPItem.Size := Int64(SR.FindData.nFileSizeHigh shl 32) + SR.FindData.nFileSizeLow;
      //
//   The file name returned in the MLST response should be the same name
//   as was specified in the MLST command, or, where TVFS is supported, a
//   fully qualified TVFS path naming the same file.  Where no argument
//   was given to the MLST command, the server-PI may either include an
//   empty file name in the response, or it may supply a name that refers
//   to the current directory, if such a name is available.  Where TVFS is
//   supported, a fully qualified pathname of the current directory SHOULD
//   be returned.
//
      LTmpPath :=  RemoveTrailingPathDel(ReplaceChars(ASender.HomeDir + APath));
      if LTmpPath = '' then
      begin
        LTmpPath := '/';
      end;
      LFTPItem.FileName := StringReplace(LTmpPath,'\','/',[rfReplaceAll]);
      LFTPItem.ModifiedDateGMT := FileTimeToTDateTime( SR.FindData.ftLastWriteTime);
      LFTPItem.CreationDateGMT := FileTimeToTDateTime( SR.FindData.ftCreationTime);
      LFTPItem.LastAccessDateGMT := FileTimeToTDateTime( SR.FindData.ftLastAccessTime);
      LFTPItem.WinAttribs := SR.FindData.dwFileAttributes;
      if SR.Attr and faDirectory > 0 then
      begin
        LFTPItem.ItemType   := ditDirectory;
      end
      else
      begin
        LFTPItem.ItemType  := ditFile;
      end;
      FindClose(SR);
    end
    else
    begin
      RaiseLastOSError;
    end;
end;

procedure TForm1.IdFTPServer1RenameFile(ASender: TIdFTPServerContext;
  const ARenameFromFile, ARenameToFile: string);
begin
  SysUtils.RenameFile(ReplaceChars(AppDir + '/'+ ARenameFromFile),ReplaceChars(AppDir +'/'+ARenameToFile));
end;

procedure TForm1.IdFTPServer1SiteUTIME(ASender: TIdFTPServerContext;
  const AFileName: string; var VLastAccessTime, VLastModTime,
  VCreateDate: TDateTime; var VAUth: Boolean);
var LHandle : THandle;
  LModDate : TFileTime;
  LPModDate : PFileTime;
  LCreateDate :TFileTime;
  LPCreateDate : PFileTime;
  LAccessDate :TFileTime;
  LPAccessDate : PFileTime;
begin
//We use the Win32 API instead of Borland's RTL because this is based on GMT.
//This is based on:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=855

//We do things in a round-about way with pointers because sometimes a date will not
//be provided by a client and this could be used by the MFF command to set
//the Last Access Time fact

//The idea behind this event is to change the file dates in only ONE pass
  LHandle := CreateFile(PChar(ReplaceChars(AppDir+'\'+AFileName)),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     nil,
                     OPEN_EXISTING,
                     FILE_FLAG_BACKUP_SEMANTICS,
                     0);
  if LHandle <> INVALID_HANDLE_VALUE then
  begin
    try
      if VCreateDate<>0 then
      begin
        LCreateDate := TDateTimeToFileTime(VCreateDate);
        LPCreateDate := @LCreateDate;
      end
      else
      begin
        LPCreateDate := nil;
      end;
      if VLastModTime<>0 then
      begin
        LModDate := TDateTimeToFileTime(VLastModTime);
        LPModDate := @LModDate;
      end
      else
      begin
        LPModDate := nil;
      end;
      if VLastAccessTime <> 0 then
      begin
        LAccessDate := TDateTimeToFileTime(VLastAccessTime);
        LPAccessDate := @LAccessDate;
      end
      else
      begin
        LPAccessDate := nil;
      end;

      if Windows.SetFileTime(LHandle,LPCreateDate,LPAccessDate,@LModDate) then
      begin
        //now that we set the date, we need to return what it was
        //set to because different file systems have different resolutions.
        if Windows.GetFileTime(LHandle,@LCreateDate,@LAccessDate,@LModDate) then
        begin
          VLastModTime := FileTimeToTDateTime(LModDate);
          VCreateDate := FileTimeToTDateTime(LCreateDate);
          VLastAccessTime := FileTimeToTDateTime(LAccessDate);
        end;
      end
      else
      begin
        raise Exception.Create('File Operation Aborted');
      end;
    finally
      CloseHandle(LHandle);
    end;
  end

end;

end.
