Последние записи
- Рандомное слайдшоу
- Событие для произвольной области внутри TImage
- Удаление папки с файлами
- Распечатка файла
- Преобразовать массив байт в вещественное число (single)
- TChromium (CEF3), сохранение изображений
- Как в Delphi XE обнулить таймер?
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
29th
Июн
Авторизация вконтакте с помощью indy
Всем привет! я знаю что таких тем куча, но всё такиж помогите очень надо!
Я пишу программу которая авторизуется на сайте вконтакте через idhttp методо post! (читать всё…)
26th
Июн
Авторизация на mail.ru с помощью indy
Не пойму в чем трабла, написал свой код, вчера сидел весь день, так ничего и не добился (читать всё…)
17th
Май
Прием данных/отсылка в поток Indy10
По сему на сервер данные поступают, но в поток Dongle.FWrBuf этот байт не записывается! как быть? (читать всё…)
15th
Сен
Imageshack Upload Api
Листинг о том, как загружать изображения на сайт imageshack.us.
function sendimgs(path:string):string;
var
HTTP: TIdHTTP;
MPS: TIdMultiPartFormDataStream;
s,s2,format:string;
begin
HTTP := TIdHTTP.Create(nil);
MPS := TIdMultiPartFormDataStream.Create;
HTTP.HandleRedirects := True;
s:='';
if fileexists(path) then
begin
try
{mps.AddFormField('Upload', 'Submit Query');
s:= HTTP.Post('http://iload8.imageshack.us/upload_api.php', MPS); }
mps.AddFile('fileupload', path, 'multipart/form-data');
s:= HTTP.Post('http://imageshack.us/index.php', MPS);
if pos('/images/blue/check.png', s)>0 then
begin
result:='Done';
end;
result:='Error while sending';
finally
MPS.Free;
HTTP.Free;
deletefile(path);
end;
end else result:='File not found';
end;
13th
Сен
idHTTP и кодировка
добрый вечер. в переменную типа стринг качается через идхттп гет запросом страница. страница в ютф8, после всего этого пытаюсь распарсить через pos (нужно найти фразу <liкакойтотекстнарусском<strong>) . соответственно, руские буквы кракозябрами, и пос их не ищет. пытался декодировать utf8toansi и наоборот – ничего не помогает. кракозябры меняются только
function UTF8ToStrSmart(Value: String): String;
function UTF8ToStr(Value: String): String;
var
buffer: Pointer;
BufLen: LongWord;
begin
BufLen := Length(Value) + 4;
GetMem(buffer, BufLen);
FillChar(buffer^, BufLen, 0);
MultiByteToWideChar(CP_UTF8, 0, @Value[1], BufLen - 4, buffer, BufLen);
Result := WideCharToString(buffer);
FreeMem(buffer, BufLen);
end;
var
Digit: String;
i: integer;
HByte: Byte;
Len: Byte;
begin
Result := '';
Len := 0;
if Value = '' then Exit;
for i := 1 to Length(Value) do
begin
if Len > 0 then
begin
Digit := Digit + Value;
Dec(Len);
if Len = 0 then
Result := Result + UTF8ToStr(Digit);
end else
begin
HByte := Ord(Value);
if HByte in [$00..$7f] then //Standart ASCII chars
Result := Result + Value
else begin
//Get length of UTF-8 char
if HByte and $FC = $FC then
Len := 6
else if HByte and $F8 = $F8 then
Len := 5
else if HByte and $F0 = $F0 then
Len := 4
else if HByte and $E0 = $E0 then
Len := 3
else if HByte and $C0 = $C0 then
Len := 2
else begin
Result := Result + Value;
Continue;
end;
Dec(Len);
Digit := Value;
end;
end;
end;
end;
Есть ещё 2 совета.
1. Брось инди и переходи на ICS.
2. Обнови инди до максимально последней версии.
Код:
function HttpGetUrl(url: string; idHttp: TidHttp): string;
var
M: TStringStream;
begin
M := TStringStream.Create('');
// try
try
IdHTTP.Get(url, m);
if IdHTTP.ResponseCode = 502 then
begin
result := 'ошибка|'+url;
freeandnil(m);
exit;
end;
except
on e: exception do
begin
// MessageBox(application.ActiveFormHandle, PAnsiChar('Произошла ошибка при получении текста страницы: '+#13+ url + #13+e.Message), 'Ошибка', IDOK);
result := 'ошибка|'+url;
freeandnil(m);
end;
end;
result := m.DataString;
// finally
freeandnil(m);
// end;
end;
итого полный код будет:
Код:
//получаем тест страницы со ссылками на объявления
slText := UTF8ToStrSmart(HttpGetUrl(URL, idHttp1));
27th
Май
Передача звука по сети. Прототип VoIP телефона
Данная статья будет полезна начинающим программистам, которые никогда не имели дело со звуком и его передачей по сети. Смысл этой статьи заключается в изучении и применении: WINAPI функций ввода и вывода звука WaveIn() и WaveOut() в среде разработки Delphi 7.0, самих компонентов TIdUDPServerSocket и TIdUDPClientSocket. Данные компоненты можно найти в библиотеке Indy, которая в свою очередь находится в свободном распространении на просторах Internet’а.
Передача звука по сети. Прототип VoIP телефона
Уколов Александр Владимирович
by ImmortalAlexSan st_devil@mail.ru
Комментарий автора.
Если вы никогда не программировали в Delphi 7.0, версиями ниже или выше, если вы вообще никогда не программировали на подобных ЯВУ, то эта статья не для вас.
Введение
К написанию программы для передачи звука по сети меня побудило желание получить-таки зачет по УИРС (это что-то вроде НИР – научно исследовательской работы студента) у преподавателя, ведущего мой основной предмет, и являющимся моим дипломным руководителем. Перед тем как сесть за Delphi и начать набирать код, предварительно, я изучил кучу литературы в бумажном и электронном виде о принципах упаковки звука и его передачи, о функциях ввода и вывода в самом Delphi и многом другом [1, 2]. Именно ввод и вывод заставил меня задуматься о сложности преподносимого материала. Для человека, никогда не имевшего с этим дело, разобраться в этой области очень сложно, имея под рукой множество кода без комментариев с непонятными процедурами и функциями непонятного WIN API, а если эти процедуры и функции описаны, то это описание предназначено не для начинающих программистов, приходилось все додумывать самому: смотреть подноготную каждой процедуры, и методом проб и ошибок идти медленно, но уверенно к вершине созидания. Но в конечном итоге я добился поставленной цели. И сейчас, разложив всю информацию, предоставленную мне в кашеобразном виде, по полочкам, я готов поделиться своими знаниями с вами, дорогие читатели! Итак, приступим…
Средства разработки
Прежде всего, для работы нам понадобится:
. IDE Delphi версии 7.0 и выше
. Библиотека Indy для Delphi 7.0 (TIdUDPServerSocket и TIdUDPClientSocket) [3, 4]
. колонки и микрофон
Сразу же перейдем к практической части. По мере появления неизвестных функций и процедур в листинге, они будут незамедлительно описываться…
Практическая часть. Создадим клиента
Передача звука в моей программе осуществляется с клиента на сервер, т.е. в одном направлении. Клиент может только писать и передавать, сервер – только принимать и воспроизводить. Первым делом начнем писать клиент.
Для этого, создадим новый проект в Дельфи, разместим на форме кнопку TButton и изменим ее свойство Caption на «начать отправку». После чего, разместим на форме компонент из библиотеки Indy TIdUDPClientSocket (см. рисунок 1):
Так как тестирование программы будет проводиться на локальном компьютере, то изменим значение свойства Host компонента TIdUDPClientSocket на «localhost». Далее я просто перечислю свойства компонента и их значения, что должны быть установлены: Active (false), BroadCastEnabled (false), BufferSize (8192), Name (IdUDPClient1), Port (0), ReceiveTimeOut (-2), Tag (0).
Примечание: описание некоторых вышеуказанных свойств выходит за рамки данной статьи.
Теперь, нажимаем двойным щелчком по вынесенному на форму компоненту TButton и появится обработчик события Button1Click(), где Button1 – это значение свойства Name данного компонента. В этом обработчике пишем или копируем следующий код:
procedure TForm1.Button1Click(Sender: TObject);
begin
// если на кнопке написано «начать отправку» то
If button1.Caption='Начать отправку' then Begin // выполняем этот код, где:
// готовим заголовок для буфера, здесь WaveIn – переменная типа интегер, для
// указания идентификатора устройства ввода (микрофона например), @WaveHdr –
// указатель на структуру TWaveHdr, sizeof(Twavehdr) – размер данной структуры в байтах.
waveInPrepareHeader(waveIn,@WaveHdr,sizeof(Twavehdr));
// заносим данные в буфер
waveInAddBuffer(wavein,@WaveHdr,sizeof(TwaveHdr));
// активируем сокет клиента
IdUDPClient1.Active:= true;
// считываем данные с микрофона
waveInStart(waveIn);
// в едит для наглядности заносим количество записанных байт (делал для себя,
// чтобы проверять, пишется звук или нет)
Edit1.Text:= inttostr(WaveHdr.dwBufferLength);
// меняем название кнопки, чтобы создать возможность прервать отправку пакетов
button1.Caption:='Остановить отправку'
end else Begin // если название кнопки «остановить отправку» то
//переименовываем её
button1.Caption:='Начать отправку';
//закрываем сокет клиента
IdUDPClient1.Active:=false;
//разгружаем буфер
waveInUnprepareHeader(Wavein,@WaveHdr,sizeof(TwaveHdr));
// приостанавливаем считывание. ЗАМЕТЬТЕ! ПРИОСТАНАВЛИВАЕМ! Если мы
// напишем waveInClose(Wavein), то устройство будет закрыто, и при повторном
// нажатии на кнопку, не будет никакого результата.
waveInStop(Wavein);
// смотрим кол-во не записанных байт
Edit1.Text:=inttostr(Wavehdr.dwBytesRecorded);
end
end;
Вы спросите, а что же такое waveInPrepareHeader? Это функция, выполняющая подготовку буфера для операции загрузки данных. Общий вид:
function waveInPrepareHeader(
hWaveIn: HWAVEIN;
lpWaveInHdr: PWaveHdr;
uSize: UINT
): MMRESULT; stdcall;
Здесь:
HWaveIn – идентификатор открытого устройства
LpWaveInHdr – адрес структуры WaveHdr
type TWaveHdr = record
lpData: PChar; { указатель на буфер}
dwBufferLength: DWORD; { длина буфера }
dwBytesRecorded: DWORD; { записанный байты }
dwUser: DWORD; { переменная для использования её пользователем }
dwFlags: DWORD; { флаги }
dwLoops: DWORD; { контролер }
lpNext: PWaveHdr; { переменная для драйвера }
reserved: DWORD; { переменная для драйвера }
end;
Здесь:
lpData – адрес буфера для загрузки данных
dwBufferLength – длина буфера в байтах
dwBytesRecorded – для режима загрузки данных определяет количество загруженных в буфер байт
dwUser – пользовательские данные
dwFlags – флаги. Могут иметь следующие значения: WHDR_DONE устанавливается
драйвером при завершении загрузки буфера данными
WHDR_PREPARED – устанавливается системой. Показывает готовность буфера к загрузке данных
WHDR_INQUEUE – устанавливается системой, когда буфер установлен в очередь
dwLoops – используется только при воспроизведении. При записи звука всегда 0
lpNext – зарезервировано
reserved – зарезервировано
uSize – размер структуры WaveHdr в байтах
Функция waveInPrepareHeader вызывается только один раз для каждого устанавливаемого в очередь загрузки буфера. Что такое waveInAddBuffer()? Функция waveInAddBuffer() ставит в очередь на загрузку данными буфер памяти. Когда буфер заполнен, система уведомляет об этом приложение:
function waveInAddBuffer(
hWaveIn: HWAVEIN;
lpWaveInHdr: PWaveHdr;
uSize: UINT
): MMRESULT; stdcall;
Здесь:
hWaveIn – идентификатор открытого Waveform audio устройства ввода
lpWaveInHdr – адрес структуры TWaveHdr
uSize – размер WaveHdr в байтах
Что такое waveInStart(), waveInStop(), waveInClose()? Общий вид записи таков:
function waveInStart(hWaveIn: HWAVEIN): MMRESULT; stdcall;
waveInStop(), waveInClose() имеют совершенно одинаковый параметр – как и WaveInStart(), которую описывать не имеет смысла, ибо и так понятно, что она начинает считывать данные с устройства ввода, а вот waveInClose() закрывает устройство для записи, и его снова придется открывать с помощью WaveInOpen(), но об этом ниже… А вот waveInStop(), ставит запись как бы на паузу, и нам не надо повторно использовать WaveInOpen().
Что такое waveInUnprepareHeader? Функция аналогичная waveInPrepareHeader(), однако она возвращает выделенную память на буфер, т.е. как бы «уничтожая» его.
Как узнать, что уже можно передавать данные?
Мы разобрали некоторые функции WIN API, относящиеся к вводу данных. Не устали? Нет? Тогда двигаемся дальше! Создадим собственную процедуру для определения завершения передачи данных в блок памяти посредством WaveInAddBuffer(). А выглядит она так:
procedure TForm1.OnWaveMessage(var msg:TMessage);
begin
waveInPrepareHeader(waveIn,@WaveHdr,sizeof(Twavehdr));
waveInAddBuffer(wavein,@WaveHdr,sizeof(TwaveHdr));
// отправляем буфер на сервер, где WaveHdr.lpData^ - это ссылка на память, где
// хранятся считанные с микрофона данные, уже преобразованные в
// последовательность нулей и единиц, WaveHdr.dwBufferLength – длина буфера данных
idUDPClient1.Sendbuffer(WaveHdr.lpData^,WaveHdr.dwBufferLength);
// В переменную заносим количество отправленных байт
Bytes:=Bytes+WaveHdr.dwBufferLength;
// Формат строки. Посмотрите в google фразу format дельфи
Caption:=Format ('%u',[Bytes]);
UpDate
end;
В этой процедуре используются уже известные вам функции, по этому второй раз описывать их не будем. Пишем её сразу после строки {$R *.dfm}. А описываем эту процедуру в разделе private класса TForm1 как:
procedure OnWaveMessage(var msg:TMessage); message MM_WIM_DATA;
Эта процедура будет выполняться каждый раз как только передача данных в буфер будет завершена и система сгенерирует сообщение WIM_DATA. Заполним обработчик события формы OnClose():
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// завершаем все действия
Action:= caFree;
// деактивируем сокет
IdUDPClient1.Active:=false;
// закрываем, теперь уже совсем, устройство записи
waveInClose(Wavein);
end;
И конечно же, заполним обработчик события формы OnCreate():
procedure TForm1.FormCreate(Sender: TObject);
begin
// with – оператор, благодаря которому можно не писать переменные, а указывать
// сразу их свойства. В данном случае WaveFormat: TWAVEFORMATEX – отвечает
// за сигнал, т.е. за все его характеристики, описан ниже.
with waveformat do begin
nChannels:=1;
wFormatTag:=WAVE_FORMAT_PCM;
nSamplesPerSec:=8000;
wBitsPerSample:=8;
nBlockAlign:=1;
nAvgBytesPerSec:=8000;
cbSize:=0;
end;
// для удобства загоняем размер буфера в переменную, которую будем вызывать
bufsize:= waveformat.nAvgBytesPerSec*2 div 16;
// размеру буфера сокета присваиваем размер буфера bufsize
IdUDPClient1.BufferSize:=bufsize;
// waveInOpen опишем чуть ниже, как и обещал, WAVE_MAPPER – система
// сама выбирает устройство
waveInOpen(@Wavein,WAVE_MAPPER,addr(waveformat),self.Handle,0,CALLBACK_WINDOW);
// выделяем память под заголовок буфера данных
WaveHdr.lpData:=Pchar(GlobalAlloc(GMEM_FIXED, bufsize));
// присваиваем длину буфера TWaveHdr’у
WaveHdr.dwBufferLength:=bufsize;
// сбрасываем флаги
WaveHdr.dwFlags:=0;
// устанавливаем порт подключения для клиента
IdUDPClient1.Port:= 10090
end;
Что же такое WaveInOpen()?
Функция waveInOpen() открывает имеющееся устройство ввода Waveform Audio для оцифровки сигнала. Типичная ее структура выглядит следующим образом:
function waveInOpen(
lphWaveIn: PHWAVEIN;
uDeviceID: UINT;
lpFormatEx: PWaveFormatEx;
dwCallback,
dwInstance,
dwFlags: DWORD
): MMRESULT; stdcall;
Здесь:
lphWaveIn – указатель на идентификатор открытого Waveform audio устройства. Идентификатор используется после того, как устройство открыто, в других функциях Waveform audio;
uDeviceID – номер открываемого устройства (см. waveInGetNumDevs). Это может быть также идентификатор уже открытого ранее устройства. Вы можете использовать значение WAVE_MAPPER для того, чтобы функция автоматически выбрала совместимое с требуемым форматом данных устройство;
lpFormatEx - указатель на структуру типа TWaveFormatEx
type TWaveFormatEx = packed record
wFormatTag: Word; { format type }
nChannels: Word; { number of channels (i.e. mono, stereo, etc.) }
nSamplesPerSec: DWORD; { sample rate }
nAvgBytesPerSec: DWORD; { for buffer estimation }
nBlockAlign: Word; { block size of data }
wBitsPerSample: Word; { number of bits per sample of mono data }
cbSize: Word; { the count in bytes of the size of }
end;
В этой структуре значения полей следующие:
wFormatTag – формат Waveform audio. Мы будем использовать значение WAVE_FORMAT_PCM
(это означает импульсно-кодовая модуляция) другие возможные значения
смотрите в заголовочном файле MMREG.H;
nChannels – количество каналов. Обычно 1 (моно) или 2(стерео);
nSamplesPerSec – частота дискретизации. Для формата PCM – в классическом смысле, т.е.
количество выборок в секунду. Согласно теореме отсчетов должна вдвое
превышать частоту оцифровываемого сигнала. Обычно находится в диапазоне от
8000 до 44100 выборок в секунду;
nAvgBytesPerSec – средняя скорость передачи данных. Для PCM равна nSamplesPerSec*nBlockAlign;
nBlockAlign – для PCM равен (nChannels*wBitsPerSample)/8;
wBitsPerSample – количество бит в одной выборке. Для PCM равно 8 или 16;
cbSize – равно 0. Подробности в Microsoft Multimedia Programmer’s Reference;
dwCallback – адрес callback-функции, идентификатор окна или потока, вызываемого при
наступлении события;
dwInstance – пользовательский параметр в callback-механизме. Сам по себе не используется
dwFlags – флаги для открываемого устройства:CALLBACK_EVENT dwCallback-параметр –
код сообщения (an event handle);
CALLBACK_FUNCTION dwCallback – параметр – адрес процедуры-обработчика
CALLBACK_NULL dwCallback – параметр не используется
CALLBACK_THREAD dwCallback – параметр – идентификатор потока команд;
CALLBACK_WINDOW dwCallback – параметр – идентификатор окна
WAVE_FORMAT_DIRECT если указан этот флаг, ACM-драйвер не выполняет преобразование данных
WAVE_FORMAT_QUERY функция запрашивает устройство для определения
поддерживает ли оно указанный формат, но не открывает его
Мы использовали callback функцию в OnWaveMessage(). В последнюю очередь я опишу переменные, которые использовались:
type
TForm1 = class(TForm)
IdUDPClient1: TIdUDPClient;
Button1: TButton;
Edit1: TEdit;
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 }
Wavein:HWAVEIN;
WaveHdr:TWaveHdr;
bufsize:Cardinal;
end;
var
Form1: TForm1;
WaveDataLength:integer;
bytes:integer;
device:word;
waveformat: TWAVEFORMATEX;
a:integer;
Так же для работы программы необходимо добавить модуль MMSystem в раздел uses. Клиент готов! Как видите, не так страшен черт, как его малюют! Перед тем как перейти к написанию сервера, я бы вам настоятельно рекомендовал бы покопаться в генофонде всех выше описанных функций и самостоятельно глубже разобраться в том, как они устроены. Так для более углубленного изучения, советую переворошить содержимое таких компонентов из серии ACM как AcmIn, AcmOut. Только самообучением можно чего-нибудь добиться.
А что же сервер?
С чистой перед клиентом совестью, можем приступить к написанию сервера! Возможно, эта процедура покажется вам более сложной, но, разобравшись в ней, вы поймете, что это не так. Единственное, что работать мы будем не с одним буфером, а с восьмью, для удобства воспроизведения звука. В один записываем, воспроизводим, очищаем, готовим, записываем и т.д. по очереди каждый из восьми. Так же будет рассмотрена работа с флагами (dwflags) и приема потока данных (TMemoryStream) на сервер. Приступим, нетерпеливые мои!
Как обычно, создадим новый проект и вынесем на форму компонент TMemo (name=memo1) (опять же-таки я использовал его в целях определения получения потока данных, перегоняя его в шестнадцатиричный формат), кнопку TButton и IdUDPServerSocket (см. рисунок 2):
Пожалуй, начнем с простого. Напишем ниже приведенный код в обработчике события OnClose() формы:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// завершаем действия
Action:= caFree;
// выключаем сервер
IdUDPServer1.Active:= False
end;
Далее займемся обработчиком события OnClick() кнопки TButton1 (см. код):
procedure TForm1.Button1Click(Sender: TObject);
begin
If button1.Caption='Включить сервер' then Begin
// активируем сокет сервера
IdUDPServer1.Active:= true;
button1.Caption:='Выключить сервер'
end else begin
// деактивируем сокет сервера
IdUDPServer1.Active:= false;
button1.Caption:= 'Включить сервер'
end
end;
Теперь напишем процедуру, которую мы будем использовать для воспроизведения принятого звука:
procedure TForm1.playsound(s:Tstream); // получаемый поток
Var // переменная типа сообщения
msg:Tmessage;
begin
// пока а не равно нашему количеству буферов выполняем следующее
While a<>CWaveBufferCount do Begin
// проверку пользовательской установки на то, что буфер готов к записи
If FHeaders[a].dwUser=0 then begin
// записываем в буфер данные из потока, пришедшего от клиента
s.Read(Fheaders[a].lpdata^,bufsize);
// процедура waveOutPrepareHeader аналогична процедуре waveInPrepareHeader
waveOutPrepareHeader(WaveOut,@FHeaders[a],sizeof(FHeaders));
// Процедура waveOutWrite аналогична процедуре waveInAddBuffer, только она
// осуществляет воспроизведение данных из буфера
waveOutWrite(WaveOut,@FHeaders[a],sizeof(FHeaders));
memo1.Lines.Add('...Двоичный код потока...');
// обнуляем флаги буфера/ов в цикле
FHeaders[a].dwFlags:= 0;
// уже знакомая нам структура
With FHeaders[a] do begin
dwBufferLength:= bufsize;
dwBytesRecorded:= 0;
dwUser := 0;
dwLoops:= 1;
// А вот здесь мы присваиваем флагу только что воспроизведенного буфера
// значение, которое отвечает за то что буфер установлен в очередь, т.е. мы как бы
// циклично используем эти 8 буферов
dwFlags:= WHDR_INQUEUE
end;
// Увеличиваем индекс, чтобы перейти к следующему буферу
inc(a);
// соответственно после воспроизведения и подготовки нам больше не нужен цикл и
// мы выходим из него
exit;
end
end
end;
Процедура разобрана, осталось ей воспользоваться… Как это осуществить? Все просто, достаточно в обработчике события OnUDPRead() idUDPServerSocket-a написать следующий код:
procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
Begin
// если мы воспроизвели последний буфер то, начинаем всё сначала (с первого)
If a = CWaveBufferCount then
a:= 0;
//вызываем нашу процедуру, в скобках пишем наш поток, пришедший на сервер,
//смотрите процедуру сокета.
playsound(Adata);
// определяем сколько байт мы приняли
Bytes:=Bytes + aData.Size;
// показываем это в названии формы
Caption:= 'Принятых байт' + Format('%u', [Bytes]);
// обновляем форму
UpDate
end;
И не забыть при создании формы проинициализировать наши аудиоустройства. Для этого в обработчике OnCreate() формы запишем:
procedure TForm1.FormCreate(Sender: TObject);
begin
bytes:= 0;
WaveOut:= 0;
With WaveFormatOut do begin
nChannels:= 1;
wFormatTag:= WAVE_FORMAT_PCM;
nSamplesPerSec:= 8000;
wBitsPerSample:= 8;
nBlockAlign:= 1;
nAvgBytesPerSec:= 8000;
cbSize:= 0
end;
bufsize:= WaveFormatOut.nAvgBytesPerSec*2 div 16;
For a:= 0 to CWaveBufferCount-1 do
With FHeaders[a] do begin
dwFlags:= WHDR_INQUEUE;
dwBufferLength:= bufsize;
dwBytesRecorded:= 0;
dwUser:= 0;
dwLoops:= 1;
GetMem(Fheaders[a].lpData, bufsize);
end;
IdUDPServer1.BufferSize:= bufsize;
IdUDPServer1.DefaultPort:= 10090;
waveOutOpen(@WaveOut, WAVE_MAPPER, @WaveFormatOut, self.Handle, 0, CALLBACK_WINDOW);
end;
Уважаемые читатели, здесь я пишу без комментариев только для того, что дать вам возможность самим додуматься, что здесь к чему, это не так сложно, тем более, что вы это уже все знаете (мы с вами выше подробно разбирали эти аналогичные функции ввода и вывода и работы с сокетами).
Далее осталось описать переменные и константы:
Const
CwaveBufferCount = 8;
type
TForm1 = class(TForm)
IdUDPServer1: TIdUDPServer;
Button1: TButton;
Memo1: TMemo;
procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure playsound(s:Tstream);
private
hdr: PwaveHdr;
{ Private declarations }
public
{ Public declarations }
WaveOut:HWAVEOUT;
WaveHdrOut,WaveHdrOut2:TWaveHdr;
WaveFormatOut:tWAVEFORMATEX;
bufsize:word;
FBuffer:Pointer;
FSndBuffer:Pointer;
FHeaders:array[0..CWaveBufferCount-1] of TWAVEHDR;
FBufSize:Cardinal;
end;
var
Form1: TForm1;
bytes:Cardinal;
WaveOut: HWAVEOUT;
WaveHdrOut,WaveHdrOut2: TWaveHdr;
WaveFormatOut: tWAVEFORMATEX;
bufsize:word;
a:integer;
Я не стал описывать процедуру перегонки потока в HEX-формат, так как писал ради передачи данных в TMемо. В конце концов, вы сами запросто можете убрать ненужные строки, относящиеся к ней.
Заключение
Хочу заметить, что размеры буферов сокетов на сервере и клиенте должны быть равны размерам буферов структуры TWaveHdr, иначе вы не получите никаких звуков на выходе, кроме шипения с прерываниями, равными по длительности размеру вашего воспроизводимого буфера. Также для более быстрой реакции на события приема звука используйте меньшие размеры буферов, но и соответственно увеличьте их количество (8-ми вполне хватит). При желании, лучше использовать динамический.
Статья была написана специально для форума Клуба ПРОграммистов www.programmersforum.ru. Исходники тестового проекта (клиента и сервера) прилагаются в виде ресурсов в теме «Журнал клуба программистов. Третий выпуск» или непосредственно в архиве с журналом [5].
Выражаю огромную благодарность человеку, чей ник на вышеуказанном форуме raxp, который активно помогал мне в изучении этого материала кодами и советами.
Ресурсы
. Азбука WIN API http://letitbit.net/download/1868.1502ee9dae8ee96cec9816babb/Azbuka_WIN_API.rar.html
. Описание звуковых функций http://www.delphikingdom.com/asp/viewitem.asp?catalogid=213
. Репозитарий Indy 9: https://svn.atozed.com:444/svn/Indy9 (имя пользователя: Indy-Public-RO)
. Репозитарий Indy 10: https://svn.atozed.com:444/svn/Indy10 (имя пользователя: Indy-Public-RO)
. Модули и проекты, использованные в статье http://programmersclub.ru/pro/pro3.zip
. Обсуждение на форуме разработки прототипа VoIP телефона
http://www.programmersforum.ru/showthread.php?t=91506
Это статья из третьего номера журнала “ПРОграммист”.
Скачать его можно по ссылке.
Ознакомиться со всеми номерами журнала.
Обсудить на форуме — Передача звука по сети. Прототип VoIP телефона
7th
Май
Авторизация “В контакте”
procedure TForm1.Button1Click(Sender: TObject);
var data:tstringlist;
PageProfile, pic:string;
error:boolean;
beginpos, endpos : Integer;
ms: TMemoryStream;
jpeg: TJpegImage;
begin
IdHTTP1.AllowCookies:=true;
IdHTTP1.HandleRedirects:=false;
data:=tstringlist.create;
data.Add('email=ЛОГИН'); // логин для авторизации
data.Add('pass=ПАРОЛЬ'); // пароль для авторизации
data.Add('expire=');
data.Add('vk=');
error:=false;
try
PageProfile:=IdHTTP1.Post('http://login.vk.com/?act=login', data);
except
error:=true;
end;
if not(error) then
begin
data.Clear;
data.Add('s='+Copy(PageProfile, Pos('value', PageProfile)+7, 56));
data.Add('op=slogin');
data.Add('redirect=1');
data.Add('expire=0');
data.Add('to=');
IdHTTP1.HandleRedirects:=true;
try
PageProfile:=IdHTTP1.Post('http://vkontakte.ru/login.php', data);
except
end;
beginpos := Pos('center', PageProfile);
endpos := PosEx('/>', PageProfile, beginpos + 21);
pic := Copy(PageProfile, beginpos + 21, endpos - (beginpos + 21));
Memo1.Lines.Add(pic);
ms := TMemoryStream.Create;
jpeg := TJpegImage.Create;
try
IdHTTP1.Get(pic, ms);
ms.Position := 0;
jpeg.LoadFromStream(ms);
Image1.Picture.Graphic := jpeg;
finally
jpeg.Free; ms.Free;
end;
end
else
Memo1.Lines.Add('Авторизация не удалась');
Data.Free;
end;
3rd
Май
Пример авторизации на WordPress
Пример авторизации на WordPress и получения результата авторизации (поиск “action=logout” на странице, вместо “action=logout” может быть любое слово/ссылка для проверки):
var
post:TStringList;
result:string;
begin
post:=TStringList.Create;
try
// Параметры
post.Add(’log=admin’);
post.Add(’pwd=123456′);
post.Add(’rememberme=forever’);
post.Add(’wp-submit=Войти’);
post.Add(’redirect_to=http://site.net/wp-admin/’);
post.Add(’testcookie=1′);
// Отправляем данные
result:=IdHTTP1.Post(’http://site.net/wp-login.php’, post);
// Результат (поиск “action=logout” на странице после авторизации)
if Pos(’action=logout’, result)>0 then
MessageDlg(’Авторизация прошла успешно!(искомый текст на странице найден)’, mtInformation, [mbOK],0)
else
MessageDlg(’Авторизация Провалилась!(искомый текст не найден)’, mtInformation, [mbOK],0);
except
post.Free;
end;
28th
Авг
Создание почтового клиента в Delphi 7
В этой статье я поэтапно объясню, как создать почтовик средствами Delphi: подключение к почтовому серверу, получение и обработка почты, завершение соединения.
26th
Авг
Indy in Depth, глубины Indy
Перевод на русский язык Анатолий Подгорецкий, 2006 год
У посетителей “Клуба программистов” частенько возникают вопросы о том, как сделать почтовый клиент, или же ftp клиент. В ru нете достаточно мало материала по данной тематике, но даже если есть информация, то обычно она уже устаревшая. Анатолий Подгорецкий, автор этой книги, руководствуясь тем, что информации на русском языке совсем мало сделал перевод книги Chad Z. Hower (Kudzu).
Облако меток
css реестр ассемблер timer SaveToFile ShellExecute программы массив советы word MySQL SQL ListView pos random компоненты дата LoadFromFile form база данных сеть html php RichEdit indy строки Win Api tstringlist Image мысли макросы Edit ListBox office C/C++ memo графика StringGrid canvas поиск файл Pascal форма Файлы интернет Microsoft Office Excel excel winapi журнал ПРОграммист DelphiКупить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)