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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.01.2016, 15:22   #1
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,893
Восклицание Передача файла TidTCPServerClient/TidTCPClient

Доброго времени суток!
Нашёл пример передачи файлов, но в нём клиент передаёт файл серверу
Код:
unit Unit1;
...
var
  Form1: TForm1;
  FName: String;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Запуск сервера
  IdTCPServer1.DefaultPort := Port;
  IdTCPServer1.Active := True;
  // Запуск клиента
  IdTCPClient1.Host := Host;
  IdTCPClient1.Port := Port;

  LServerStatus.Caption := 'Ожидание подключения...';
end;
//------------------------------------Server------------------------------------
procedure TForm1.BSelectFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then FName := OpenDialog1.FileName;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
  LServerStatus.Caption := 'Передача...';
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  LServerStatus.Caption := 'Отмена передачи';
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  FS: TFileStream;
  FName: String;
begin
  FName := AContext.Connection.IOHandler.ReadLn;

  FS := TFileStream.Create('Downloads\' + ExtractFileName(FName), fmCreate); // Сохранение
  try
    AContext.Connection.IOHandler.ReadStream(FS, -1, True); // Поток передаваемый клиентом
  finally
    FreeAndNil(FS);;
  end;

  AContext.Connection.Disconnect;

  LServerStatus.Caption := 'Файл принят';
end;
//------------------------------------Client------------------------------------
procedure TForm1.BFileReceiveClick(Sender: TObject);
var
  FS: TFileStream;
begin
  IdTCPClient1.Connect;
  IdTCPClient1.IOHandler.WriteLn(FName);

  FS := TFileStream.Create(FName, fmOpenRead or fmShareDenyNone); // Загрузка
  try
    IdTCPClient1.IOHandler.Write(FS); // Поток принимаемый сервером
  finally
    FreeAndNil(FS);
  end;

  IdTCPClient1.Disconnect;

  LClientStatus.Caption := 'Файл отправлен';
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  LClientStatus.Caption := 'Приём...';
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  LClientStatus.Caption := 'Отмена приёма';
end;

end.
Сделать наоборот и всё убил
Код:
unit Unit1;
...
var
  Form1: TForm1;
  FName: String;

implementation

{$R *.dfm}
//------------------------------------Server------------------------------------
procedure TForm1.BSelectFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    FName := OpenDialog1.FileName;
    // Запуск сервера
    IdTCPServer1.DefaultPort := Port;
    IdTCPServer1.Active := True;

    LServerStatus.Caption := 'Ожидание подключения...';
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
  LServerStatus.Caption := 'Передача...';
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  LServerStatus.Caption := 'Передача отменена';
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  FS: TFileStream;
begin
  AContext.Connection.Socket.WriteLn(FName);

  FS := TFileStream.Create(FName, fmOpenRead or fmShareDenyNone); // Загрузка
  try
    AContext.Connection.Socket.Write(FS); // Поток принимаемый клиентом
  finally
    FreeAndNil(FS);
  end;

  LClientStatus.Caption := 'Файл отправлен';
end;
// ------------------------------------Client------------------------------------
procedure TForm1.BFileReceiveClick(Sender: TObject);
begin
  // Запуск клиента
  IdTCPClient1.Host := Host;
  IdTCPClient1.Port := Port;
  IdTCPClient1.Connect;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  LClientStatus.Caption := 'Приём...';
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  LClientStatus.Caption := 'Приём отменён';
end;

procedure TForm1.IdTCPClient1SocketAllocated(Sender: TObject);
var
  FS: TFileStream;
  FName: String;
begin
  FName := IdTCPClient1.IOHandler.ReadLn;

  FS := TFileStream.Create('Downloads\' + ExtractFileName(FName), fmCreate); // Сохранение
  try
    IdTCPClient1.IOHandler.ReadStream(FS, -1, True); // Поток передаваемый сервером
  finally
    FreeAndNil(FS);;
  end;

  IdTCPClient1.Disconnect;

  LServerStatus.Caption := 'Файл принят';
end;

end.
Дальше
Код:
FName := IdTCPClient1.IOHandler.ReadLn;
нет действий и программа повисает

Последний раз редактировалось Shouldercannon; 22.01.2016 в 12:45.
Shouldercannon вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
TidTCPClient как определить момент чтения? igorserg Работа с сетью в Delphi 0 06.08.2012 16:38
Вопрос по TidTCPClient hobtorkins Работа с сетью в Delphi 0 21.12.2011 13:25
Как отправить текст с TidTCPServer на TidTCPClient? cyberexpert Работа с сетью в Delphi 0 19.09.2011 23:26
TIdTCPClient.IOHandler.InputBufferI sEmpty не сразу обновляется st01en Работа с сетью в Delphi 1 26.06.2009 08:34