Передать звук на несколько хостов - Работа с сетью в Delphi

Programmer0 · 30.06.2015, 10:35

Здравствуйте.
Статья из журнала "Программист" Передача звука по сети. Прототип VoIP телефона Уколов А.В. http://www.programmersclub.ru/%D0%9F...5%D0%BB%D0%B5/.
Пытаюсь передать звук на несколько хостов. В клиент добавляю второй TIdUDPClient и в процедуре OnWaveMessage отправляю на 2 хоста. В результате вся передача сильно тормозит. Подскажите, почему. И как передавать на несколько хостов?

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  StdCtrls,MMSystem;

const sampleRate=16000;
const buff_count=8; //количество буферов записи

type
  TForm1 = class(TForm)
    IdUDPClient1: TIdUDPClient;
    Button1: TButton;
    IdUDPClient2: TIdUDPClient;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
  procedure OnWaveMessage(var msg:TMessage); message MM_WIM_DATA;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  waveformat: TWAVEFORMATEX;
  Wavein: HWAVEIN;
  WaveHdr:array [0..buff_count-1] of TWaveHdr;
  bufsize:Cardinal;
  bytes:integer;
  n:integer; //номер буфера
  fstop:boolean;

implementation

{$R *.dfm}

procedure TForm1.OnWaveMessage(var msg:TMessage);
begin
    if not fstop then begin
        if n=buff_count then
          n:=0;
        idUDPClient1.Sendbuffer(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        idUDPClient2.Sendbuffer(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        waveInPrepareHeader(waveIn,@WaveHdr[n],sizeof(Twavehdr));
        waveInAddBuffer(wavein,@WaveHdr[n],sizeof(TwaveHdr));
        UpDate;
        inc(n);
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i:integer;
begin
    If button1.Caption='Начать отправку' then begin
        n:=0;
        fstop:=false;
        IdUDPClient1.Active:=true;
        IdUDPClient2.Active:=true;
        button1.Caption:='Остановить отправку';
        for i:=0 to buff_count-1 do begin
            waveInPrepareHeader(waveIn,@WaveHdr[i],sizeof(Twavehdr));
            waveInAddBuffer(wavein,@WaveHdr[i],sizeof(TwaveHdr));
            end;
        waveInStart(waveIn);
        end
    else
        begin
        fstop:=true;
        button1.Caption:='Начать отправку';
        IdUDPClient1.Active:=false;
        IdUDPClient2.Active:=false;
        for i:=0 to buff_count-1 do
            waveInUnprepareHeader(Wavein,@WaveHdr[i],sizeof(TwaveHdr));
        waveInStop(Wavein);
        end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Action:=caFree;
    IdUDPClient1.Active:=false;
    IdUDPClient2.Active:=false;
    waveInClose(Wavein);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    i:integer;
begin
    with waveformat do begin
        nChannels:=1;
        wFormatTag:=WAVE_FORMAT_PCM;
        nSamplesPerSec:=sampleRate;
        wBitsPerSample:=16;
        nBlockAlign:=nChannels * wBitsPerSample div 8;
        nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8;
        cbSize:=0;
        end;
    bufsize:=waveformat.nAvgBytesPerSec*2 div 16;
    IdUDPClient1.BufferSize:=bufsize;
    IdUDPClient1.Port:=10090;
    IdUDPClient2.BufferSize:=bufsize;
    IdUDPClient2.Port:=10091;
    waveInOpen(@Wavein,WAVE_MAPPER,addr(waveformat),self.Handle,0,CALLBACK_WINDOW);
    for i:=0 to buff_count-1 do begin
        WaveHdr[i].lpData:=Pchar(GlobalAlloc(GMEM_FIXED, bufsize));
        WaveHdr[i].dwBufferLength:=bufsize;
        WaveHdr[i].dwFlags:=0;
        end;
end;

end.

Stilet · 30.06.2015, 11:30

А загруз сети сверял? Может слишком большой объем передается?

Programmer0 · 30.06.2015, 11:43

Сеть на радиомодемах. Пока 3 компа "многоточка-2_точки". Размер буфера, как я понимаю 4000 байт:

Код:

const sampleRate=16000;
nChannels:=1;
wFormatTag:=WAVE_FORMAT_PCM;
nSamplesPerSec:=sampleRate;
wBitsPerSample:=16;
nBlockAlign:=nChannels * wBitsPerSample div 8;
nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8;
bufsize:=waveformat.nAvgBytesPerSec*2 div 16;
WaveHdr[i].dwBufferLength:=bufsize;
idUDPClient2.Sendbuffer(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);

Больше пока никаких данных не передается. Или надо что-то еще смотреть?

Programmer0 · 02.07.2015, 13:25

Цель та же - передать звук на несколько хостов одновременно. Переделал по-другому (взял отсюда http://superadm.net/index.php?name=pages&op=view&id=173). Вроде все в отдельном потоке, а все равно тормозит передача при 2-x idudpclient.sendbuffer.
А также не нашел, как передать мультикаст. Тоже прошу ткнуть носом.

Aliens_wolfs · 03.07.2015, 07:16

Попробуйте через поток передачу делать.

вот на вашем коде в потоке передачу делаем. Этот код я проверил с вашим проектом работает без тормазов. Запустите ваш сервер и этот код все работает нормально.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
  StdCtrls,MMSystem;

const sampleRate=16000;
const buff_count=8; 

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
  procedure OnWaveMessage(var msg:TMessage); message MM_WIM_DATA;
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  MemoryStream: TMemoryStream;
  hWorkUDPThead, ThId: Dword;

   waveformat: TWAVEFORMATEX;
  Wavein: HWAVEIN;
  WaveHdr:array [0..buff_count-1] of TWaveHdr;
  bufsize:Cardinal;
  bytes:integer;
  n:integer;
  fstop:boolean;


implementation

{$R *.dfm}

function WorkUDPThead(Param: Pointer): Integer;
var
  IdUDPClient1: TIdUDPClient;
  IdUDPClient2: TIdUDPClient;
begin
  IdUDPClient1:= TIdUDPClient.Create(nil);
  IdUDPClient2:= TIdUDPClient.Create(nil);

    IdUDPClient1.BufferSize:= Bufsize;
    IdUDPClient1.Port:= 10090;
    IdUDPClient2.BufferSize:= Bufsize;
    IdUDPClient2.Port:=10091;

  IdUDPClient1.Active:= true;
  IdUDPClient2.Active:= true;
try
while true do
begin
if MemoryStream.Size > 0 then
begin
MemoryStream.Position:= 0;
idUDPClient1.Sendbuffer(MemoryStream.Memory^, MemoryStream.Size);
idUDPClient2.Sendbuffer(MemoryStream.Memory^, MemoryStream.Size);
MemoryStream.Clear;
end;
sleep(1); //чтобы не грузить процессор
end;
     finally
    IdUDPClient1.Free;
    IdUDPClient2.Free;
 CloseHandle(hWorkUDPThead);
  endthread(0);
  end;
end;

procedure TForm1.OnWaveMessage(var msg:TMessage);
begin
    if not fstop then begin
        if n=buff_count then
          n:=0;
        MemoryStream.Write(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        waveInPrepareHeader(waveIn,@WaveHdr[n],sizeof(Twavehdr));
        waveInAddBuffer(wavein,@WaveHdr[n],sizeof(TwaveHdr));
        UpDate;
        inc(n);
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i:integer;
begin
    If button1.Caption='Начать отправку' then
    begin
        n:=0;
        fstop:=false;
     hWorkUDPThead:= BeginThread(nil, 0, @WorkUDPThead, Self, 0, ThId);
        button1.Caption:='Остановить отправку';
        for i:=0 to buff_count-1 do begin
            waveInPrepareHeader(waveIn,@WaveHdr[i],sizeof(Twavehdr));
            waveInAddBuffer(wavein,@WaveHdr[i],sizeof(TwaveHdr));
            end;
        waveInStart(waveIn);
        end
    else
        begin
        fstop:=true;
        button1.Caption:='Начать отправку';
        TerminateThread(hWorkUDPThead, 0);
        for i:=0 to buff_count-1 do
        waveInUnprepareHeader(Wavein,@WaveHdr[i],sizeof(TwaveHdr));
        waveInStop(Wavein);
        end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TerminateThread(hWorkUDPThead, 0);
    Sleep(100); //небольшая пауза для ожидания завершения потока и сокетов
    waveInClose(Wavein);
    MemoryStream.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    i:integer;
begin
MemoryStream:= TMemoryStream.Create;
    with waveformat do begin
        nChannels:=1;
        wFormatTag:=WAVE_FORMAT_PCM;
        nSamplesPerSec:=sampleRate;
        wBitsPerSample:=16;
        nBlockAlign:=nChannels * wBitsPerSample div 8;
        nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8;
        cbSize:=0;
        end;
    bufsize:=waveformat.nAvgBytesPerSec*2 div 16;

    waveInOpen(@Wavein,WAVE_MAPPER,addr(waveformat),self.Handle,0,CALLBACK_WINDOW);
    for i:=0 to buff_count-1 do begin
        WaveHdr[i].lpData:=Pchar(GlobalAlloc(GMEM_FIXED, bufsize));
        WaveHdr[i].dwBufferLength:=bufsize;
        WaveHdr[i].dwFlags:=0;
        end;
end;

end.

Programmer0 · 03.07.2015, 09:24

Цитата:

Сообщение от Aliens_wolfs

вот на вашем коде в потоке передачу делаем.

Спасибо. А здесь идет отправка броадкаста?

Aliens_wolfs · 04.07.2015, 00:22

Но можно пакетами RAW передачу делать и прием.
Вот Broadcast на вашем коде:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdUDPClient, StdCtrls, MMSystem;

const sampleRate=16000;
const buff_count=8; 

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  procedure OnWaveMessage(var msg:TMessage); message MM_WIM_DATA;
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  MemoryStream: TMemoryStream;
  hWorkUDPThead, ThId: Dword;

   waveformat: TWAVEFORMATEX;
  Wavein: HWAVEIN;
  WaveHdr:array [0..buff_count-1] of TWaveHdr;
  bufsize:Cardinal;
  bytes:integer;
  n:integer;
  fstop:boolean;


implementation

{$R *.dfm}

function WorkUDPThead(Param: Pointer): Integer;
var
  IdUDPClient: TIdUDPClient;
begin
try
 IdUDPClient:=TIdUDPClient.Create(nil);
 IdUDPClient.Port:=10090;
 IdUDPClient.Host:='255.255.255.255';
 IdUDPClient.BroadcastEnabled:=True;

while true do
begin
if MemoryStream.Size > 0 then
begin
MemoryStream.Position:= 0;
IdUDPClient.Sendbuffer(MemoryStream.Memory^, MemoryStream.Size);
MemoryStream.Clear;
end
else
sleep(1); //чтобы не грузить процессор
end;
     finally
    IdUDPClient.Free;
 CloseHandle(hWorkUDPThead);
  endthread(0);
  end;
end;

procedure TForm1.OnWaveMessage(var msg:TMessage);
begin
    if not fstop then begin
        if n=buff_count then
          n:=0;
        MemoryStream.Write(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        waveInPrepareHeader(waveIn,@WaveHdr[n],sizeof(Twavehdr));
        waveInAddBuffer(wavein,@WaveHdr[n],sizeof(TwaveHdr));
        UpDate;
        inc(n);
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i:integer;
begin
    If button1.Caption='Начать отправку' then
    begin
        n:=0;
        fstop:=false;
   MemoryStream.clear;
     hWorkUDPThead:= BeginThread(nil, 0, @WorkUDPThead, Self, 0, ThId);
        button1.Caption:='Остановить отправку';
        for i:=0 to buff_count-1 do begin
            waveInPrepareHeader(waveIn,@WaveHdr[i],sizeof(Twavehdr));
            waveInAddBuffer(wavein,@WaveHdr[i],sizeof(TwaveHdr));
            end;
        waveInStart(waveIn);
        end
    else
        begin
        fstop:=true;
        button1.Caption:='Начать отправку';
        TerminateThread(hWorkUDPThead, 0);
        for i:=0 to buff_count-1 do
        waveInUnprepareHeader(Wavein,@WaveHdr[i],sizeof(TwaveHdr));
        waveInStop(Wavein);
        end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  TerminateThread(hWorkUDPThead, 0);
    Sleep(1000); //небольшая пауза для ожидания завершения потока и сокетов
    waveInClose(Wavein);
    MemoryStream.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    i:integer;
begin
MemoryStream:= TMemoryStream.Create;
    with waveformat do begin
        nChannels:=1;
        wFormatTag:=WAVE_FORMAT_PCM;
        nSamplesPerSec:=sampleRate;
        wBitsPerSample:=16;
        nBlockAlign:=nChannels * wBitsPerSample div 8;
        nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8;
        cbSize:=0;
        end;
    bufsize:=waveformat.nAvgBytesPerSec*2 div 16;

    waveInOpen(@Wavein,WAVE_MAPPER,addr(waveformat),self.Handle,0,CALLBACK_WINDOW);
    for i:=0 to buff_count-1 do begin
        WaveHdr[i].lpData:=Pchar(GlobalAlloc(GMEM_FIXED, bufsize));
        WaveHdr[i].dwBufferLength:=bufsize;
        WaveHdr[i].dwFlags:=0;
        end;
end; 

end.

в принимающей программе добавить эти строки
IdUDPServer1.BroadcastEnabled:=true ;
IdUDPServer1.Active:=true;

Aliens_wolfs · 05.07.2015, 17:10

Сделан Broadcast на ваших примерах.
Принимающий ставите на компьютерах куда должен идти звук, а передающий ставиться на тот компьютер откуда должен идти источник звука. Работает проверено, и еще 2 программки с жатием GSM, нагрузка на сеть уменьшилась, качество вроде не потерянно, но есть небольшая задержка.

Programmer0 · 07.07.2015, 09:43

Цитата:

Сообщение от Aliens_wolfs

Сделан Broadcast на ваших примерах.

Огромное спасибо! Все прекрасно работает!
Только, честно говоря, сейчас мне немного другое нужно. Чтобы передающая программа управляла, кому передавать, а кому нет. И поэтому спросил про броадкаст в первом примере, где:

Цитата:

вот на вашем коде в потоке передачу делаем. Этот код я проверил с вашим проектом работает без тормазов. Запустите ваш сервер и этот код все работает нормально.

Там два TidUDPclient-а, и у них указывается
порт, но не указывается хост. И вот я спросил, он по умолчанию броадкаст отправляет?

Programmer0 · 07.07.2015, 09:44

А так мне пока нужно отправлять либо на один хост, либо на другой, либо на оба сразу, либо ни на один. Это я сделал по вашему примеру, добавив еще один поток:

Код:

var
  Form1: TForm1;

  MemoryStream1,MemoryStream2: TMemoryStream;
  hWorkUDPThead1, ThId1: Dword;
  hWorkUDPThead2, ThId2: Dword;

  waveformat: TWAVEFORMATEX;
  Wavein: HWAVEIN;
  WaveHdr:array [0..buff_count-1] of TWaveHdr;
  bufsize:Cardinal;
  bytes:integer;
  n:integer;
  fstop:boolean;

function WorkUDPThead1(Param: Pointer): Integer;
var
  IdUDPClient1: TIdUDPClient;
begin
  IdUDPClient1:= TIdUDPClient.Create(nil);
  IdUDPClient1.BufferSize:= Bufsize;
  IdUDPClient1.Host:='169.254.233.61';
  IdUDPClient1.Port:= 10090;
  IdUDPClient1.Active:= true;

  try
      while true do
          begin
          if MemoryStream1.Size > 0 then
              begin
              MemoryStream1.Position:= 0;
              idUDPClient1.Sendbuffer(MemoryStream1.Memory^, MemoryStream1.Size);
              MemoryStream1.Clear;
              end;
          sleep(1);
          end;
  finally
      IdUDPClient1.Free;
      CloseHandle(hWorkUDPThead1);
      endthread(0);
  end;
end;

function WorkUDPThead2(Param: Pointer): Integer;
var
  IdUDPClient2: TIdUDPClient;
  i:integer;
  s:array[0..1] of char;

  begin
  s[0]:=0;
  IdUDPClient2:= TIdUDPClient.Create(nil);
  IdUDPClient2.BufferSize:= Bufsize;
  IdUDPClient2.Host:='169.254.124.227';
  IdUDPClient2.Port:= 10090;
  IdUDPClient2.Active:= true;

  try
      while true do
          begin
          if MemoryStream2.Size > 0 then
              begin
              for i:=0 to memorystream2.size-1 do begin
                memorystream2.Position:=i;
                memorystream2.Write(s[0],1);
                inc(i);
                end;
              MemoryStream2.Position:= 0;
              idUDPClient2.Sendbuffer(WaveStreamL.Memory^, WaveStreamL.Size);
              MemoryStream2.Clear;
              end;
          sleep(1);
          end;
  finally
      IdUDPClient2.Free;
      CloseHandle(hWorkUDPThead2);
      endthread(0);
  end;
end;

procedure TForm1.OnWaveMessage(var msg:TMessage);
begin
    if not fstop then begin
        if n=buff_count then
          n:=0;
        MemoryStream1.Write(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        MemoryStream2.Write(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);
        waveInPrepareHeader(waveIn,@WaveHdr[n],sizeof(Twavehdr));
        waveInAddBuffer(wavein,@WaveHdr[n],sizeof(TwaveHdr));
        inc(n);
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i:integer;
begin
    If button1.Caption='Начать отправку' then
    begin
        n:=0;
        fstop:=false;
        hWorkUDPThead1:= BeginThread(nil, 0, @WorkUDPThead1, Self, 0, ThId1);
        hWorkUDPThead2:= BeginThread(nil, 0, @WorkUDPThead2, Self, 0, ThId2);
        button1.Caption:='Остановить отправку';
        for i:=0 to buff_count-1 do begin
            waveInPrepareHeader(waveIn,@WaveHdr[i],sizeof(Twavehdr));
            waveInAddBuffer(wavein,@WaveHdr[i],sizeof(TwaveHdr));
            end;
        waveInStart(waveIn);
        end
    else
        begin
        fstop:=true;
        button1.Caption:='Начать отправку';
        TerminateThread(hWorkUDPThead1, 0);
        TerminateThread(hWorkUDPThead2, 0);
        for i:=0 to buff_count-1 do
        waveInUnprepareHeader(Wavein,@WaveHdr[i],sizeof(TwaveHdr));
        waveInStop(Wavein);
        end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    i:integer;
begin
    MemoryStream1:= TMemoryStream.Create;
    MemoryStream2:= TMemoryStream.Create;
    with waveformat do begin
        nChannels:=1;
        wFormatTag:=WAVE_FORMAT_PCM;
        nSamplesPerSec:=sampleRate;
        wBitsPerSample:=16;
        nBlockAlign:=nChannels * wBitsPerSample div 8;
        nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8;
        cbSize:=0;
        end;
    bufsize:=waveformat.nAvgBytesPerSec*2 div 16;

    waveInOpen(@Wavein,WAVE_MAPPER,addr(waveformat),self.Handle,0,CALLBACK_WINDOW);
    for i:=0 to buff_count-1 do begin
        WaveHdr[i].lpData:=Pchar(GlobalAlloc(GMEM_FIXED, bufsize));
        WaveHdr[i].dwBufferLength:=bufsize;
        WaveHdr[i].dwFlags:=0;
        end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    TerminateThread(hWorkUDPThead1, 0);
    TerminateThread(hWorkUDPThead2, 0);
    Sleep(100);
    waveInClose(Wavein);
    MemoryStream1.Destroy;
    MemoryStream2.Destroy;
end;

end.

30.06.2015, 11:30	#2
Stilet Белик Виталий :) Старожил Регистрация: 23.07.2007 Сообщений: 57,097	А загруз сети сверял? Может слишком большой объем передается? I'm learning to live...

30.06.2015, 11:43	#3
Programmer0 Пользователь Регистрация: 05.05.2015 Сообщений: 55	Сеть на радиомодемах. Пока 3 компа "многоточка-2_точки". Размер буфера, как я понимаю 4000 байт: Код: `const sampleRate=16000; nChannels:=1; wFormatTag:=WAVE_FORMAT_PCM; nSamplesPerSec:=sampleRate; wBitsPerSample:=16; nBlockAlign:=nChannels * wBitsPerSample div 8; nAvgBytesPerSec:=sampleRate * nChannels * wBitsPerSample div 8; bufsize:=waveformat.nAvgBytesPerSec2 div 16; WaveHdr[i].dwBufferLength:=bufsize; idUDPClient2.Sendbuffer(WaveHdr[n].lpData^,WaveHdr[n].dwBufferLength);` Больше пока никаких данных не передается. Или надо что-то еще смотреть? Последний раз редактировалось Stilet; 30.06.2015 в 16:13.*

Опции темы	Поиск в этой теме
Версия для печати Отправить по электронной почте	Поиск в этой теме: Расширенный поиск

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как правильно передать несколько разнородных данных из одной формы в другую?	tumanovalex	C# (си шарп)	2	21.05.2011 10:05
Как передать несколько значений checkbox?	snikers987	PHP	12	13.12.2010 18:29
ServerSocket и несколько хостов.	noname Incognito	Работа с сетью в Delphi	4	15.07.2010 12:59
Передать звук по Блутуф связи	new123	Помощь студентам	1	25.04.2009 20:53
передать несколько файлов indy	SeЯgey	Работа с сетью в Delphi	5	31.05.2008 21:03