[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]