Const HappyBirthDay: Array [1..30] of TFullNote =
     ( (N: Mi1;  D: 2), (N: Mi1;  D: 2), (N: FaD1; D: 1),
(N: Mi1;  D: 1), (N: La1;  D: 1), (N: SolD1;D: 0.5), (N: Pause; D: 2),
(N: Mi1;  D: 2), (N: Mi1;  D: 2), (N: FaD1; D: 1),
(N: Mi1;  D: 1), (N: Si1;  D: 1), (N: La1;  D: 0.5), (N: Pause; D: 2),
(N: Mi1;  D: 2), (N: Mi1;  D: 2), (N: DoD2; D: 1),
(N: La1;  D: 1),
(N: SolD1;D: 2), (N: La1;  D: 2), (N: SolD1;D: 1),
(N: FaD1; D: 1),          (N: Pause; D: 2),
(N: Re2;  D: 2), (N: Re2;  D: 2), (N: DoD2; D: 1),
(N: La1;  D: 1), (N: DoD2; D: 1), (N: Si1;  D: 0.5), (N: Pause; D: 8) );

Unit Music;
{--------------------------}Interface
Procedure Sound (Hz: Word);
Procedure NoSound;

Var Duration: Word;
{Type  TNote=(Pause,
C1,  Cs1,  D1,  Ds1,  E1,  F1,  Fs1,  G1,  Gs1,  A1,  As1,  B1,
C2,  Cs2,  D2,  Ds2,  E2,  F2,  Fs2,  G2,  Gs2,  A2,  As2,  B2);}
Type  TNote=(Pause,
Do1, DoD1, Re1, ReD1, Mi1, Fa1, FaD1, Sol1,SolD1,La1, LaD1, Si1,
Do2, DoD2, Re2, ReD2, Mi2, Fa2, FaD2, Sol2,SolD2,La2, LaD2, Si2);
     {перечисление нот
*1, *2 - первая, вторая октавы
??D? (?s?) - диез (sharp)}
     TDuration = Single;
     TFullNote = Record
     N: TNote;     {Нота}
     D: TDuration  {Длительность}
   End;

{Пример вся 1ая октава + До второй}
{Const Melody0: Array [1..8] of TFullNote =
    ( (N: Do1; D: 1), (N: Re1; D: 1), (N: Mi1; D: 1), (N: Fa1; D: 1),
      (N: Sol1;D: 1), (N: La1; D: 1), (N: Si1; D: 1), (N: Do2; D: 1) );}

Procedure PlayNote (FullNote: TFullNote);
Procedure Play (Melody: Array of TFullNote);

{--------------------------}Implementation
Function Stp (L: Double; R: ShortInt): Double;
 Var i: Byte;
     Pr: Double;
 Begin
   Pr:=1;
   For i:=1 to Abs(R) do Pr:=Pr*L;
   If R<0 Then Stp:=1/Pr
   Else Stp:=Pr
 End;

Var Base, Trans: Double;

Procedure Sound (Hz: Word); Assembler;
 Asm
MOV BX,SP
MOV BX,SS:[BX+4]
MOV AX,34DDH
MOV DX,0012H
CMP DX,BX
JNC @@2
DIV BX
MOV BX,AX
IN AL,61H
TEST AL,3
JNZ @@1
OR AL,3
OUT 61H,AL
MOV AL,0B6H
OUT 43H,AL
@@1: MOV AL,BL
OUT 42H,AL
MOV AL,BH
OUT 42H,AL
@@2: RETF 2
 End;

Procedure NoSound; Assembler;
 Asm
IN AL,61H
AND AL,0FCH
OUT 61H,AL
RETF
 End;

Procedure PlayNote (FullNote: TFullNote);
 Begin
   With FullNote do
   Begin
     If N=Pause
     Then NoSound
     Else Sound( Round( Base * Stp(Trans, Ord(N)) ) );
     Delay( Duration / D )
   End
 End;

Procedure Play (Melody: Array of TFullNote);
 Var i: Word;
 Begin
   For i:=Low(Melody) to High(Melody) do
     PlayNote(Melody[i]);
   NoSound
 End;

Begin
 Trans:=Exp(Ln(2)/12);
 Base:=440*Stp(Trans, -10);
 Duration:= 400;
End.

program tst;

uses crt;

var
f : file;
b : array [1..64500] of byte;
i : word;
i1: word;
t : byte;
b1: byte;
covox: word;
c : string[2];
spd : word;

begin
if paramcount = 0 then
 begin
 writeln('Test program for *.WAV (Windows)  files.');
 writeln;
 writeln('Usage:');
 writeln(' TST <filename> [C#]');
 writeln;
 writeln(' <filename> - .WAV File Name,');
 writeln(' C#         - Covox port number.');
 writeln;
 writeln('If C# parameter is not specified Internal PC Speaker will be use.');
 halt;
 end;
if (paramcount > 1) and ((copy(paramstr(2),1,1) = 'C') or (copy(paramstr(2),1,1) = 'c')) then
 begin
 c:=copy(paramstr(2),2,1);
 if c[1] in ['1'..'4'] then
   begin
   covox:=memw[0:$408+((byte(c[1]) and $f)-1)*2];
   end
 else
   covox:=0;
 end
else
 covox:=0;
sound(20000); nosound;
t:=port[$61];
assign(f,paramstr(1));
{$I+}
reset(f,1);
blockread(f,b,64500,i);
close(f);
spd:=b[25]+(word(b[26]) shl 8);
spd:=$fffffff div longint(spd);
if covox = 0 then
 begin
 spd:=spd shr 7;
 port[$43]:=0;
 for i1:=44 to i do
   begin
   b1:=b[i1];
   asm
    mov al,b1
    shr al,6
    and al,2
    out 61h,al
    in al,40h
    xchg al,ah
    in al,40h
    xchg al,ah
    mov dx,ax
    @m1:
    xor al,al
    out 43h,al
    in al,40h
    xchg al,ah
    in al,40h
    xchg al,ah
    push dx
    sub dx,ax
    cmp dx,spd
    pop dx
    jb @m1
    end;
   end;
 end
else
 begin
 spd:=spd shr 7;
 port[$43]:=0;
 for i1:=44 to i do
   asm
    lea bx,b
    mov dx,covox
    add bx,i1
    dec bx
    mov al,[bx]
    out dx,al
    in al,40h
    xchg al,ah
    in al,40h
    xchg al,ah
    mov dx,ax
    @m1:
    xor al,al
    out 43h,al
    in al,40h
    xchg al,ah
    in al,40h
    xchg al,ah
    push dx
    sub dx,ax
    cmp dx,spd
    pop dx
    jb @m1
    end;
 end;
port[$61]:=t;
end.

Procedure BadSound;
begin  
 Windows.Beep(100,200);
end;

Procedure GoodSound;
begin  
 WinProcs.Beep(500,200);
end;