home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC Action 1998 January
/
PCA0198.ISO
/
MENUE
/
POSTFACH
/
98012060.TXT
< prev
next >
Wrap
Text File
|
1997-11-25
|
4KB
|
185 lines
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.