Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как пищать динамиком? [D7, XP]

Alex_C © (2006-12-01 11:21:00)
Возникла надобность пишать динамиком. Нашел в инете про это (кстати мало очень). Вот полный код моей программы:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

type
NTSTATUS=Integer;
DWORD=Cardinal;
LARGE_INTEGER = Windows.LARGE_INTEGER;
PLARGE_INTEGER = ^LARGE_INTEGER;

_IO_STATUS_BLOCK=packed
record
Status: NTSTATUS;
Information: DWORD;
end;
IO_STATUS_BLOCK=_IO_STATUS_BLOCK;
PIO_STATUS_BLOCK=^IO_STATUS_BLOCK;

_UNICODE_STRING=packed record
Length: WORD;
MaximumLength: WORD;
Buffer: PWChar;
end;
UNICODE_STRING=_UNICODE_STRING;
PUNICODE_STRING=^UNICODE_STRING;

_OBJECT_ATTRIBUTES=packed record
Len: DWORD;
RootDirectory: THandle;
ObjectName: PUNICODE_STRING;
Attributes: DWORD;
SecurityDescriptor: Pointer;
SecurityQualityOfService: Pointer;
end;
OBJECT_ATTRIBUTES=_OBJECT_ATTRIBUTES;
POBJECT_ATTRIBUTES=^OBJECT_ATTRIBUTES;

PIO_APC_ROUTINE = Procedure(
ApcContext: Pointer;
IoStatusBlock: PIO_STATUS_BLOCK;
Reserved: ULONG
); StdCall;

TNtObjectAttributes = packed record
Length : ULONG;
RootDirectory : THandle;
ObjectName : PUNICODE_STRING;
Attributes : ULONG;
SecurityDescriptor : Pointer;
SecurityQualityOfService : Pointer;
end;

PNtObjectAttributes = ^TNtObjectAttributes;

const
FILE_READ_DATA = ( $0001 ); // file & pipe
FILE_WRITE_DATA = ( $0002 ); // file & pipe
FILE_OPEN_IF = ( $0003 );

var
BeepDevice:THandle;

procedure RtlInitUnicodeString(
var DestinationString: UNICODE_STRING;
const SourceString: PWideChar
); stdcall; external 'NTDLL.DLL' name 'RtlInitUnicodeString';

procedure InitializeObjectAttributes(InitializedAttributes : PNtObjectAttributes;
pObjectName : PUNICODE_STRING;
const uAttributes : ULONG;
const hRootDirectory : THandle;
pSecurityDescriptor : PSECURITY_DESCRIPTOR);
begin
with InitializedAttributes^ do
begin
Length := SizeOf(TNtObjectAttributes);
ObjectName := pObjectName;
Attributes := uAttributes;
RootDirectory := hRootDirectory;
SecurityDescriptor := pSecurityDescriptor;
SecurityQualityOfService := nil;
end;
end;

function NtCreateFile(FileHandle: PHANDLE; DesiredAccess: ACCESS_MASK;
ObjectAttributes: POBJECT_ATTRIBUTES;
IoStatusBlock: PIO_STATUS_BLOCK; AllocationSize: PLARGE_INTEGER;
FileAttributes: ULONG; ShareAccess: ULONG;
CreateDisposition: ULONG; CreateOptions: ULONG; EaBuffer: Pointer;
EaLength: ULONG): NTSTATUS; stdcall; external 'NTDLL.DLL' name 'NtCreateFile';

function NT_SUCCESS(Status:NTSTATUS):boolean;
begin
result:=Status >= 0
end;

function NtDeviceIoControlFile(
FileHandle, Event: THANDLE;
ApcRoutine: PIO_APC_ROUTINE;
ApcContext: Pointer;
var loStatusBlock: PIO_STATUS_BLOCK ;
loControlCode: Cardinal;
InputBuffer: Pointer;
InputBufferLength: Cardinal
):NTSTATUS; stdcall; external 'NTDLL.DLL' name 'NtDeviceIoControlFile';

procedure NTBeep(Frequency:Word);
var
BeepDeviceName:UNICODE_STRING;
ObjectAttributes:OBJECT_ATTRIBUTES;
IoStatusBlock:PIO_STATUS_BLOCK;
Status:NTSTATUS;
BeepSetParameters:packed record
Frequency,Duration:DWORD;
end;
begin
if BeepDevice=0 then
begin
RtlInitUnicodeString(BeepDeviceName,'\Device\Beep');
InitializeObjectAttributes(@ObjectAttributes,@BeepDeviceName,0,0,nil);
Status:=NtCreateFile(@BeepDevice,FILE_READ_DATA or FILE_WRITE_DATA,
@ObjectAttributes,@IoStatusBlock,nil,0,
FILE_SHARE_READ or FILE_SHARE_WRITE,FILE_OPEN_IF,0,nil,0);
if not NT_SUCCESS(Status) then
begin
BeepDevice:=0;
Exit;
end;
end;
BeepSetParameters.Frequency:=Frequency;
BeepSetParameters.Duration:=DWORD(-1);
NtDeviceIoControlFile(BeepDevice,0,nil,nil,IoStatusBlock,65536,@BeepSetParameter s,SizeOf(BeepSetParameters));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
NTBeep(1000);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
NTBeep(0);
end;

end.

При запуске выдает ошибку
Access violation...

Может кто поможет разобраться?

Anatoly Podgoretsky (2006-12-01 15:41:00) [1]
> Alex_C (01.12.2006 13:17:09) [9]

а что-то типа азбуки морзе (т.е. для каждой ошибки свой сигнал пищать).

While
Beep 1
Pause 1
Beep 3
Pause 1
Beep 1
Pause 3
end

clickmaker (2006-12-01 15:08:00) [2]
Кстати, если предположить, что ребята из МС не любят делать лишнюю работу, то Windows.Beep внутри тоже вызывает NtDevice... поэтому я бы попробовал такой код
StartBeep(Freq)
begin
Windows.Beep(Freq, INFINITE);
end;

EndBeep
beign
Windows.Beep(0, 0);
end;

Elen (2006-12-01 14:57:00) [3]

> Alex_C

А все таки чем windows.beep не устраивает?

novill (2006-12-01 14:56:00) [4]
> [13] Игорь Шевченко © (01.12.06 14:49)
> Если ты увидишь на клетке слона надпись "Буйвол", не верь
> глазам своим.

Я не знаю, что в том ящике, внутрь не заглядывал :)

Игорь Шевченко (2006-12-01 14:49:00) [5]
novill © (01.12.06 12:06) [7]

Если ты увидишь на клетке слона надпись "Буйвол", не верь глазам своим.

Игорь Шевченко (2006-12-01 14:49:00) [6]

> function NtDeviceIoControlFile(
> FileHandle, Event: THANDLE;
>
> ApcRoutine: PIO_APC_ROUTINE;
>
> ApcContext: Pointer;
> var loStatusBlock: PIO_STATUS_BLOCK
> ;
> loControlCode: Cardinal;
> InputBuffer: Pointer;
> InputBufferLength: Cardinal
> ):NTSTATUS; stdcall; external
> 'NTDLL.DLL' name 'NtDeviceIoControlFile';

> NtDeviceIoControlFile(BeepDevice,0,nil,nil,IoStatusBlock,
> 65536,@BeepSetParameter s,SizeOf(BeepSetParameters));

Это явно ерунда.

Скорее, должно быть

function NtDeviceIoControlFile (hFile, hEvent: THANDLE;
IoApcRoutine: Pointer; IoApcContext: PVOID; IoStatusBlock: PIOSTATUSBLOCK;
DeviceIoControlCode: ULONG; InBuffer: PVOID; InBufferLength: ULONG;
OutBuffer: PVOID; OutBufferLength: ULONG): NTSTATUS; stdcall;external
'NTDLL.DLL' name 'NtDeviceIoControlFile';

и, соответственно,

NtDeviceIoControlFile(BeepDevice,0,nil,nil,IoStatusBlock,
65536,@BeepSetParameterы,SizeOf(BeepSetParameters), nil, 0);

clickmaker (2006-12-01 13:34:00) [7]

> Ошибка происходит при выходе из процедуры NTBeep (т.е. как
> на End попадаешь и нажимаешь F7)

Подозреваю, что память под параметры NtDeviceIoControlFile должна выделяться в куче, а не в стеке. Поскольку асинхронная функция

novill (2006-12-01 13:31:00) [8]
не подскажу, не разбирался, просто мсдн почитал. Посмотри, там вроде доступное описание.

Alex_C (2006-12-01 13:17:00) [9]
То Elen: для проигрывания вавки динамики нужны, а там просто контрольный комп стоит, даже без монитора. Вот писк и нужен.

То clickmaker: да, этот код абстрактно работает, но при BeepOff -> TBeepThread.Terminate происходит задержка, т.е. не сразу писк отключается. А хочется еще не просто писк, а что-то типа азбуки морзе (т.е. для каждой ошибки свой сигнал пищать).

То Сергей М.: в том то и дело - пошагово прохожу - ошибки нет, мало того, все структуры заполнятся. Ошибка происходит при выходе из процедуры NTBeep (т.е. как на End попадаешь и нажимаешь F7)

То novill: Если не влом, не подскажешь как заменить у меня NtDeviceIoControlFile на DeviceIoControl? Список параметров у них разный.

Elen (2006-12-01 12:41:00) [10]

> Alex_C

Извини что вмешиваюс. А не лучше какую нить Wav-ку проигрываать? Ато писчалЪЪЪка раздражает жутко.

novill (2006-12-01 12:06:00) [11]
М-м-м, а такую штуку ты читал?
NtDeviceIoControlFile
Deprecated. Builds descriptors for the supplied buffer(s) and passes the untyped data to the device driver associated with the file handle. NtDeviceIoControlFileis superseded by DeviceIoControl.

ms-help://MS.MSDNQTR.2004JUL.1033/winui/winui/windowsuserinterface/lowlevelclientsupport/misclowlevelclientsupport.htm

clickmaker (2006-12-01 12:05:00) [12]
TBeepThread.Execute
begin
while not Terminated
Beep(1000, 1000);
end;
end;

BeepOn -> TBeepThread.Create
BeepOff -> TBeepThread.Terminate

Ну а если хочется именно с тонной кода, то отладчик в руки

Сергей М. (2006-12-01 12:02:00) [13]

> нужно не просто пищать, а включить - выключить

Ну и почему на этомнельзя было не заострить внимание в первом же своем вопросе ?

Код свой трассировал пошагово ?
Какая строка вызывает AV ?

Alex_C (2006-12-01 11:57:00) [14]
:) Ребят, ну я все же не до такой степени тупой!
Мне нужно не просто пищать, а включить - выключить (без указания времени писка).
Т.е.

// Возникла ошибка
BeepOn( 1000 );
// Тут что-то происходит
...
// Ошибка пропала
BeepOff;

Вот как это сделать на С
http://www.delphimaster.ru/articles/ntbeep/index.html
Но мне надо на дельфи.

novill (2006-12-01 11:28:00) [15]
> . Нашел в инете про это (кстати мало очень).

вам на delphiworld надо там штук пять примеров.
А вообще
function Beep(dwFreq, dwDuration: DWORD): BOOL; stdcall;
вам в руки!
Модуль Windows

Рамиль (2006-12-01 11:25:00) [16]
Мм...
А просто Windows.Beep() не подходит?

Сергей М. (2006-12-01 11:24:00) [17]
Ну ты и нахреновертил)

Ларчик-то просто открывается:

Windows.Beep(частота, длительность)

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »