Передача файла tidtcpserverclient/tidtcpclient

Тема в разделе "Delphi - Сети", создана пользователем Shouldercannon, 21 янв 2016.

  1. Shouldercannon

    Shouldercannon Well-Known Member

    Регистрация:
    25 май 2010
    Сообщения:
    125
    Симпатии:
    0
    Доброго времени суток!
    Нашёл пример передачи файлов, но в нём клиент передаёт файл серверу
    Код (Delphi):
    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.
    Сделать наоборот и всё убил :)
    Код (Delphi):
    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.
    Дальше
    Код (Delphi):
    FName := IdTCPClient1.IOHandler.ReadLn;
    нет действий и программа повисает
     
    #1 Shouldercannon, 21 янв 2016
    Последнее редактирование модератором: 22 янв 2016
Загрузка...
Похожие Темы - Передача файла tidtcpserverclient
  1. alekssgor
    Ответов:
    3
    Просмотров:
    3.270
  2. alekssgor
    Ответов:
    5
    Просмотров:
    4.976
  3. sum44
    Ответов:
    2
    Просмотров:
    2.861
  4. Corexis
    Ответов:
    0
    Просмотров:
    73
  5. Shouldercannon
    Ответов:
    0
    Просмотров:
    393

Поделиться этой страницей