Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.11.2010, 17:02   #1
foxes
Пользователь
 
Регистрация: 14.11.2008
Сообщений: 94
По умолчанию Фтп сервер

делаю фтп сервер соединяется всё нормальна!
проблематика, заключается что не могу не чего скачать с фтп

function FtpDownloadFile чего то не помагает

Код:
Код:

function setSlashes(APath:String):String;
var
slash:string;
begin
slash := StringReplace(APath, '/', '', [rfReplaceAll]);
slash := StringReplace(slash, '', '', [rfReplaceAll]);
Result :=  slash;
end;

procedure TForm2.IdFTPServer1AfterUserLogin(ASender: TIdFTPServerContext);
begin
HomeDir:= 'D:/';
end;

procedure TForm2.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
begin
 ASender.CurrentDir:= VDirectory;
end;

procedure TForm2.IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
  const APathName: string);
begin
if fileexists(APathName) then
begin
DeleteFile(APathName);
end;
end;

procedure TForm2.IdFTPServer1FileExistCheck(ASender: TIdFTPServerContext;
  const APathName: string; var VExist: Boolean);
begin
if fileexists(APathName) then
begin
VExist:=true;
end
else
begin
VExist:=False;
end;
end;

procedure TForm2.IdFTPServer1GetFileDate(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileDate: TDateTime);
var
fdate:tdatetime;
begin
fdate:= FileAge(AFilename);
 if  not (fdate=-1) then  begin
VFileDate:=fdate;
end;

end;

procedure TForm2.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
  const AFilename: string; var VFileSize: Int64);
 Var
LFile : String;
rec:tsearchrec;
ASize: Int64 ;
  begin
LFile := setslashes(homedir + AFilename );
try
if FindFirst(Lfile, faAnyFile, rec) = 0 then  repeat
             Asize:=rec.Size;
             until FindNext(rec) <> 0;
        finally
            FindClose(rec);
end;
if Asize > 1 then
VFileSize:= Asize
else
VFilesize:=0;
end;

procedure TForm2.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(HomeDir + 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(HomeDir + APath + '..');
end;

procedure TForm2.IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
var
ldir:string;
begin
ldir:= setslashes(Homedir+VDirectory);
if not DirectoryExists(ldir) then
if not CreateDir(ldir) then
raise Exception.Create('Cannot create '+ldir);

end;

procedure TForm2.IdFTPServer1RemoveDirectory(ASender: TIdFTPServerContext;
  var VDirectory: string);
Var
LFile : String;
begin
LFile := setslashes(homedir + VDirectory);
if directoryexists(LFile) then begin
RemoveDir(LFile);
end
else
begin
Raise Exception.Create('Could not remove directory');
   end;

end;

procedure TForm2.IdFTPServer1RenameFile(ASender: TIdFTPServerContext;
  const ARenameFromFile, ARenameToFile: string);
begin
if not Renamefile(ARenameFromFile,ARenameToFile) then
begin
   Raise Exception.Create('Could not rename file');
end;
end;

procedure TForm2.IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
  const AFileName: string; AAppend: Boolean; var VStream: TStream);
begin
if not Aappend then
VStream := TFileStream.Create(AFileName,fmCreate)
else
      VStream := TFileStream.Create(AFileName,fmOpenWrite)
end;

procedure TForm2.IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
  const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
 if (AUsername = Edit1.text) and (APassword = Edit1.text) then
begin
AAuthenticated:=True
end
else
begin
AAuthenticated := False;
end;
end;
end.

Последний раз редактировалось foxes; 19.11.2010 в 18:11.
foxes вне форума Ответить с цитированием
Старый 19.11.2010, 17:10   #2
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

Внизу каждой страницы форума есть ссылка на наш "Клуб программистов".
Там есть исходники и чата, и ФТП, и почтового клиента и много-много всего...
mihali4 вне форума Ответить с цитированием
Старый 19.11.2010, 17:22   #3
foxes
Пользователь
 
Регистрация: 14.11.2008
Сообщений: 94
По умолчанию

всё те что у вас он работаю только на delphi7, а меня интересуют delphi 2010

Не нужно цитировать предыдущее сообщение! Это - флуд.
Рекомендую. Помимо общих правил форума есть и дополнения к ним в каждом разделе...
А кроме кнопки "Цитата" внизу есть простое окно для ввода своего сообщения.
Или маленькая кнопочка "Быстрый ответ" справа от кнопки "Цитата".
Попадаете туда же.
Модератор


Кроме того, переносы делаются автоматически...

Последний раз редактировалось mihali4; 19.11.2010 в 17:47.
foxes вне форума Ответить с цитированием
Старый 19.11.2010, 17:48   #4
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

А что, переносить исходники на 2010-ю должен дядя ?

Последний раз редактировалось mihali4; 19.11.2010 в 18:26.
mihali4 вне форума Ответить с цитированием
Старый 19.11.2010, 18:23   #5
foxes
Пользователь
 
Регистрация: 14.11.2008
Сообщений: 94
По умолчанию

Большое вам спасибо!
foxes вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Скачать с ФТП CraftR14 Работа с сетью в Delphi 0 06.04.2010 19:27
Работа с фтп -IIPu3PAK- Работа с сетью в Delphi 1 19.08.2009 16:18
Загрузка файлов на фтп mish@ Работа с сетью в Delphi 0 30.06.2009 13:28