0
Soundblaster-Erkennung, und Zusätze:
Der Zauberleerling
Listings
{Variablen--------------------------------------
-----------------------------}

Type  Tickarray   = array[1..5] of byte;

var   BasePort    : integer;
      Blastername : String;
      DSPVersion  : string[4];
      LFSuccess   : Boolean;

{Prozeduren-------------------------------------
-----------------------------}

procedure GetTicks (VAR Ticks: Tickarray);
begin
Inline($1E/$31/$C0/$8E/$D8/$BE/$6C/$04/$C4/$7E/<
TICKS/$FC/$AB/$FA/$A4/$A5/$FB/$1F)
end;

function ConvertTicks (Ticks: TickArray): 
longint;
begin
  ConvertTicks := Round(((Ticks[5]*256.0) + 
Ticks[4])*256 + Ticks[3]);
end;

Procedure Delay(Ticks: Longint); { 1 Tick ist 
ungef„hr 1/20 sek }
var ticked : tickarray; temp   : longint;
begin Getticks(Ticked); 
temp:=ConvertTicks(Ticked); repeat 
Getticks(Ticked);
until Convertticks(Ticked)-temp >= Ticks; end;

function sbfind:integer;
var   Basis, MaxPort, n,n2 : word;
const TestCount=15; TestCount2=40;
begin
Basis:=$210; MaxPort:=$260; n:=TestCount;
while n<=MaxPort do
 begin
  port[Basis+$6]:=1; port[Basis+$6]:=0; 
n2:=TestCount2;
  while (n2>0) and (port[Basis+$e] and 128=0) do 
dec(n2); 
  while (n2>0) and (port[Basis+$e] and 128=0) do 
dec(n2);
  if (n2=0) or (port[Basis+$a]<>$aa) then dec(n) 
else
    begin
     sbfind:=Basis;
     exit;
    end;
      Basis:=Basis+$10;
   end;
  sbfind:=-1;
end;

Procedure ResetDSP; Assembler;
asm
  mov LFSuccess, False
  mov dx, BasePort;
  add dl, 6
  mov al, 1
  out dx, al
  sub al, al
@Delay:
  dec al
  jnz @Delay
  out dx, al
  sub cx, cx
@Empty:
  mov dx, BasePort
  add dl, 0Eh
  in  al, dx
  or  al, al
  jns @Nextattempt
  sub dl, 4
  in  al, dx
  cmp al, 0AAh
  mov LFSuccess, True
  je  @Finish
@Nextattempt:
  Loop @Empty
@Finish:
end;

function ReadFromDSP : Byte;
begin
asm
  mov dx, BasePort;
  add dl, 0Eh
@Busy:
  in  al, dx
  or  al, al
  jns @Busy
  sub dl, 4
  in  al, dx
  mov @Result, al
end;
end;

Procedure WriteToDSP( ToWrite : Byte ); 
assembler;
asm
  mov dx, BasePort;
  add dl, 0Ch
@Busy:
  in  al, dx
  or  al, al
  js  @Busy
  mov al, ToWrite
  out dx, al
end;

Procedure SetSpeaker( On : Boolean );
begin
If On then WriteToDSP($D1) else WriteToDSP($D3);
end;

Procedure GetBlaster;
var DSPV1, DSPV2 : byte;
begin
ResetDSP;
WriteToDSP($E1);
DSPV1:=ReadFromDSP;
DSPV2:=ReadFromDSP;
str(dspv1,DSPVersion);
str(dspv2,Blastername);
DSPVersion:=DSPVersion+'.';
if Dspv2 < 10 then 
DSPVersion:=DSPVersion+'0'+Blastername else 
DSPVersion:=DSPVersion+Blastername;
If DSPV1 = 1 then BlasterName := 'Sound-Blaster 
1.5'else
If DSPV1 = 2 then
 begin
  if DSPV2 > 0 then BlasterName := 
'Sound-Blaster 2.0' else
                    BlasterName := 
'Sound-Blaster 1.5';
 end;
If DSPV1 = 3 then
 begin
  if port[$388] = $06 then BlasterName := 
'Sound-Blaster Pro 1.0' else
  BlasterName := 'Sound-Blaster Pro 2.0';
 end else
If DSPV1 = 4 then BlasterName := 'Sound-Blaster 
16' else
BlasterName := 'Keine zum Programm kompatible 
Soundkarte gefunden.';
end;

Procedure SetTimeConstant(Channels : byte; 
SamplingRate : Word);
var temp : longint;
begin
temp:=65536-(256000000 div (Channels * 
SamplingRate));
WriteToDSP($40);
WriteToDSP(temp);
end;

{Programm---------------------------------------
-----------------------------}

begin
BasePort:=SbFind;
if BasePort <> -1 then Getblaster
else
begin
Blastername:='Keine Soundkarte gefunden';
DSPVersion :='-';
end;
Writeln(BlasterName);
Writeln(DSPVersion);
Setspeaker(True);
Setspeaker(False);
end.