вот держи выдрал откудотова:
Основные свойства компонента TidFTPServer
Свойство Тип Описание
AllowAnonymousLogin boolean Указывает, поддерживает ли FTP-сервер анонимных пользователей
AnonymousAccounts TStrings Определяет имена анонимных пользователей
AnonymousPassStrictCheck Boolean Определяет, должен ли пароль анонимных пользователей содержать верный адрес электронной почты
DefaultDataPort integer Порт по умолчанию для DATA-соединения
EmulateSystem TIdFTPSystems Определяет, как пользователю будет представляться файловая система сервера
HelpReply Tstrings Определяет ответ на FTP-команду HELP
UserAccounts TIdUserManager Ссылка на компонент TIdUserManager, который управляет пользователями сервера
Примечание:
1. Свойство DefaultDataPort по умолчанию имеет значение 20 и изменять его следует только в крайних случаях, причем необходимо понимать к чему это может привести.
2. В свойстве HelpReply обычно указываются все команды поддерживаемые сервером, но можно и ничего не указывать
Основные события компонента TidFTPServer
Событие Когда воникает
OnAfterCommandHandler После выполнения команды от клиента на сервере Asender в потоке AThread
OnBeforeCommandHandler Перед выполнением команды, поступившей от клиента
OnConnect При подключение нового пользователя
OnDisconnect При отключении пользователя
OnException При возникновении исключительной ситуации AException в потоке AThread
OnExecute При запуске потока для клиента
OnListenException При возникновении исключения в "прослушивающем" потоке
OnNoCommandHandler При получении неизвестной комманды
OnStatus При изменении состояния сервера
Несколько слов о TidUserManager
Основные свойства компонента TidUserManager
Свойство Тип Описание
Accounts TIdUserAccounts Коллекция для определения аккаунтов пользователей сервера
CaseSensitivePasswords Boolean Определяет имена анонимных пользователей
CaseSensitiveUsernames Boolean Определяет, учитывать ли регистр символов в имени пользователя idUserManager - управляет пользователями сервера, на официальном сайте есть пример с этим компонентом на 10 версию
| Код |
procedure TForm1.IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
//аутентификация на сервере средствами компонента idUserManager1
AAuthenticated:=IdUserManager1.AuthenticateUser(AUsername, APassword);
end;
Теперь следует определить обработчики событий основных команд протокола FTP.
onListDirectory:
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 := ASender.Username;
listitem.GroupName := 'all';
listitem.OwnerPermissions:='---';
listitem.GroupPermissions:='---';
listitem.UserPermissions:='---';
listitem.Size:=size;
listitem.ModifiedDate:=date;
end;
var
f: tsearchrec;
a: integer;
begin
ADirectoryListing.DirectoryName:=apath;
a:=FindFirst(TransLatePath(apath, ASender.HomeDir)+'*.*', faAnyFile, f);
while (a=0) do
begin
if (f.Attr and faDirectory> 0) then
AddlistItem(ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime(f.Time))
else
AddlistItem(ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime(f.Time));
a:=FindNext(f);
end;
FindClose(f);
end;
OnRenameFile:
procedure TForm1.IdFTPServer1RenameFile(ASender: TIdFTPServerThread;
const ARenameFromFile, ARenameToFile: String);
begin
if not MoveFile(pchar(TransLatePath(ARenameFromFile, ASender.HomeDir)),
pchar(TransLatePath(ARenameToFile, ASender.HomeDir))) then
RaiseLastWin32Error;
end;
OnRetrieveFile (скачать файл):
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.create(translatepath(AFilename,
ASender.HomeDir), fmopenread or fmShareDenyWrite);
end;
OnStoreFile: (закачать файл на сервер)
procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
if FileExists(translatepath(AFilename, ASender.HomeDir)) and AAppend then
begin
VStream:=TFileStream.create(translatepath(AFilename, ASender.HomeDir),
fmOpenWrite or fmShareExclusive);
VStream.Seek(0,soFromEnd);
end
else
VStream:=TFileStream.create(translatepath(AFilename, ASender.HomeDir),
fmCreate or fmShareExclusive);
end;
OnRemoveDirectory:
procedure TForm1.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
RmDir(TransLatePath(VDirectory, ASender.HomeDir));
end;
OnMakeDirectory:
procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
MkDir(TransLatePath(VDirectory, ASender.HomeDir));
end;
OnGetFileSize:
procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
begin
VFileSize:=FileSizeByName(TransLatePath(AFilename, ASender.HomeDir));
end;
OnDeleteFile:
procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerThread;
const APathName: String);
begin
DeleteFile(pchar(TransLatePath(ASender.CurrentDir+'/'+APathname, ASender.HomeDir)));
end;
OnCangeDirectory:
procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
VDirectory:=GetNewDirectory(ASender.CurrentDir, VDirectory);
end;
OnAfterUserLogin:
procedure TForm1.IdFTPServer1AfterUserLogin(ASender: TIdFTPServerThread);
begin
ASender.HomeDir := '/';
ASender.CurrentDir := '/';
end;
Поподробнее остановимся на событии OnAfterUserLogin. Его можно применить для установки домашнего и текущего каталога для пользователя. В данном случае - для всех пользователей в обоих случаях устанавливается корневой каталог диска, на котором запущен FTP сервер. Но можно каждому пользователю выделить свой каталог:
...
Asender.HomeDir := 'C:/FTP/'+ASender.Username +'/';
...
В проекте используется несколько сервисных процедур, код которых описан ниже. Важно, что, например, для изменения домашней папки пользователей, придется внести некоторые изменения в эти процедуры. Они специально были выделены, чтобы локализовать место для внесеия изменений, а не править половину исходного кода сервера.
function BackSlashToSlash(const str: string): string;
//применяется для преобразования пути в формате
//UNIX в вормат Windows
var
a: dword;
begin
result:=str;
for a:=1 to length(result) do
if result[a]='\' then
result[a]:='/';
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;
begin
tmppath:=SlashToBackSlash(APathname);
if homedir = '/' then
begin
result:=tmppath;
Exit;
end;
if length(APathname)=0 then
Exit;
if result[length(result)]='\' then
result:=copy(result, 1, length(result)-1);
if tmppath[1]'\' then
result:=result+'\';
result:=result+tmppath;
end;
function GetNewDirectory(old, action: string): string;
var
a: integer;
begin
if action='../' then
begin
if old='/' then
begin
result:=old;
Exit;
end;
a:=length(old)-1;
while(old[a]'\') and (old[a]'/') do
dec(a) ;
result:=copy(old, 1, a);
Exit;
end;
if (action[1]='/') or (action[1]='\')
then result:=action
els result:=old+action;
end;
|
|
