VPF::idFTPserver - Форум программистов

hastot

Дата 13.1.2005, 00:36 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Где можно достать исходники с фтп сервера с использованием idFTPserver smile

Snowy

Дата 4.10.2005, 11:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

А разве в Indy Demos нет примера FTP сервера?
Насколько я помню, должен быть.

generator

Дата 4.10.2005, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 18.1.2005

Репутация: нет
Всего: нет

Вот выложил, может кому поможет

http://linker19.pisem.net

Akella

Дата 19.4.2007, 10:56 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 4
Всего: 329

А нет ничего поновее для Indy10? B книге "Глубины Indy" нет нормального описания и примеров. И ещё хотелось узнать о IidUserManager.

Это сообщение отредактировал(а) Akella - 19.4.2007, 10:58

Sanchezzz

Дата 21.4.2007, 20:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1670
Регистрация: 19.11.2006
Где: Voronezh

Репутация: 1
Всего: 60

вот держи выдрал откудотова:

Основные свойства компонента 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;

Это сообщение отредактировал(а) Sanchezzz - 21.4.2007, 20:47

--------------------

Понравился ответ "+" по репе, не забываем закрывать тему, заказы в LS.

Gelios

Дата 16.6.2007, 15:14 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 16.6.2007

Репутация: нет
Всего: нет

Цитата(generator @ 4.10.2005, 17:54)

Вот выложил, может кому поможет

http://linker19.pisem.net

Спасибо за материал....!

Rohoss

Дата 9.9.2007, 14:12 (ссылка)

(нет голосов)

Загрузка ...

Начальник интернета

Профиль
Группа: Завсегдатай
Сообщений: 1308
Регистрация: 9.10.2006
Где: Matrix

Репутация: нет
Всего: 18

Пример ФТП сервера на http://www.indyproject.org/sockets/demos/index.en.aspx почему то не хочет удалять файлы и директории, подскажите плз в чём дело.
Вот исходный код этого сервера:

Код


unit uFTPServer;

interface

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

type
  TForm1 = class(TForm)
    IdFTPServer1: TIdFTPServer;
    btnClose: TButton;
    moNotes: TMemo;
    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);
  private
    function ReplaceChars(APath: String): String;
    function GetSizeOfFile(AFile : String) : Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  AppDir      : String;

implementation
{$R *.DFM}

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

function TForm1.ReplaceChars(APath:String):String;
var
 s:string;
begin
  s := StringReplace(APath, '/', '\', [rfReplaceAll]);
  s := StringReplace(s, '\\', '\', [rfReplaceAll]);
  Result := s;
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);
begin
  ASender.CurrentDir := VDirectory;
end;

procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
  const APathName: string);
begin
  DeleteFile(ReplaceChars(AppDir+ASender.CurrentDir+'\'+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 :TIdFTPListItem;
 SR : TSearchRec;
 SRI : Integer;
begin
  ADirectoryListing.DirFormat := doUnix;
  SRI := FindFirst(AppDir + APath + '\*.*', faAnyFile - faHidden - faSysFile, SR);
  While SRI = 0 do
  begin
    LFTPItem := ADirectoryListing.Add;
    LFTPItem.FileName := SR.Name;
    LFTPItem.Size := SR.Size;
    LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
    if SR.Attr = faDirectory then
     LFTPItem.ItemType   := ditDirectory
    else
     LFTPItem.ItemType   := ditFile;
    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
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmCreate)
 else
   VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenWrite)
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileSize: Int64);
Var
 LFile : String;
begin
 LFile := ReplaceChars( AppDir + AFilename );
 try
 If FileExists(LFile) then
   VFileSize :=  GetSizeOfFile(LFile)
 else
   VFileSize := 0;
 except
   VFileSize := 0;
 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
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;

end.

Добавлено через 1 минуту и 51 секунду
Наверное дело в атрибутах файлов, а можно их как-то менять через IdFTPServer?

--------------------

Файловый менеджер Explorer.Net скачать video

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »