ftp.sberbank.sumy.ua/2014.11.ftp.sberbank.sumy.ua.tar/ftp.sberbank.sumy.ua/incoming/1/ftpserver.txt

Text File | 2014-02-08 | 9KB | 306 lines

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.