[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]
{
> Are there anybody out there who has some routins to play CD Audio in a CD
> ROM drive. Just the usual commands like play, stop, resume, eject and so
> on. I would appreciate any help!
}
Unit CDROM;
{ Unit talking to a CD-Rom-Drive
Low-level CD access,
only the first drive is supported...!
Copyright 1992 Norbert Igl }
Interface
Type
CD_Record = Record
Status : Word; { Status des Drives/letzte Funktion }
DrvChar: Char; { LW-Buchstabe }
DrvNo : Byte; { als Byte ablegegt (0...) }
HSG_RB : Byte; { Adressierungs-Modus }
Sector : LongInt; { Adresse des Lesekopfes }
VolInfo: Array[1..8] of Byte; { Lautst.-Einstellungen }
DevPar : LongInt; { Device-parameter, BIT-Feld! }
RawMode: Boolean; { Raw/Cooked-Mode ? }
SecSize: Word; { Bytes/Sector }
VolSize: LongInt; { sek/Volume => Groesse der CD}
MedChg : Byte; { Disk gewechselt? }
LoAuTr : Byte; { kleinste Audio-Track # }
HiAuTr : Byte; { groesste Audio-Track # }
endAdr : LongInt; { Adresse der Auslaufrille (8-) }
TrkNo : Byte; { Track #. Eingabe-Wert ! }
TrkAdr : LongInt; { Adresse dieses Tracks }
TrkInf : Byte; { Info dazu: BIT-Feld! }
CntAdr : Byte; { CONTROL und ADR, von LW }
CTrk : Byte; { track # }
Cindx : Byte; { point/index }
CMin : Byte; { minute\ }
CSek : Byte; { second > Laufzeit im Track }
CFrm : Byte; { frame / }
Czero : Byte; { immer =0 }
CAmin : Byte; { minute \ }
CAsec : Byte; { sekunde > Laufzeit auf Disk }
CAFrm : Byte; { frame / }
Qfrm : LongInt;{ start-frame address }
Qtrfs : LongInt;{ Bufferaddresse }
Qcnt : LongInt;{ Anzahl der Sectoren }
{ pro Sector werden 96 Byte nach buffer kopiert }
Uctrl : Byte; { CONTROL und ADR Byte }
Upn : Array[1..7] of Byte; { EAN-CODE }
Uzero : Byte; { immer = 0 }
Ufrm : Byte; { Frame-# }
end;
OneTrack = Record
Title : String[20];
Runmin,
RunSec : Byte;
Start : LongInt; { HSG Format ! }
end;
VolumeTableOfContens = Record
Diskname: String[20];
UAN_Code: String[13];
TrackCnt: Byte;
Titles : Array[1..99] of OneTrack;
end;
TrkInfo = Record
Nummer : Byte;
Start : LongInt;
Cntrl2 : Byte;
end;
{===== global verfuegbare Variablen =============}
Var CD : CD_Record;
CD_AVAIL : Boolean;
VtoC : VolumeTableOfContens;
CD_REDPos : String;
CD_HSGPos : String;
{===== allgemeine Funktionen ===================}
Function CD_Reset : Boolean;
Function CD_HeadAdr : Boolean;
Function CD_Position: Boolean;
Function CD_MediaChanged: Boolean;
{===== Tray/Caddy-Funktionen ===================}
Function CD_Open: Boolean;
Function CD_Close: Boolean;
Function CD_Eject: Boolean;
{==== Audio-Funktionen =========================}
Function CD_Play(no:Byte; len:Integer): Boolean;
Function CD_Stop: Boolean;
Function CD_Resume:Boolean;
Function CD_SetVol:Boolean;
Function CD_GetVol:Boolean;
Procedure CD_Info;
Procedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );
{==== Umwandlungen =============================}
Function Red2Time( Var Inf:TrkInfo ):Word;
Implementation Uses Dos;
Type IOCtlBlk = Array[0..200] of Byte;
Const IOCtlRead = $4402;
IOCtlWrite = $4403;
DevDrvReq = $1510;
All:LongInt= $0f00;
Var R : Registers;
H : Text;
Handle : Word;
Old_Exit : Pointer;
CtlBlk : IOCtlBlk;
Tracks : Array[1..100] of TrkInfo;
Procedure CD_Exit; { wird bei Programmende ausgefuehrt }
begin
if Old_Exit <> NIL
then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }
{$I-}
Close(H);
If IoResult = 0 then; { 'H' schliessen, falls offen, }
{$I+} { evtl. Fehler verwerfen }
end;
Function CD_Init: Boolean; { Initialisierung beim Programmstart }
begin
FillChar( CD, SizeOf( CD ), 0);
With R do
begin
AX := $1500;
BX := $0000;
CX := $0000;
Intr( $2F, R );
CD_Init := (BX > 0); { Anzahl der CD-Laufwerke }
If BX > 0
then begin
CD.DrvChar { CD-Laufwerksbuchstabe }
:= Char( CL + Byte('A') );
CD.DrvNo := CL;
If CD_HeadAdr then
If CD_GetVol then;
end
else CD.DrvChar := '?'; { im Fehlerfall...}
end
end;
Procedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );
begin
T := Tracks[nr]
end;
Function OpenCDHandle:Word;
Const Name : String[8] = 'MSCD001'; { evt. anpassen!!! ? }
begin
Assign(H, Name); { Filehandle holen }
(*$I-*)
Reset(H);
(*$I+*)
if IoResult = 0 then
begin
Handle := TextRec(H).Handle; { Filehandle holen }
Old_Exit := ExitProc; { Bei ende/Abbruch muss 'H'... }
ExitProc := @CD_Exit; { ...automatisch geschlossen werden }
end
else Handle := 0;
OpenCDHandle := Handle;
end;
Procedure CloseCDHandle;
begin
if TextRec(H).Mode <> FmClosed
then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }
Old_Exit := NIL;
{$I-}
Close(H);
If IoResult = 0 then; { 'H' schliessen, falls offen, }
{$I+} { evtl. Fehler verwerfen }
end;
Function Red2HSG( Var Inf:TrkInfo ):LongInt;
Var l: LongInt;
begin
l := LongInt(( Inf.Start shr 16 ) and $FF ) * 4500;
l := l + LongInt(( Inf.Start shr 8 ) and $FF ) * 75;
l := l + LongInt(( Inf.Start ) and $FF ) ;
Red2HSG := l -2;
end;
Function Red2Time( Var Inf:TrkInfo ):Word;
begin
Red2Time:= (( Inf.Start shr 24 ) and $FF ) shl 8
+ (( Inf.Start shr 16 ) and $FF )
end;
Function HSG2Red(L:LongInt):LongInt;
begin
end;
Function CD_IOCtl( Func, Len : Word) : Boolean;
begin
With R do
begin
AX := Func;
BX := OpenCDHandle;
CX := 129;
DS := DSeg;
ES := DS;
DX := Ofs(CtlBlk);
MsDos( R );
CD.Status := AX;
CD_IOCtl := (Flags and FCARRY) = 0;
CloseCDHandle;
end
end;
Function CD_Reset: Boolean;
begin
CtlBlk[0] := 2; { Reset }
CD_Reset := CD_IoCtl( IoCtlWrite, 1)
end;
Function DieTuer( AufZu:Byte ): Boolean;
begin
CtlBlk[0] := 1; { die Tuer.. }
CtlBlk[1] := AufZu; { ..freigeben }
DieTuer := CD_IoCTL(IoCtlWrite, 2);
end;
Function CD_Open: Boolean;
Const Auf = 0;
begin
CD_Open := DieTuer( Auf );
end;
Function CD_Close: Boolean;
Const Zu = 1;
begin
CD_Close := DieTuer( Zu );
end;
Function CD_Eject: Boolean;
begin
CtlBlk[0] := 0; { CD auswerfen }
CD_Eject := CD_IOCtl(IoCtlWrite, 1);
end;
Function CD_Play(no:Byte; len:Integer): Boolean;
begin { CD PlayAudio }
FillChar(CtlBlk, SizeOf(CtlBlk), 0);
CtlBlk[0] := 22; { laenge des req-hdr }
CtlBlk[1] := 0; { sub-Unit }
CtlBlk[2] := $84; { Kommando }
CtlBlk[3] := 0; { Status-WORT }
CtlBlk[4] := 0;
CtlBlk[5] := 0;
CtlBlk[13]:= CD.HSG_RB; { HSG-Modus }
CD.Sector := VtoC.Titles[no].Start; { ist im HSG-Format }
Move( CD.Sector, CtlBlk[14], 4 ); { Start-Sector }
if len = -1
then All := $FFFF
else All := len;
Move( All , CtlBlk[18], 4 ); { Anzahl Sectoren}
Asm
mov ax, $1510
push ds
pop es
xor cx, cx
mov cl, CD.DrvNo
mov bx, offset CtlBlk
Int $2f
end;
CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
CD_Play := CD.Status and $8000 = 0;
end;
Function CD_VtoC:Boolean;
Var i: Byte;
l: LongInt;
begin
FillChar( Tracks, SizeOf( Tracks ), 0);
CtlBlk[0] := 10; { Read LeadOut-Tr }
CD_IoCtl( IoCtlRead, 6);
Move( CtlBlk[1], CD.LoAuTr, 6);
i := CD.HiAuTr+1;
Move( CtlBlk[3], Tracks[i], 4); { die Auslaufrille 8-) }
Tracks[i].Start := Red2Hsg(Tracks[i]);
For i := CD.LoAuTr to CD.HiAuTr do
begin
FillChar(CtlBlk, SizeOf(CtlBlk), 0); { RED-Book-Format }
CtlBlk[0] := 11; { Read VtoC-Entry }
CtlBlk[1] := i; { track-no }
CD_IoCtl( IoCtlRead, 6);
Move( CtlBlk[1], Tracks[i], 6);
{ Tracks[i].Start := Red2Hsg(Tracks[i]); }
end;
With VtoC do
begin
DiskName := '';
UAN_Code := '';
TrackCnt := CD.HiAuTr;
For i := CD.LoAuTr to CD.HiAuTr do
With Titles[i] do
begin
L := LongInt((Tracks[i+1].Start shr 16) and $FF) * 60
+ (Tracks[i+1].Start shr 8) and $FF
- ( LongInt((Tracks[i].Start shr 16) and $FF) * 60
+ (Tracks[i].Start shr 8) and $FF);
Title := '???';
RunMin := L div 60;
RunSec := l - RunMin*60;
Start := Red2Hsg(Tracks[i]);
end
end;
end;
Function CD_Stop: Boolean;
begin { CD StopAudio }
FillChar(CtlBlk, SizeOf(CtlBlk), 0);
CtlBlk[0] := 5; { laenge des req-hdr }
CtlBlk[1] := 0; { sub-Unit }
CtlBlk[2] := $85; { Kommando }
CtlBlk[3] := 0; { Status-WORT }
CtlBlk[4] := 0;
CtlBlk[5] := 0;
Asm
mov ax, $1510
push ds
pop es
xor cx, cx
mov cl, CD.DrvNo
mov bx, offset CtlBlk
Int $2f
end;
CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
CD_Stop := CD.Status and $8000 = 0;
end;
Function CD_Resume:Boolean;
begin { ResumeAudio}
CtlBlk[0] := 3; { laenge des req-hdr }
CtlBlk[1] := 0; { sub-Unit }
CtlBlk[2] := $88; { Kommando }
CtlBlk[3] := 0; { Status-WORT }
CtlBlk[4] := 0;
Asm
mov ax, Seg @DATA
mov es, ax
mov ax, DevDrvReq
lea bx, CtlBlk
Int 2fh
end;
CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;
CD_Resume := CD.Status and $8000 = 0;
end;
Function CD_GetVol:Boolean;
begin
CtlBlk[0] := 4; { die Lautstaerke lesen }
CD_GetVol := CD_IOCtl(IoCtlRead, 8);
if ((R.Flags and FCARRY) = 0)
then Move(CtlBlk[1], CD.VolInfo, 8)
else FillChar( CD.VolInfo, 8, 0)
end;
Function CD_SetVol:Boolean;
begin
CtlBlk[0] := 3; { die Lautstaerke setzen }
CD_SetVol := CD_IOCtl( IoCtlWrite, 8);
end;
Function CD_HeadAdr: Boolean;
Var L:LongInt; S:String;
begin
FillChar(CtlBlk, SizeOf(CtlBlk), 0);
CtlBlk[0] := 1;
CtlBlk[1] := 1; { die KopfPosition im RED-Format }
CD_HeadAdr:= CD_IOCtl(IoCtlRead, 128);
if ((R.Flags and FCARRY) = 0)
then begin
Move(CtlBlk[2], L, 4);
if CtlBlk[1] = 1 then
begin
STR( CtlBlk[4]:2, S); CD_REDPos := S;
STR( CtlBlk[3]:2, S); CD_REDPos := CD_REDPos+ ':'+ S;
CD.Sector := LongInt(CtlBlk[4]) *4500 +
LongInt(CtlBlk[3]) *75 +
LongInt(CtlBlk[2])
- 150;
end else
begin
CD.Sector := L;
STR(L:0,CD_HSGPos);
end
end
else FillChar( CD.Sector, 4, 0);
end;
Function CD_Position:Boolean;
Var l : LongInt;
begin
CtlBlk[0] := 12; { Audio-Infos }
CD_Position :=CD_IOCtl(IoCtlRead,10);
Move(CtlBlk[1], CD.CntAdr, 10);
end;
Procedure CD_GetUAN;
begin
CtlBlk[0] := 14; { EAN-Nummer }
If CD_IOCtl(IoCtlRead,10)
then Move(CtlBlk[1], CD.Uctrl, 10);
end;
Function CD_MediaChanged:Boolean;
begin
CtlBlk[0] := 9; { Media-Change }
If CD_IOCtl(IoCtlRead, 1)
then Move(CtlBlk[1], CD.MedChg, 1 );
CD_MediaChanged:= CD.MedChg <> 1
end;
Procedure CD_Info;
begin
{ CD_Reset; }
If CD_HeadAdr then;
CtlBlk[0] := 6; { Device-parameter }
If CD_IOCtl(IoCtlRead, 4)
then Move(CtlBlk[1], CD.DevPar, 4 );
CtlBlk[0] := 7; { Sector-Groesse }
If CD_IOCtl(IoCtlRead, 3) { & Modus }
then Move(CtlBlk[1], CD.RawMode, 3 );
CtlBlk[0] := 8; { Volume-Groesse }
If CD_IOCtl(IoCtlRead, 4)
then Move(CtlBlk[1], CD.VolSize, 4 );
CtlBlk[0] := 12; { Audio-Infos }
If CD_IOCtl(IoCtlRead,10)
then Move(CtlBlk[1], CD.CntAdr, 10);
CtlBlk[0] := 11; { Track-Infos }
CtlBlk[1] := CtlBlk[2]; { aktueller... }
If CD_IOCtl(IoCtlRead, 6)
then Move(CtlBlk[1], CD.TrkNo, 6 );
CD_VtoC;
end;
{========= minimale Initialisierung =============}
begin
CD_Avail := CD_Init;
if CD_Avail then CD_INFO
end. Norbert
{
--- part 2, a Test -----
}
Program CDROM_TEST;
Uses Crt, cdrom, SbTest;
Type a5 = Array[0..4] of Byte;
Var i:Byte;
L : LongInt;
ch : Char;
no,
len : Integer;
begin
ClrScr;
WriteLn('CDROM-Unit TestProgram',#10);
With CD do
if CD_Avail then
begin
WriteLn('þ CD als Laufwerk ',DrvChar,': gefunden!');
Write ('þ Aktuelle CD: ');
Write('(UPN-CODE:');
For i := 1 to 7 do Write(Char( (Upn[i] shr 4) or $30),
Char((Upn[i] and $f) or $30));
WriteLn(#8')');
WriteLn('þ Audio-Tracks : ',loautr,'..',hiautr);
WriteLn(' Laufzeiten : ');
For i := CD.LoAuTr to CD.HiAuTr do
With VtoC.Titles[i] do
WriteLn(i,Title:10, RunMin:6,':',RunSec);
no := 1;
len := -1;
if CD_Stop then
if not CD_Play( no ,len)
then WriteLn('! Fehler-Status: ',STATUS and $F);
ch := ' ';
While ch <> #27 do
begin
While ch = ' ' do
With CD do
begin
if CD_Position then
Write('Playing Track ',CTrk,' : ',CMin:2,':',CSek:2,' '#13);
Delay(1500);
if KeyPressed
then ch := ReadKey;
end;
Case ch of
'+' : Inc(no);
'-' : Dec(no);
end;
if ch <> #27 then ch := ' ';
if no > cd.HiAUTr then Dec(no);
if no < cd.LoAuTr then Inc(no);
if CD_Stop
then CD_Play(no, len);
end;
cd_stop;
clreol;
WriteLn(' CD stopped...');
end
else WriteLn('Leider kein CD-ROM gefunden...');
end.
[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]