Оформил: DeeCo

program playwavp; {воспроизведение 8-битного звука}
{в защищенном режиме процессора}
{$D+,L+,I+,R+,S+,V+}
uses dos, winapi;
const
  BlasterPort: word = $220; {номер порта Sound Blaster}
  BlasterIRQ: word = 5; {номер прерывания Sound Blaster}
  BlasterDMAl: word = 1; {номер канала DMA Sound Blaster}
  maxlen = 35000; {длина звукового буфера}
  {   Seg0040 = $40;}
  SouBlas: Boolean = False; {было ли прерывание от SB }

function clock: longint; {функция определения времени}
begin
  clock := MemL[Seg0040: $6C];
end;

var
  ExitSave: Pointer; {адрес старой программы выхода в DOS}
  SBold: pointer; {адрес обработчика прерывания Sound Blaster'a}
  SBIRQ: byte; { номер прерывания Sound Blaster'a }

{$F+}

procedure SBint;
interrupt; { обработчик прерывания SB }
begin
  SouBlas := True;
  Port[$20] := $20;
end;

procedure MyExit; {дополнительная процедура при выходе в DOS}
begin
  ExitProc := ExitSave;
  SetIntVec(SBIRQ + 8, SBold);
end;
{$F-}

procedure IntInit(sbi: byte); {установка нового вектора} {прерывания и т.д.}
begin { sbi - номер аппаратного прерывания SB }
  if sbi < 8 then
    SBIRQ := sbi
  else
    SBIRQ := 2;
  GetIntVec(SBIRQ + 8, SBold);
  SetIntVec(SBIRQ + 8, @SBint); {переопределение} {прерывания SB}
  ExitSave := ExitProc; {переопределение} {процедуры выхода}
  ExitProc := @MyExit;
end;

procedure WriteCommand(Comm: byte); { процедура записи} {команды в регистр SB }
begin
  while (Port[BlasterPort + $0C] and $80) <> 0 do
    ;
  Port[BlasterPort + $0C] := Comm;
end;

procedure NotSupport; { вывод на экран сообщения }
begin
  writeln('Format not supported');
  halt;
end;

var
  longi: longint; {рабочая ячейка}
  arr1: pointer; {для выравнивающего массива}
  pusto: word; {длина выравнивающего массива}
  sndp: pointer; {для массива звуковых отсчетов}
  DMAPage: byte; {номер 64K сегмента для записи} {в регистр DMA)
  DMAOfs :word;     {смещение звуковой последовательности}{в нижней памяти}

procedure GetSBMem; {выделение буфера } {нижней памяти для SB/DMA}
begin
  longi := GlobalDosAlloc(16);
  arr1 := ptr(longi and $0FFFF, 0); {селектор нижней памяти}
  longi := $FFFF - (((longi shr 16) shl 4) and $FFFF) + 1;
  pusto := longi; {столько осталось до начала} {следующего 64k сегмента}
  GlobalDosFree(seg(arr1^));
  longi := GlobalDosAlloc(pusto);
  arr1 := ptr(longi and $0FFFF, 0); {селектор нижней} {памяти (выравн.масс.)}
  longi := GlobalDosAlloc(maxlen);
  sndp := ptr(longi and $0FFFF, 0); {селектор нижней} {памяти (для звука)}
  DMAPage := longi shr 28;
  DMAofs := 0;
end;

procedure FreeSBMem; {возвращение нижней памяти в систему}
begin
  GlobalDosFree(seg(sndp^));
  GlobalDosFree(seg(arr1^));
end;

const
  dmap: array[0..3] of byte = ($87, $83, $81, $82); {номера} {регистров DMA}
var
  i: word; {рабочая ячейка}
  t, friq: word; {временной параметр/частота дискретизации}
  lenfil: word; {длина считываемой части звуковых данных}
  snd: file; {звуковой файл}
  riff: array[0..15] of char; {массив для чтения} {неиспольз. частей заголовка}

begin {the main program}
  if paramcount <> 1 then
  begin
    writeln;
    writeln("Usage: playwave filename.wav");
    writeln;
    halt;
  end;
  IntInit(BlasterIRQ); { переустанавливаем прерывания }
  Assign(snd, paramstr(1));
  Reset(snd, 1);
  BlockRead(snd, riff, 16); { $00}
  BlockRead(snd, longi, 4); { $10 длина заголовка}
  BlockRead(snd, i, 2); { $14}
  BlockRead(snd, i, 2); { $16 число каналов}
  if i <> 1 then
    notsupport;
  BlockRead(snd, friq, 2); { $18 частота дискретизации}
  Seek(snd, longi + $12); { $1A пропускаем заголовок} {до предпосл.слова}
  BlockRead(snd, i, 2); {     разрядность}
  if i <> 8 then
    notsupport;
  GetSBMem; {запрашиваем нижнюю память для звука}
  BlockRead(snd, longi, 4); {  'data'}
  BlockRead(snd, longi, 4); { длина данных}
  if longi > maxlen then
    lenfil := maxlen
  else
    lenfil := longi;
  BlockRead(snd, sndp^, lenfil); {звуковые данные}
  close(snd);
  WriteCommand($D3); {включаем звук}
  t := 256 - 1000000 div friq;
  WriteCommand($40); {задаем частоту дискретизации}
  WriteCommand(t);
  Port[$21] := Port[$21] and not (1 shl BlasterIRQ); {разрешаем прерывание}
  Port[$A] := BlasterDMAl + 4; {маскируем DMA }
  Port[$C] := 0; {сбрасываем триггер}
  Port[$B] := BlasterDMAl + $48; {задаем режим передачи }
  Port[$2] := lo(DMAOfs); {задаем адрес буфера}
  Port[$2] := hi(DMAOfs);
  Port[dmap[BlasterDMAl]] := DMAPage; {задаем 64k страницу}
  Port[BlasterDMAl * 2 + 1] := lo(lenfil - 1); {длина звуковой}
    {последовательности}
  Port[BlasterDMAl * 2 + 1] := hi(lenfil - 1);
  Port[$A] := BlasterDMAl; {размаскируем DMA }
  WriteCommand($14); {начинаем воспроизведение звука}
  WriteCommand(lo(lenfil - 1));
  WriteCommand(hi(lenfil - 1));
  longi := clock; {на всякий случай ограничим по времени}
  while (SouBlas = false) and (longi + 50 > clock) do
    ;
  if not SouBlas then
    Port[$20] := $20; {сбрасываем DMA }
  i := Port[BlasterPort + $0E]; {сбрасываем Sound Blaster}
  WriteCommand($D1); {выключаем звук}
  Port[$21] := Port[$21] or (1 shl BlasterIRQ); {запрещаем прерывание}
  FreeSBMem; {возвращаем память в систему}
end.

var
  m1, m2, m3: word; { флаги процедур выделения памяти: }
    { 4 - успешно, 5 - ошибка, 2 - не выделялась }

procedure GetSBMem; {выделение буфера нижней памяти} {для SB/DMA}
var
  j: word;
begin
  j := (longint(maxlen) + 15) div 16; {длина блока} {в параграфах}
  m1 := 2;
  m2 := 2;
  m3 := 2;
  asm
      mov ax,$0100
      mov bx,j
      int $31      {запрашиваем память}
      rcl m1,1     {запоминаем CF}


      mov bx,$1000
      mov cx,ax
      and cx,$fff
      sub bx,bc      {вычисляем размер до конца сегмента}
      cmp j,bx
      jb @l1       {если достаточно места, уходим}

      push bx
      mov ax,$0101
      int $31      {возвращаем память}

      pop bx
      mov ax,$0100
      int $31      {забираем память до конца 64k-сегмента}
      rcl m2,1     {запоминаем CF}
      mov word ptr [arr1+2],dx  {сохраняем селектор}

      mov ax,$0100
      mov bx,j
      int $31    {запрашиваем память для звукового буфера}
      rcl m3,1   {запоминаем CF}
     mov bx,ax
      mov ax,0
      adc ax,ax
      mov m3,ax   {запоминаем CF}
 @l1:
      mov word ptr [sndp+2],dx    {сохраняем селектор}
      xor dx,dx
      mov word ptr [sndp],dx      {сохраняем смещение}
      mov ax,bx
      shl ax,4
      mov DMAOfs,ax
      shr bx,12
      mov DMAPage,bl
  end;
  if ((m1 and 1) or (m2 and 1) or (m3 and 1)) <> 0 then
    halt;
end;

procedure FreeSBMem; {возвращение нижней памяти в систему}
begin
  asm
      mov ax,$0101
      mov dx,word ptr[sndp+2]
      int $31
  end;
  if m2 = 4 then
    asm
      mov ax,$0101
      mov dx,word ptr[arr1+2]
      int $31
    end;
end;