Los coman dos de sonido de pascal no trabajan en windows 7 tendrás que usar la SoundBlaster
pera generar los sonidos mira esto te puede ayudar a entenderlo
esto es para archivos wav de 8 bits pruevalo}
program musicawav;
uses
crt, dos;
type
regmusica = record
frecu : longint;
tama : longint;
misi : pointer;
end;
cavewave = record
riff : array[0..3] of char;
tama : longint;
wave : array[0..7] of char;
for1 : longint;
for2 : integer;
mono : integer;
frec : longint;
bseg : longint;
bcat : integer;
bmut : integer;
dato : array[0..3] of char;
bmst : longint;
end;
string4 = string[4];
var
tomado, pbase : word;
mimusi : regmusica;
cwave : cavewave;
f : file;
mayor, menor : byte;
nombre : string;
blaster, memtoma : boolean;
memcarga : word;
nombmusi : string[20];
function bytehex(n : byte) : string;
Const
nchars : Array[0..15] of char = '0123456789ABCDEF';
begin
bytehex[0] := #2;
bytehex[1] := nchars[n shr 4];
bytehex[2] := nchars[n and 15];
end;
function wordhexa(n : word) : string;
begin
wordhexa := bytehex(hi(n)) + bytehex(lo(n));
end;
function longinthex(n : longint) : string;
begin
longinthex := wordhexa(n shr 16) + wordhexa(n);
end;
procedure puertobase;
var
datos : string;
bas : string[4];
tb : word;
erro : integer;
begin
datos := getenv('blaster');
if datos[1] in ['a','A'] then
bas := copy(datos,2,5);
for erro := 1 to length(bas) do
if bas[erro] = ' ' then
delete(bas,erro,1);
val('$' + bas,tb,erro);
if erro = 0 then
begin
pbase := tb;
blaster := true;
writeln('Configuracion Sound Blaster = ',datos);
end;
end;
procedure versionsb;
begin
port[pbase + $c] := $e1;
mayor := port[pbase + $a];
menor := port[pbase + $a];
port[pbase + $c] := $D0;
end;
procedure escribe_dsp(d : byte);
begin
while Port[pbase + $c] And $80 <> 0 do;
port[pbase + $c] := d;
end;
function lee_dsp : byte;
begin
while Port[pbase + $c] and $80 = 0 do;
lee_dsp := Port[pbase + $a];
end;
procedure escribe_dac(d : byte);
begin
escribe_dsp($10);
escribe_dsp(d);
end;
function lee_dac : byte;
begin
escribe_dsp($20);
lee_dac := lee_dsp;
end;
function altavoz_encendido : byte;
begin
escribe_dsp($d1);
end;
function altavoz_apagado: byte;
begin
escribe_dsp($d3);
end;
procedure activa_dma;
begin
escribe_dsp($d4);
end;
procedure para_dma;
begin
escribe_dsp($d0);
end;
procedure escribe_en_mixer(ind, v : byte);
begin
port[pbase + 4] := ind;
port[pbase + 5] := v;
end;
function lee_en_mixer(ind : byte) : byte;
begin
port[pbase + 4] := ind;
lee_en_mixer := port[pbase + 5];
end;
procedure activa_misica(soud : Pointer; long : word; frec : longint);
var
tiempo : longint;
pagina, despla : word;
begin
altavoz_encendido;
long := long - 1;
despla := seg(soud^) shl 4 + ofs(soud^);
pagina := (seg(soud^) + ofs(soud^) shr 4) shr 12;
port[$0a] := 5;
port[$0c] := 0;
port[$0b] := $49;
port[$02] := lo(despla);
port[$02] := hi(despla);
port[$83] := pagina;
port[$03] := lo(long);
port[$03] := hi(long);
port[$0a] := 1;
if (cwave.bmut = 8) and (cwave.mono = 1) and (cwave.bcat = 1) then {8 bit}
begin
tiempo := (65536 - (256000000 div (1 * frec))) shr 8;
escribe_dsp($40);
escribe_dsp(tiempo);
escribe_dsp($14);
escribe_dsp(lo(long));
escribe_dsp(hi(long));
end;
end;
procedure presenta_archivos_wav;
var
x, y : integer;
DirInfo: SearchRec;
begin
x := 2;
y := 6;
FindFirst('c:\*.wav', Archive, DirInfo);
while DosError = 0 do
begin
gotoxy(x,y);write(DirInfo.Name);
FindNext(DirInfo);
y := y + 1;
if y > 23 then
begin
x := x + 15;
y := 6;
end;
end;
end;
procedure tomawave(nom : string);
begin
memtoma := false;
assign(f,nom);
{$I-} reset(f,1); {$I+}
if ioresult <> 0 then
begin
clrscr;
writeln(' Error El Archivo No Se Encontro Pulse [Enter]');
readln;
exit;
end
else
begin
seek(f,0);
blockread(f,cwave,sizeof(cavewave),tomado);
if cwave.bmst < 32563 then
begin
getmem(mimusi.misi,cwave.bmst);
blockread(f,mimusi.misi^,cwave.bmst);
memtoma := true;
mimusi.tama := cwave.bmst;
mimusi.frecu := cwave.frec;
memcarga := cwave.bmst;
end
else
begin
getmem(mimusi.misi,32563);
blockread(f,mimusi.misi^,32563);
memtoma := true;
mimusi.tama := 32563;
mimusi.frecu := cwave.frec;
memcarga := 32563;
end;
close(f);
end;
end;
procedure presenta_cabecera_wave;
begin
clrscr;
writeln('****** Cabecera De Archivo Wave *******');
writeln;
writeln(' Identificador Archivo : ',cwave.riff[0], cwave.riff[1],
cwave.riff[2], cwave.riff[3]);
writeln(' Tama¤o Del Archivo : ',cwave.tama);
writeln(' Marcador Wave : ',cwave.wave[0], cwave.wave[1],
cwave.wave[2], cwave.wave[3], cwave.wave[4], cwave.wave[5],
cwave.wave[6], cwave.wave[7]);
writeln(' Tama¤o Cabecera : ',cwave.for1);
writeln(' Etiqueta Formato : ',cwave.for2);
if cwave.mono = 1 then
writeln(' Tipo Reproducion : Mono')
else
writeln(' Tipo Reproducion : Estereo');
writeln(' Frecuencia Muestreo : ',cwave.frec);
writeln(' N§ Medio De Bytes/Sg : ',cwave.bseg);
writeln(' Alineamiento De Blaques : ',cwave.bcat);
writeln(' N§ Bytes Por Muestra : ',cwave.bmut);
writeln(' Marcador Inicio Datos : ',cwave.dato[0], cwave.dato[1],
cwave.dato[2], cwave.dato[3]);
writeln(' N§ Bytes Muestra : ',cwave.bmst);
writeln;
writeln('>>>>> Pulse Una Tecla <<<<<');
repeat until keypressed;
end;
begin
clrscr;
blaster := false;
puertobase;
if blaster = true then
begin
writeln('*** Sound Blaster En Puerto Base : $',wordhexa(pbase),' ***');
versionsb;
writeln('*** Sound Blaster Version = ',mayor,'.',menor);
presenta_archivos_wav;
gotoxy(2,25);write('Elija Solo Nombre : ');
gotoxy(22,25);readln(nombmusi);
nombre := 'c:\' + nombmusi + '.wav';
tomawave(nombre);
activa_misica(mimusi.misi, mimusi.tama, mimusi.frecu);
port[pbase + $c] := $D0;
presenta_cabecera_wave;
if memtoma = true then
freemem(mimusi.misi,memcarga);
end;
end.