Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2016.07.24;
Скачать: CL | DM;

Вниз

Вот интересно   Найти похожие ветки 

 
Dimka Maslov ©   (2015-11-18 10:33) [0]

Почему если программа запущена как приложение, в ней работает функция Beep, но если та же программа работает уже как служба, то никаких звуков функция Beep не издаёт?


 
DVM ©   (2015-11-18 11:07) [1]

Потому что запрещено давно уже.
Через WaveOut можно издать звук теперь только.

Вот давным давно делал. Тут правда длительности нет, но добавить не сложно. Вроде работало.

procedure TPlaySoundThread.PlaySignal(AFreq: Integer);
var
 WaveOut: HWaveOut;
 WaveHdr: TWaveHdr;
 Format: TWaveFormatEx;
 DataSize: integer;

 procedure SetFreq(pos1, pos2, hz: integer);
 var
   pos: integer;
   v: single;
   step: single;
 begin
   v := VOLUME;
   step := -VOLUME / (16000 / hz);
   pos := pos1;
   while pos < pos2 do begin
     PByte(cardinal(waveHdr.lpData) + pos)^ := trunc(v);
     v := v + step;
     if abs(v) > VOLUME then step := -step;
     inc(pos);
   end;
 end;

begin
 DataSize := 16000 * 2;

 with Format do
   begin
     wFormatTag := WAVE_FORMAT_PCM;
     nChannels := 1;
     nSamplesPerSec := 16000;
     wBitsPerSample := 8;
     nBlockAlign := nChannels * wBitsPerSample div 8;
     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
   end;
 with WaveHdr do
 begin
   GetMem(lpData, DataSize);
   dwBufferLength := DataSize;
   dwFlags := 0;
   dwLoops := 0;
 end;
 try
   WaveOutCheck(WaveOutOpen(@WaveOut, WAVE_MAPPER, @Format, 0, 0, 0));
   try
     SetFreq(0, DataSize - 1, AFreq);
     WaveOutCheck(WaveOutPrepareHeader(WaveOut, @WaveHdr, SizeOf(TWaveHdr)));
     try
       WaveOutCheck(WaveOutWrite(WaveOut, @WaveHdr, SizeOf(TWaveHdr)));
       Sleep(DataSize div 16);
     finally
       WaveOutUnprepareHeader(WaveOut, @WaveHdr, SizeOf(TWaveHdr));
       WaveOutReset(WaveOut);
     end;
   finally
     WaveOutClose(WaveOut);
   end;
 finally
   FreeMem(WaveHdr.lpData);
 end;

end;


 
DVM ©   (2015-11-18 11:08) [2]

Дополнение:

procedure WaveOutCheck(result: MMRESULT);
var
 Mess: string;
begin
 Mess := "";
case result of
   MMSYSERR_NOERROR: Exit;
   MMSYSERR_ALLOCATED:
     Mess := "Драйвер уже открыт";
   MMSYSERR_BADDEVICEID:
     Mess := "Неверный идентификатор устройства";
   MMSYSERR_NODRIVER:
     Mess := "Отсутствует драйвер устройства";
   MMSYSERR_NOMEM:
     Mess := "Невозможно распределить или зафиксировать память";
   WAVERR_BADFORMAT:
     Mess := "Неверный формат данных";
   WAVERR_SYNC:
     Mess := "Попытка воспроизведения на синхронном устройстве";
   MMSYSERR_INVALHANDLE:
     Mess := "Неверный ключ устройства";
   WAVERR_UNPREPARED:
     Mess := "Попытка воспроизведения неподготовленного блока данных";
   WAVERR_STILLPLAYING:
     Mess := "Блок данных находится в очереди на воспроизведение";
 end;
 raise Exception.Create(Mess);
end;


 
Rouse_ ©   (2015-11-18 11:13) [3]

Потому что "Функция Beep требует UIPermission SafeTopLevelWindows уровня" ©

Вообще открой в сервисе устройство "\device\beep" и отправь ему команду IOCTL_BEEP_SET.

http://forum.codenet.ru/q33342/
В самом низу.


 
Dimka Maslov ©   (2015-11-18 11:14) [4]

Но разве Beep теперь не инкапсуляция WaveOut? И что же мешает бибикать службе, позволяя бибикать приложению?


 
Dimka Maslov ©   (2015-11-18 11:17) [5]


> Потому что "Функция Beep требует UIPermission SafeTopLevelWindows
> уровня


Но зачем такие сложности?


 
Rouse_ ©   (2015-11-18 11:24) [6]


> Dimka Maslov ©   (18.11.15 11:17) [5]

Ну видимо по каким-то своим соображениям, по аналогии наверное с тем, что не каждое приложение может сказать SetForegroundWindow (плохая аналогия, но какая есть :)


 
Dimka Maslov ©   (2015-11-18 11:54) [7]


> Ну видимо по каким-то своим соображениям,


Всё равно не понятно, как издавание звуков может навредить системе.


 
Rouse_ ©   (2015-11-18 12:16) [8]

Ну может чтоб какафонии небыло, не знаю. У меня только предположения.


 
Dimka Maslov ©   (2015-11-18 12:24) [9]

Но ведь если служба работает под системой, ей позволено многое, что может действительно принести вред. Но бибикание? Что в этом опасного?


 
Юрий Зотов ©   (2015-11-18 12:24) [10]

Это сделано по просьбе Михалкова. В рамках борьбы с воспроизведением пиратского звукового контента.


 
Dimka Maslov ©   (2015-11-18 12:39) [11]


> Юрий Зотов ©   (18.11.15 12:24) [10]


Глубоко. Тогда почему только при работе службы?


 
DVM ©   (2015-11-18 13:13) [12]


> Dimka Maslov ©   (18.11.15 12:39) [11]
>
> > Юрий Зотов ©   (18.11.15 12:24) [10]
>
>
> Глубоко. Тогда почему только при работе службы?

Звуки служба могут быть услышаны разными пользователями, а это уже коллективное прослушивание однако.


 
sniknik ©   (2015-11-18 13:21) [13]

> Но бибикание? Что в этом опасного?
тоже не понимаю, и бывает это реально мешает работать -
http://delphimaster.net/view/15-1437484469/
там кстати все кончилось хорошо, отключение(/слом) виндового "бипа" перестало мешать программе его самой каким то образом воспроизводить... (звонок на спикере)


 
Dimka Maslov ©   (2015-11-18 13:29) [14]


> sniknik ©   (18.11.15 13:21) [13]


Бибикание не работает через колонки, если ф-ция вызывается из службы.


 
sniknik ©   (2015-11-18 14:27) [15]

> Бибикание не работает через колонки
да, я понял еще из первого поста, моя ситуация несколько другая (не служба vs программа для стандартного ныне бипа, а бип через спикер vs колонки/наушники в программе)... но, имхо, тоже нифига не опасная но почему то "запрещенная".


 
Dimka Maslov ©   (2015-11-18 14:43) [16]


> sniknik ©   (18.11.15 14:27) [15]


Да и про принципиальную "однопоточность" пищалки - гонят. Тем более, что во времена DOS пищалка была устройством асинхронным: подал в порт частоту, она пиликала, а программа могла спокойно работать.


 
Inovet ©   (2015-11-19 13:21) [17]

> [9] Dimka Maslov ©   (18.11.15 12:24)
> Но бибикание? Что в этом опасного?

Кому будет бибикать и какой звуковой схемой?



Страницы: 1 вся ветка

Текущий архив: 2016.07.24;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.014 c
15-1441127797
Pavia
2015-09-01 20:16
2016.07.24
Хочу пример таблицы


15-1443532985
Дмитрий Белькевич
2015-09-29 16:23
2016.07.24
Ищу реализацию алгоритма SIFT на Delphi


4-1278405370
tytus
2010-07-06 12:36
2016.07.24
CryptoAPI (Delphi 2010, XP SP3)


2-1414037154
Drowsy
2014-10-23 08:05
2016.07.24
Unit не дебажится.


15-1447406179
ksergey
2015-11-13 12:16
2016.07.24
бесплатная панель от FirstVDS сегодня