Как пищать динамиком?

← →
Alex_C © (2006-12-01 11:21) [0]

Возникла надобность пишать динамиком. Нашел в инете про это (кстати мало очень). Вот полный код моей программы:

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...

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

← →
Сергей М. © (2006-12-01 11:24) [1]

Ну ты и нахреновертил)

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

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

← →
Рамиль © (2006-12-01 11:25) [2]

Мм...
А просто Windows.Beep() не подходит?

← →
novill © (2006-12-01 11:28) [3]

> . Нашел в инете про это (кстати мало очень).

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

← →
Alex_C © (2006-12-01 11:57) [4]

:) Ребят, ну я все же не до такой степени тупой!
Мне нужно не просто пищать, а включить - выключить (без указания времени писка).
Т.е.

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

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

← →
Сергей М. © (2006-12-01 12:02) [5]

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

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

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

← →
clickmaker © (2006-12-01 12:05) [6]

TBeepThread.Execute
begin
while not Terminated
Beep(1000, 1000);
end;
end;

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

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

← →
novill © (2006-12-01 12:06) [7]

М-м-м, а такую штуку ты читал?
NtDeviceIoControlFile
Deprecated. Builds descriptors for the supplied buffer(s) and passes the untyped data to the device driver associated with the file handle. NtDeviceIoControlFile is superseded by DeviceIoControl.

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

← →
Elen © (2006-12-01 12:41) [8]

> Alex_C

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

← →
Alex_C © (2006-12-01 13:17) [9]

То Elen: для проигрывания вавки динамики нужны, а там просто контрольный комп стоит, даже без монитора. Вот писк и нужен.

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

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

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

← →
novill © (2006-12-01 13:31) [10]

не подскажу, не разбирался, просто мсдн почитал. Посмотри, там вроде доступное описание.

← →
clickmaker © (2006-12-01 13:34) [11]

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

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

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

> 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);

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

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

> Alex_C

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

Кстати, если предположить, что ребята из МС не любят делать лишнюю работу, то Windows.Beep внутри тоже вызывает NtDevice... поэтому я бы попробовал такой код
StartBeep(Freq)
begin
Windows.Beep(Freq, INFINITE);
end;

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

> Alex_C (01.12.2006 13:17:09) [9]

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

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

Как пищать динамиком? Найти похожие ветки