home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.sberbank.sumy.ua
/
2014.11.ftp.sberbank.sumy.ua.tar
/
ftp.sberbank.sumy.ua
/
incoming
/
1
/
ftpserver.txt
< prev
next >
Wrap
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.