 Отзывы присылать на склад нитроманита nitromanit@mail.ru

Unit sb;

interface

Uses Dos;

type Tbit2=(on,off);
     TPare=record
           o1,o2:byte;
           end;
     Tinstrument=record
                 SoundCharacter,Level,AttackDecay,
                 SustainRelease,WaveSelect:TPare;
                 FeedBack:byte;
                 Reserved:array [1..5] of byte;
                 end;

procedure InitSB;
function GetBlaster(var Port,IRQ,DMA,SBType:word):word; {0-Ok,0<>error}
function GetSBName(SBType:word):string;
function DetectBlaster:word;
procedure SetInstrument(channel,voice:byte;instrument:Tinstrument);
procedure Sound(channel,voice,octave,note:word);
procedure NoSound(channel,voice:byte);
procedure InitMixer;
procedure SetMainValume(left,right:byte);
procedure SetDACValume(left,right:byte);
procedure SetFMValume(left,right:byte);
procedure SetLineValume(left,right:byte);
procedure SetMicValume(valume:byte);
procedure SetCDValume(valume:byte);
procedure SetRecSourse(value:byte);
procedure SetStereo;
procedure SetMono;
{}
procedure InitDMA;
procedure DeInitDMA;
function DMADone(channel:word):word;
procedure SetSampleRate(frec:word);
procedure SoundOutPut(buf:pointer;count:word);
procedure SoundInPut(buf:pointer;count:word);
procedure Pause;
procedure Cancel;
{}
{procedure Play(frec:word;buf:pointer;count:word);
procedure Recording(frec:word;buf:pointer;count:word);}
procedure Play(frec:word;var buf;count:word);
procedure Recording(frec:word;var buf;count:word);

const AdLib=$388;
      SBlaster=$220;
      SBLeftChannel=$220;
      SBRightChannel=$222;
      LeftChannel=0;
      RightChannel=1;
      {--SB driver--}
      AsyncPlay=0;
      SyncPlay=1;
      {--Mixer--}
      MixInit=0;
      MixMainValume=$22;
      MixDACValume=$04;
      MixFMValume=$26;
      MixLineValume=$2e;
      MixMicValume=$0a;
      MixCDValume=$28;
      MixRecord=$0c;
      {}
      RecMic=0;
      RecCD=2;
      RecLine=6;
      {}
      MixStereo=$0e;
      {}
      Mono=0;
      Stereo=2;
      {--DMA--}
      DMAOutput=1;
      DMAInput=0;
      {--Instruments--}
      CPiano1:array[0..15] of byte=($0E4,$0C0,$040,$00,$0FF,$0F0,$46,$84,
                                  $0E,0,0,0,0,0,0,0);
      CPiano2:array[0..15] of byte=($01,$11,$4f,$00,$0f1,$0d2,$51,$43,
                                  $00,$00,$06,$00,0,0,0,0);
      CPiano3:array[0..15] of byte=($01,$01,$10,$00,$f0,$f0,$77,$77,
                                  0,0,0,0,0,0,0,0);
      CFlute:array[0..15] of byte=($0e0,$61,$0ec,$00,$7e,$65,$8f,$2a,
                                 $00,$00,$0e,$00,0,0,0,0);
      CDrum:array[0..15] of byte=(0,0,0,192,210,248,31,240,
                                10,0,0,0,0,0,0,0);

var   Base,DMARes,TransferDone,SBMode:word;
      DMAIRQ,DMAChannel:byte;
      IntIRQ_old:pointer;
      Piano1:Tinstrument absolute CPiano1;
      Piano2:Tinstrument absolute CPiano2;
      Piano3:Tinstrument absolute CPiano3;
      Flute:Tinstrument absolute CFlute;
      Drum:Tinstrument absolute CDrum;

implementation

procedure PutReg(channel,reg,value:byte);assembler;
  { Outputs a value to an ADLIB register }
  { IN: AH - register no., AL - value }
asm
    mov al,channel
    cmp al,0
    je  @a1
    {mov dx,Base}
    {mov dx,SBRightChannel}
    mov dx,base
    add dx,2
    jmp @a2
@a1:{mov dx,SBLeftChannel}
    mov dx,base
@a2:mov al,reg
    out dx,al
    in al,dx
    in al,dx
    in al,dx
    in al,dx
    in al,dx
    in al,dx
    inc dx
    mov al,value
    out dx,al
    dec dx
    mov ah,22
@la:in al,dx
    dec ah
    jnz @la
end;

procedure SetFeedBack(channel,voice,value:byte);
var reg:word;
begin
reg:=voice;
reg:=reg+$0c0;
PutReg(channel,reg,value);
end;

procedure SetInstrument(channel,voice:byte;instrument:Tinstrument);
{voice - 0..10 т.е. всего 22 голоса в SBlaster или по 11 голосов на канал
в каждом голосе по 2 оператора,если 2-х операторный режим}
const oprtr_ofs:array[0..8] of byte=(00,01,02,08,09,10,16,17,18);
var offs:word;
begin
offs:=oprtr_ofs[voice];
with instrument do begin
 PutReg(channel,$20+offs,SoundCharacter.o1);
 PutReg(channel,$20+offs+3,SoundCharacter.o2);
 {}
 PutReg(channel,$40+offs,Level.o1);
 PutReg(channel,$40+offs+3,Level.o2);
 {}
 PutReg(channel,$60+offs,AttackDecay.o1);
 PutReg(channel,$60+offs+3,AttackDecay.o2);
 {}
 PutReg(channel,$80+offs,SustainRelease.o1);
 PutReg(channel,$80+offs+3,SustainRelease.o2);
 {}
 PutReg(channel,$0e0+offs,WaveSelect.o1);
 PutReg(channel,$0e0+offs+3,WaveSelect.o2);
 {}
 SetFeedBack(channel,voice,FeedBack);
 end;
end;

procedure Sound(channel,voice,octave,note:word);
{note - 1..12}
{octave - 0..7}
{voice - 0..10}
Const  SBFrec:array[1..12] of word=
       ($16B,$181,$198,$1B0,$1CA,$1E5,$202,$220,$241,$263,$287,$2AE);
var Freccod:word;
    lbyte,hbyte:byte;
begin
Freccod:=SBFrec[note];
   asm
    mov bx,Freccod
    mov ax,octave
    shl ax,1
    shl ax,1
    or al,20h {включаем 5-й бит клавиши}
    add bh,al
    mov lbyte,bl
    mov hbyte,bh
   end;
PutReg(channel,voice+$0a0,lbyte);
PutReg(channel,voice+$0b0,hbyte);
end;

procedure NoSound(channel,voice:byte);
begin
PutReg(channel,voice+$0b0,0);
end;

procedure PutMixer(device,value:byte);
begin
port[base+$04]:=device;
port[base+$05]:=value;
end;

function GetMixer(device:byte):byte;
{при чтении из регистров микшера получаемые значения
являются случайными,во всяком случае они не соответствуют
устанавлеваемым через запись в микшер}
var value:byte;
begin
port[base+$04]:=device;
value:=port[base+$05];
end;

procedure InitSB;
var b:byte;
    i:word;
begin
port[base+$06]:=1;
b:=port[base+$06];
b:=port[base+$06];
b:=port[base+$06];
b:=port[base+$06];
port[base+$06]:=0;
end;

procedure InitMixer;
begin
PutMixer(MixInit,0);
end;

procedure GetMainValume(var left,right:byte);
var valume:byte;
begin
valume:=GetMixer(MixMainValume);
right:=valume and $0f;
left:=valume and $0f0;
left:=left shr 4;
end;

procedure SetMainValume(left,right:byte); {working}
var valume:byte;
begin
valume:=left shl 4;
valume:=valume or right;
PutMixer(MixMainValume,valume);
end;

procedure GetDACValume(var left,right:byte);
var valume:byte;
begin
valume:=GetMixer(MixDACValume);
right:=valume and $0f;
left:=valume and $0f0;
left:=left shr 4;
end;

procedure SetDACValume(left,right:byte); {working}
var valume:byte;
begin
valume:=left shl 4;
valume:=valume or right;
PutMixer(MixDACValume,valume);
end;

procedure GetFMValume(var left,right:byte);
var valume:byte;
begin
valume:=GetMixer(MixFMValume);
right:=valume and $0f;
left:=valume and $0f0;
left:=left shr 4;
end;

procedure SetFMValume(left,right:byte); {working}
var valume:byte;
begin
valume:=left shl 4;
valume:=valume or right;
PutMixer(MixFMValume,valume);
end;

procedure GetLineValume(var left,right:byte);
var valume:byte;
begin
valume:=GetMixer(MixLineValume);
right:=valume and $0f;
left:=valume and $0f0;
left:=left shr 4;
end;

procedure SetLineValume(left,right:byte);
var valume:byte;
begin
valume:=left shl 4;
valume:=valume or right;
PutMixer(MixLineValume,valume);
end;

function GetMicValume:byte;
var valume:byte;
begin
valume:=GetMixer(MixMicValume);
GetMicValume:=valume and $07;
end;

procedure SetMicValume(valume:byte);
begin
valume:=valume and $07;
PutMixer(MixMicValume,valume);
end;

function GetCDValume:byte;
var valume:byte;
begin
valume:=GetMixer(MixCDValume);
GetCDValume:=valume and $0f;
end;

procedure SetCDValume(valume:byte);
begin
valume:=valume and $0f;
PutMixer(MixCDValume,valume);
end;

function GetRecSourse:byte;
begin
GetRecSourse:=GetMixer(MixRecord);
end;

procedure SetRecSourse(value:byte);
begin
PutMixer(MixRecord,value);
end;

function GetStereoMode:boolean;
var v:byte;
begin
v:=GetMixer(MixStereo);
if v=Mono then GetStereoMode:=false
   else GetStereoMode:=true;
end;

procedure SetStereo; {working}
begin
PutMixer(MixStereo,Stereo);
end;

procedure SetMono; {working}
begin
PutMixer(MixStereo,Mono);
end;

procedure DMASetup(channel:word;buf:pointer;count,dir:word);assembler;
const pagetable:array [0..3] of word=($0087,$0083,$0081,$0082);
asm
     push bp
     {mov bp,sp}
     push bx
     push cx
     push dx
     push si
     push di
     {pushf}
     mov DMARes,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     mov bx,channel
     cmp bx,3
     jbe @Ok1
     mov DMARes,12
     {mov ax,-1}
     jmp @end
@Ok1:shl bx,1  {в bx I/O порт Channel*2}
     cmp dir,0
     jnz @Rd
     mov al,44h {write mode}
     jmp @Mod
 @Rd:mov al,48h {read mode}
@Mod:push cx
     mov cx,channel
     add al,cl
     xor ah,ah
     mov si,ax {в si команда для DMA}
     mov ax,0
     add al,cl
     pop cx
     mov cl,al
     mov ax,di
     add ax,count
     jnc @Ok2
     mov DMARes,2
     {mov ax,-1}
     jmp @end
@Ok2:cli       {запрещаем прерывания}
     mov dx,00ch
     out dx,al
     {засылаем 20-и битный адрес в DMA-контроллер}
     mov ax,di {в ax младшие 16 бит 20-и битного адреса буфера}
     mov dx,bx {в dx базовый адрес порта DMA этого канала}
     out dx,al
     mov al,ah
     out dx,al
     mov al,ch {в al номер страницы памяти где находится буфер}
     mov dx,word ptr [bx+offset pagetable] {в dx адрес DMA-порта страницы памяти где находится буфер}
     out dx,al
     {-------}
     mov ax,count
     mov dx,bx {в dx базовый адрес порта DMA этого канала}
     inc dx    {в dx адрес DMA-порта длины пересылки}
     out dx,al
     mov al,ah
     out dx,al
     mov ax,si
     mov dx,000bh {в dx регистр режима работы DMA}
     out dx,al
     mov dx,000ah {в dx регистр маскировки DMA}
     mov al,cl
     out dx,al
     {mov ax,0}
@end:{popf}
     pop di
     pop si
     pop dx
     pop cx
     pop bx
     pop bp
end;

procedure DMAReset(channel:word);assembler;
asm
     push bp
     push dx
     mov DMARes,0
     cmp channel,3
     jbe @Ok1
     mov DMARes,12
     jmp @end
@Ok1:mov dx,000ah {в dx регистр маскировки DMA}
     mov ax,0004h
     add ax,channel
     out dx,al
@end:pop dx
     pop bp
end;

function DMADone(channel:word):word;assembler;
asm
     push bp
     push dx
     cmp channel,3
     jbe @Ok1
     mov DMARes,12
     jmp @end
@Ok1:mov dx,channel
     shl dx,1 {в dx базовый адрес порта DMA этого канала}
     add dx,1
     cli
     in  al,dx
     mov ah,al
     in  al,dx
     xchg al,ah
@end:pop dx
     pop bp
end;

procedure PutDSP(value:byte);
var b:byte;
begin
b:=port[base+$0c];
b:=b and $80;
while boolean(b) do begin
      b:=port[base+$0c];
      b:=b and $80;
      end;
port[base+$0c]:=value;
end;

procedure SetSampleRate(frec:word);
begin
PutDSP($40);
PutDSP(256-(1000000 div frec));
end;

{$F+}
procedure IntIRQ_new;interrupt;
begin
if SBMode=SyncPlay then
   asm
     sti
     mov TransferDone,1
     mov al,20h
     mov dx,20h
     out dx,al
   end
   else begin
   Pause;
   asm
     sti
     mov TransferDone,1
     mov al,20h
     mov dx,20h
     out dx,al
   end;
   end;
end;
{$F-}

procedure InitDMA;
begin
  asm
     cli
  end;
GetIntVec($08+DMAIRQ,IntIRQ_old);
SetIntVec($08+DMAIRQ,@IntIRQ_new);
  asm
     mov cl,DMAIRQ
     mov ax,1
     shl ax,cl
     mov bx,ax
     not bx
     mov dx,21h
     in  al,dx
     and al,bl
     {mov al,0}
     out dx,al
     sti
  end
end;

procedure DeInitDMA;
begin
  asm
     cli
  end;
SetIntVec($08+DMAIRQ,IntIRQ_old);
  asm
     mov cl,DMAIRQ
     mov ax,1
     shl ax,cl
     mov bx,ax
     mov dx,21h
     in  al,dx
     or  al,bl
     {mov al,bl}
     out dx,al
     sti
  end
end;

procedure SoundOutPut(buf:pointer;count:word);
type TWord=record
           lbyte,hbyte:byte;
           end;
var  len:Tword absolute count;
begin
TransferDone:=0;
DMAReset(DMAChannel);
DMASetup(DMAChannel,buf,count,DMAOutput);
PutDSP($14);
PutDSP(len.lbyte);
PutDSP(len.hbyte);
PutDSP($0d1);
  asm
     sti
  end;
end;

procedure SoundInPut(buf:pointer;count:word);
type TWord=record
           lbyte,hbyte:byte;
           end;
var  len:Tword absolute count;
begin
TransferDone:=0;
DMAReset(DMAChannel);
DMASetup(DMAChannel,buf,count,DMAInput);
PutDSP($24);
PutDSP(len.lbyte);
PutDSP(len.hbyte);
{PutDSP($0d1);}
  asm
     sti
  end;
end;

procedure Pause;
begin
PutDSP($0d0);
end;

procedure Cancel;
begin
PutDSP($0d4);
end;

procedure AsyncPlay2(frec:word;var buf;count:word);
type TSoundBuf=array [0..60000] of byte;
var ibuf:TSoundBuf absolute buf;
begin
InitSB;
{InitDMA;}
SetSampleRate(frec);
SoundOutput(@ibuf,count);
if DMAres<>0 then begin
   Pause;
   DeInitDMA;
   writeln('Error= ',DMARes);
   exit;
   end; 
{ repeat
 until TransferDone=1;
Pause;
DeInitDMA;}
end;

procedure Play2(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var ibuf:TSoundBuf absolute buf;
begin
InitSB;
InitDMA;
SetSampleRate(frec);
SoundOutput(@ibuf,count);
if DMAres<>0 then begin
   Pause;
   DeInitDMA;
   writeln('Error= ',DMARes);
   exit;
   end; 
 repeat
 until TransferDone=1;
Pause;
DeInitDMA;
end;

procedure Play3(frec:word;var buf;count:word);
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
InitSB;
InitDMA;
SetSampleRate(frec);
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   InitSB;
   SoundOutput(@ibuf,firstcount);
   repeat
   until TransferDone=1;
   InitSB;
   SoundOutput(@ibuf[lastoffs],lastcount);
   repeat
   until TransferDone=1;
   end
   else begin
        SoundOutput(@buf,count);
        repeat
        until TransferDone=1;
   end;
Pause;
DeInitDMA;
end;

procedure SyncPlayVoc(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   play2(frec,ibuf,firstcount);
   play2(frec,ibuf[lastoffs+1],lastcount);
   end
   else begin
        play2(frec,buf,count);
   end;
end;

procedure AsyncPlayVoc(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   Asyncplay2(frec,ibuf,firstcount);
   Asyncplay2(frec,ibuf[lastoffs+1],lastcount);
   end
   else begin
        Asyncplay2(frec,buf,count);
   end;
end;

procedure Play(frec:word;var buf;count:word);
begin
if SBMode=SyncPlay then SyncPlayVoc(frec,buf,count)
   else AsyncPlayVoc(frec,buf,count);
end;

procedure Recording1(frec:word;var buf;count:word); {working but no verify for DMARes}
type TSoundBuf=array [0..60000] of byte;
var ibuf:TSoundBuf absolute buf;
begin
InitSB;
InitDMA;
SetSampleRate(frec);
SoundInput(@ibuf,count);
 repeat
 until TransferDone=1;
Pause;
DeInitDMA;
end;

procedure AsyncRecording2(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var ibuf:TSoundBuf absolute buf;
begin
InitSB;
{InitDMA;}
SetSampleRate(frec);
SoundInput(@ibuf,count);
if DMAres<>0 then begin
   Pause;
   DeInitDMA;
   writeln('Error= ',DMARes);
   exit;
   end; 
{ repeat
 until TransferDone=1;
Pause;
DeInitDMA;}
end;

procedure Recording2(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var ibuf:TSoundBuf absolute buf;
begin
InitSB;
InitDMA;
SetSampleRate(frec);
SoundInput(@ibuf,count);
if DMAres<>0 then begin
   Pause;
   DeInitDMA;
   writeln('Error= ',DMARes);
   exit;
   end; 
 repeat
 until TransferDone=1;
Pause;
DeInitDMA;
end;

procedure Recording3(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
InitSB;
InitDMA;
SetSampleRate(frec);
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   InitSB;
   SoundInput(@ibuf,firstcount);
   repeat
   until TransferDone=1;
   InitSB;
   SoundInput(@ibuf[lastoffs+1],lastcount);
   repeat
   until TransferDone=1;
   end
   else begin
        SoundInput(@buf,count);
        repeat
        until TransferDone=1;
   end;
Pause;
DeInitDMA;
end;

procedure SyncRecordVoc(frec:word;var buf;count:word); {working}
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   recording2(frec,ibuf,firstcount);
   recording2(frec,ibuf[lastoffs+1],lastcount);
   end
   else begin
        recording2(frec,buf,count);
   end;
end;

procedure AsyncRecordVoc(frec:word;var buf;count:word);
type TSoundBuf=array [0..60000] of byte;
var t,time,res,key,r,firstcount,lastoffs,lastcount:word;
    ibuf:TSoundBuf absolute buf;
begin
  asm
     mov res,0
     mov bx,word ptr [buf]
     mov ax,word ptr [buf+2]
     mov cl,4
     rol ax,cl
     mov ch,al
     and al,0f0h
     add ax,bx
     adc ch,0
     and ch,0fh
     mov di,ax {ch:di физический базовый адрес буфера}
     add ax,count
     jnc @Ok
     mov res,2
     mov bx,di
     mov ax,0ffffh
     sub ax,bx
     mov firstcount,ax
     mov lastoffs,ax
     mov ax,count
     sub ax,firstcount
     mov lastcount,ax
 @Ok:
  end;
if res=2 then begin
   Asyncrecording2(frec,ibuf,firstcount);
   Asyncrecording2(frec,ibuf[lastoffs+1],lastcount);
   end
   else begin
        Asyncrecording2(frec,buf,count);
   end;
end;

procedure Recording(frec:word;var buf;count:word);
begin
if SBMode=SyncPlay then SyncRecordVoc(frec,buf,count)
   else AsyncRecordVoc(frec,buf,count);
end;

function GetBlaster(var Port,IRQ,DMA,SBType:word):word; {0-Ok,0<>error}
var s,ss:string;
    b:byte;
    code:integer;
    p:word;
begin
GetBlaster:=0;
s:=GetEnv('blaster');
{--Searching SBport value--}
b:=pos('A',s);
ss:=copy(s,b+1,3);
val(copy(ss,1,1),p,code);
if code<>0 then begin GetBlaster:=22;exit;end;
Port:=p*256;
val(copy(ss,2,1),p,code);
if code<>0 then begin GetBlaster:=22;exit;end;
Port:=Port+p*16;
val(copy(ss,3,1),p,code);
if code<>0 then begin GetBlaster:=22;exit;end;
Port:=Port+p;
{--Searching SBIRQ value--}
b:=pos('I',s);
ss:=copy(s,b+1,1);
val(ss,IRQ,code);
if code<>0 then begin GetBlaster:=22;exit;end;
{--Searching SBDMA value--}
b:=pos('D',s);
ss:=copy(s,b+1,1);
val(ss,DMA,code);
if code<>0 then begin GetBlaster:=22;exit;end;
{--Searching SBType value--}
b:=pos('T',s);
if b=0 then begin SBType:=22;exit;end;
ss:=copy(s,b+1,1);
val(ss,SBType,code);
if code<>0 then begin SBType:=22;exit;end;
GetBlaster:=0;
end;

function GetSBName(SBType:word):string;
var s:string;
begin
  case SBType of
    1:s:='Sound Blaster 1.5';
    2:s:='Sound Blaster Pro';
    3:s:='Sound Blaster 2.0';
    4:s:='Sound Blaster Pro 2';
    5:s:='Sound Blaster';
    6:s:='Sound Blaster 16';
  else s:='Dont now';
  end;
GetSBName:=s;
end;

function DetectBlaster:word; {0-detecting Ok,0<>-not detected}
var i:word;
    b:byte;
begin
DetectBlaster:=22; {error}
InitSB;
for i:=0 to 60000 do begin end;
b:=port[base+$0e];
    if (b and $80)=$80 then begin
       b:=port[base+$0a];
       if b=$0aa then begin DetectBlaster:=0;exit;end;
       end;
end;

begin
base:=SBlaster;
DMAIRQ:=5;
DMAChannel:=1;
SBMode:=SyncPlay;
end.