Удобный модуль-обёртка для работы с системной пищалкой средствами WinRing0

BeeperWrapper.pas

unit BeeperWrapper;

interface

uses
  WinRing0;

{
  Подробности здесь:
    http://wiki.osdev.org/PIT
    http://wiki.osdev.org/PC_Speaker
}

function InitializeBeeper: LongWord;
function DeinitializeBeeper: Boolean;

procedure SetBeeperOut;
procedure SetBeeperIn;

procedure StartBeeper;
procedure StopBeeper;
procedure SetBeeperRegime;

procedure SetBeeperDivider(Value: Word);
procedure SetBeeperFrequency(Value: Single);

implementation

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

function InitializeBeeper: LongWord;
begin
  InitializeOls;
  Result := GetDLLStatus;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

function DeinitializeBeeper: Boolean;
begin
  Result := DeinitializeOls;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure SetBeeperOut;
var
  Value: Byte;
begin
{
  ; Взводим 1 бит, отвечающий за положение мембраны из порта 61h - подаём напряжение:
  in al, 61h
  or al, 00000010b
  out 61h, al
}
  Value := ReadIoPortByte($61);
  Value := Value or 2;
  WriteIoPortByte($61, Value);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure SetBeeperIn;
var
  Value: Byte;
begin
{
  ; Сбрасываем 1 бит, отвечающий за положение мембраны из порта 61h - снимаем напряжение:
  in al, 61h
  and al, 11111101b
  out 61h, al
}
  Value := ReadIoPortByte($61);
  Value := Value and 253;
  WriteIoPortByte($61, Value);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure StartBeeper;
var
  Value: Byte;
begin
{
  ; Взводим 2 бита, отвечающие за включенность пищалки из порта 61h:
  in al, 61h
  or al, 00000011b
  out 61h, al
}
  Value := ReadIoPortByte($61);
  Value := Value or 3;
  WriteIoPortByte($61, Value);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure StopBeeper;
var
  Value: Byte;
begin
{
  ; Сбрасываем первые два бита в порте 61h, отвечающие за включенность пищалки:
  in al, 61h
  and al, 11111100b
  out 61h, al
}
  Value := ReadIoPortByte($61);
  Value := Value and 252;
  WriteIoPortByte($61, Value);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure SetBeeperRegime;
const
  InitializationValue: Byte = $0B6;
begin
{
  ; Инициализируем пищалку:
  mov al, $0B6h ; 0B6h = 10 11 011 0
          10 = номер канала, которым мы будем управлять (10b = второй канал)
          11 = тип операции (11b = чтение/запись сначала младшего, а потом старшего байта)
         011 = режим работы канала (011b = генератор прямоугольных импульсов (основной режим))
           0 = формат счетчика (0 = 16-разрядное число от 0 до 0FFFFh)
  out 43h, al
}
  WriteIoPortByte($43, InitializationValue);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure SetBeeperDivider(Value: Word);
begin
  WriteIoPortByte($42, Byte(Value)); // Младшая часть
  WriteIoPortByte($42, Byte(Pointer(NativeUInt(@Value) + 1)^)); // Старшая часть
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

procedure SetBeeperFrequency(Value: Single);
begin
  SetBeeperDivider(Word(Round(1193180 / Value)));
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

end.