Передача файла TidTCPServerClient/TidTCPClient

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Ответить
Shouldercannon
Сообщения: 74
Зарегистрирован: 08 июн 2008, 15:49

21 янв 2016, 16:55

Доброго времени суток!
Нашёл пример передачи файлов, но в нём клиент передаёт файл серверу

Код: Выделить всё

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;
нет действий и программа повисает
Ответить