unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer,IdFTPList, 
  StdCtrls, ExtCtrls, ComCtrls, ShellCtrls, Grids, Outline, DirOutln, 
  IdUserAccounts; 
 
type 
  TForm1 = class(TForm) 
    IdFTPServer1: TIdFTPServer; 
    Bevel1: TBevel; 
    Image1: TImage; 
    Image2: TImage; 
    Label2: TLabel; 
    WorkDirectory: TEdit; 
    Memo1: TMemo; 
    Label1: TLabel; 
    IdUserManager1: TIdUserManager; 
    procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread; 
      const APath: String; ADirectoryListing: TIdFTPListItems); 
    procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread; 
      var VDirectory: String); 
    procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread; 
      var VDirectory: String); 
    procedure ShellTreeView1Change(Sender: TObject; Node: TTreeNode); 
    procedure IdFTPServer1StoreFile(ASender: TIdFTPServerThread; 
      const AFileName: String; AAppend: Boolean; var VStream: TStream); 
    procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread; 
      const AFileName: String; var VStream: TStream); 
    procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerThread; 
      const APathName: String); 
    procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerThread; 
      const AFilename: String; var VFileSize: Int64); 
    procedure IdFTPServer1RenameFile(ASender: TIdFTPServerThread; 
      const ARenameFromFile, ARenameToFile: String); 
    procedure FormCreate(Sender: TObject); 
    procedure IdFTPServer1UserLogin(ASender: TIdFTPServerThread; 
      const AUsername, APassword: String; var AAuthenticated: Boolean); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    HomeVDirectory:String; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
 
{$R *.dfm} 
 
function GetFileSize(const FileName: string): Longint; 
var 
  SearchRec: TSearchRec; 
begin 
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then 
    Result := SearchRec.Size 
  else Result := -1; 
  FindClose(SearchRec); 
end; 
 
Function ReplaceChar(Source:String;SChar,RChar:Char):String; 
var 
  ReplacePointer,IsSp,i,j:Integer; 
  Temp:String; 
begin 
  For ReplacePointer:=1 to length(Source) do 
  begin 
    if Source[ReplacePointer]=SChar then 
      Source[ReplacePointer]:=RChar; 
  end; 
  { 
  ReplacePointer:=1; 
  j:=0; 
  while ReplacePointer<=Length(Source)-1 do 
  begin 
    if (Source[ReplacePointer]=RChar) and (Source[ReplacePointer+1]=RChar) then 
    begin 
      For i:=ReplacePointer to Length(Source)-1 do 
      begin 
        Source[i]:=Source[i+1]; 
        inc(j); 
      end; 
      inc(ReplacePointer); 
    end; 
    inc(ReplacePointer); 
    inc(IsSp); 
  end; 
  Setlength(Source,length(Source)-j); 
  } 
  Result:=Source; 
end; 
 
function SlashToBackSlash( const str: string ) : string; 
var 
  a: dword; 
begin 
  result := str; 
  for a := 1 to length( result ) do 
    if result[a] = '/' then 
      result[a] := '\'; 
end; 
 
function TransLatePath( const APathname, homeDir: string ) : string; 
var 
  tmppath: string; 
  TempResult:String; 
begin 
  TempResult := SlashToBackSlash( homeDir ) ; 
  tmppath := SlashToBackSlash( APathname ) ; 
  if homedir = '/' then 
  begin 
    result := tmppath; 
    exit; 
  end; 
 
  if length( APathname ) = 0 then 
    exit; 
  Try 
    if TempResult[length(TempResult)-1 ] = '\' then 
      result := copy( TempResult, 1, length(TempResult) - 1 ) ; 
  Except 
    Exit; 
  end; 
  if tmppath[1] <> '\' then 
    result := TempResult + '\'; 
  result := TempResult + tmppath; 
end; 
 
procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread; 
  const APath: String; ADirectoryListing: TIdFTPListItems); 
   
  procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename:string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ; 
  var 
    listitem: TIdFTPListItem; 
  begin 
    listitem := aDirectoryListing.Add; 
    listitem.ItemType := ItemType; 
    listitem.FileName := Filename; 
    listitem.OwnerName := 'anonymous'; 
    listitem.GroupName := 'all'; 
    listitem.OwnerPermissions := '---'; 
    listitem.GroupPermissions := '---'; 
    listitem.UserPermissions := '---'; 
    listitem.Size := size; 
    listitem.ModifiedDate := date; 
  end; 
 
var 
  DirInfo: tsearchrec; 
  FindResult,i: integer; 
  Temp:PChar; 
begin 
  ADirectoryListing.DirectoryName := apath; 
  //ShowMessage(Format('½«ÒªÊ¹ÓõÄĿ¼ÊÇ: "%s"',[APath])); 
    FindResult := FindFirst( WorkDirectory.Text+APath+'*.*',faAnyFile, DirInfo ) ; 
    //·¢ÏÖµÚÒ»¸öÎļþ»òĿ¼ 
    while ( FindResult = 0 ) do 
    begin 
      if ( DirInfo.Attr and faDirectory > 0 ) then 
        AddlistItem( ADirectoryListing, DirInfo.Name, ditDirectory, DirInfo.size,FileDateToDateTime( DirInfo.Time ) ) 
        //Èç¹û½á¹ûÊÇĿ¼ 
      else 
        AddlistItem( ADirectoryListing, DirInfo.Name, ditFile, DirInfo.size,FileDateToDateTime( DirInfo.Time ) ) ; 
        //Èç¹û½á¹ûÊÇÎļþ 
      FindResult := FindNext( DirInfo ) ; 
     //¼ÌÐø²éÕÒ 
    end; 
   FindClose( DirInfo ) ; 
    //²é¿´½áÊø¹Ø±ÕÏàÓ¦µÄ²éÕÒ¹ý³Ì 
end; 
 
procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread; 
  var VDirectory: String); 
 
  {*½«Ä¿Â¼µ÷ÕûΪÉÏÒ»¼¶Ä¿Â¼*} 
  Function EraseLastString(Source:String;EraseChar:Char):String; 
  var 
    BasePoint,DymaPoint:integer; 
    StrLen:Integer; 
  begin 
    StrLen:=Length(Source); 
    if StrLen<=0 then 
      Result:=Source; 
    //ÒѾ 
    DymaPoint:=-1; 
    //³õʼ»¯Ö¸Õë 
    for BasePoint:=1 to StrLen do 
    begin 
      if Source[BasePoint]=EraseChar then 
        DymaPoint:=BasePoint; 
        //¶¨Î»Ä¿Â¼·Ö¸ô×Ö·û 
    end; 
    if DymaPoint=-1 then 
    begin 
      Result:=EraseChar 
    end 
    else 
    begin 
      SetLength(Source,DymaPoint-1); 
      Result:=Source; 
    end; 
  end; 
 
var 
  CurrentDir:String; 
begin 
  CurrentDir:=ASender.CurrentDir ; 
  {Åжϵ±Ç°µÄĿ¼ÊÇ·ñΪ¸ùĿ¼} 
  If VDirectory='..\' then 
  begin 
    VDirectory:=EraseLastString(CurrentDir,'\'); 
  end; 
end; 
 
procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread; 
  var VDirectory: String); 
begin 
  //MkDir(WorkDirectory.text+ASender.CurrentDir+VDirectory); 
  MkDir(ReplaceChar(WorkDirectory.text+VDirectory,'/','\')); 
end; 
 
procedure TForm1.ShellTreeView1Change(Sender: TObject; Node: TTreeNode); 
begin 
  WorkDirectory.Text:=Node.Item[Node.Index].Text 
end; 
 
procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerThread; 
  const AFileName: String; AAppend: Boolean; var VStream: TStream); 
var 
  NewFile:String; 
begin 
  NewFile :=ReplaceChar(WorkDirectory.Text+AFileName,'/','\'); 
  VStream:=TFileStream.Create(NewFile,fmCreate); 
end; 
 
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread; 
  const AFileName: String; var VStream: TStream); 
var 
  NewFile:String; 
begin 
  NewFile :=ReplaceChar(WorkDirectory.Text+AFileName,'/','\'); 
  VStream:=TFileStream.Create(NewFile,fmOpenRead or fmShareDenyWrite)  
end; 
 
procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerThread; 
  const APathName: String); 
var 
  NewFile:String; 
begin 
  NewFile:=WorkDirectory.Text+ASender.CurrentDir+'\'+APathName; 
  //Éú³ÉÎļþµÄ¾ø¶Ô·¾¶ 
  NewFile :=ReplaceChar(NewFile,'/','\'); 
  DeleteFile(newFile); 
  //ɾ³ýÏàÓ¦µÄÎļþ 
end; 
 
procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread; 
  const AFilename: String; var VFileSize: Int64); 
var 
  NewFile:String; 
begin 
  NewFile :=ReplaceChar(WorkDirectory.Text+AFileName,'/','\'); 
  VFileSize:=GetFileSize(newFile); 
end; 
 
procedure TForm1.IdFTPServer1RenameFile(ASender: TIdFTPServerThread; 
  const ARenameFromFile, ARenameToFile: String); 
var 
  RenameFromFile,RenameToFile:String; 
  //±»Ð޸ĵĺÍÍê³ÉµÄÎļþµÄ¾ø¶Ô·¾¶Ãû³Æ 
begin 
  RenameFromFile:=WorkDirectory.Text+ASender.CurrentDir+'\'+ARenameFromFile; 
  RenameToFile:=WorkDirectory.Text+ASender.CurrentDir+'\'+ARenameToFile; 
  //Éú³É¾ø¶ÔÎļþÃû³Æ 
  if FileExists(RenameToFile) then 
    ASender.Connection.WriteLn(format('%sÒѾ,ÇëÖØиıäÎļþÃû³Æ.',[ARenameToFile])) 
    //Èç¹ûÍê³ÉµÄÎļþÃû³ÆÒѾ,Ôò²»´¦Àí±»·¢ËÍÏàÓ¦µÄÐÅÏ¢ 
  else 
    RenameFile(RenameFromFile,RenameToFile) 
    //ÖØÃüÃûÎļþ¹¦ÄÜʵÏÖ 
 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
IdFTPServer1.MaxConnectionReply.Text.AddStrings(Memo1.lines); 
end; 
 
procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerThread; 
  const AUsername, APassword: String; var AAuthenticated: Boolean); 
begin 
  if (AUsername='lzmsoft') and (APassword='123') then 
    AAuthenticated:=True 
    //ͨ¹ýÈÏÖ¤ 
  else 
    AAuthenticated:=False; 
    //ûÓÐͨ¹ýÈÏÖ¤ 
end; 
 
end.