Solved

Eject CD Rom??

Posted on 2002-04-12
21
838 Views
Last Modified: 2010-12-21
Hi Experts.
I want to be able to open/close cdrom drive, via one button. That means i need to know if the cdrom is currently open or closed.

How can i get the status of the drive (open or closed)?

i tried this code:
if MediaPlayer1.Mode = mpOpen then
  showmessage('CDTrayOpen')
else
  showmessage('CDTrayClosed');

But it always return false.

Also note, if its possible to get som code that get the status of the cdrom drive right, even if my program was not started when cd was ejected.

Thanks
0
Comment
Question by:Dennis9
  • 7
  • 4
  • 3
  • +5
21 Comments
 

Expert Comment

by:waltham
Comment Utility
Please try below code


function TForm1.IsDriveCD(Drive : char) : longbool;
var
  DrivePath : string;
begin
  DrivePath := Drive + ':\';
  result := LongBool(GetDriveType(PChar(DrivePath)) and DRIVE_CDROM);
end;

function TForm1.EjectCD(Drive : char) : bool;
var
  mp : TMediaPlayer;
begin
  result := false;
  Application.ProcessMessages;
  if not IsDriveCD(Drive) then exit;
  mp := TMediaPlayer.Create(nil);
  mp.Visible := false;
  mp.Parent := Application.MainForm;
  mp.Shareable := true;
  mp.DeviceType := dtCDAudio;
  mp.FileName := Drive + ':';
  mp.Open;
  Application.ProcessMessages;
  mp.Eject;
  Application.ProcessMessages;
  mp.Close;
  Application.ProcessMessages;
  mp.free;
  result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not EjectCD('D') then
    ShowMessage('Not A CD Drive');
end;
0
 
LVL 1

Author Comment

by:Dennis9
Comment Utility
waltham -> Your code just opens the drive. I wanna know if the drive currently is open or if it is closed.
0
 

Expert Comment

by:waltham
Comment Utility
i know you are a delphi programmer but i think the information in this link will help a lot ( my vb group use to use this information )

http://www.mvps.org/vbnet/index.html?code/toc/tocbyuse.htm

0
 
LVL 5

Expert Comment

by:alanwhincup
Comment Utility
Try this (Unsure if works):

procedure TForm1.Button1Click(Sender: TObject);
var
  S : array[0..64] of Char;
  Error : Cardinal;
  Text : array[0..255] of Char;
begin
  Error := mciSendString('open cdaudio alias cd', nil, 0, Handle);
  if Error <> 0 then
  begin
    mciGetErrorString(Error, @Text, 255);
    ShowMessage(Text);
    mciSendString('close cd', nil, 0, Handle);
    Exit;
  end;
  Error := mciSendString('status cd mode', @S, SizeOf(S), Handle);
  if Error <> 0 then
  begin
    mciGetErrorString(Error, @Text, 255);
    ShowMessage(Text);
    mciSendString('close cd', nil, 0, Handle);
    Exit;
  end;
  mciSendString('close cd', nil, 0, Handle);
  ShowMessage(S);
end;

Cheers,

Alan
0
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
Agree with alanwhincup . Just add mmsystem at uses.
0
 
LVL 1

Author Comment

by:Dennis9
Comment Utility
alanwhincup -> Your code would work if not mciSendString always did resturn 0 :<

Its hard when the MMSystem has errors. It always return 0, probaly because MMSystem think it had a success when it resive the command.

Maybe this question is impossible to solve?

Dennis
0
 
LVL 3

Expert Comment

by:bryan7
Comment Utility
there is no way to know if the tray is
Opened or Closed... I remember on of the
big experts here once ask for it offering
2000 points and no answer..
0
 
LVL 3

Expert Comment

by:neostudio
Comment Utility
Well,
i disagree bryan7, btw)) been a long time ;-)
everything can be done, even if hard-coded but it can be done !!

don't you think so !!

regards,
</Ruslan>
0
 
LVL 3

Expert Comment

by:bryan7
Comment Utility
umm, do it so...
0
 
LVL 3

Expert Comment

by:bryan7
Comment Utility
you will get exactly same results Drive not ready
with tray open or close (with no cd)
there is no flag or anything to indicate
if the tray is open.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 3

Expert Comment

by:neostudio
Comment Utility
How About This Snippet ??
I Want To Make This A Bet bryan7 !! ;-)
Just For Interest,


//*
Uniform CDROM driver ioctls

CDROMCLOSETRAY pendant of CDROMEJECT
CDROM_SET_OPTIONS Set behavior options
CDROM_CLEAR_OPTIONS Clear behavior options
CDROM_SELECT_SPEED Set the CD-ROM speed
CDROM_SELECT_DISC Select disc (for juke-boxes)
CDROM_MEDIA_CHANGED Check is media changed
CDROM_DRIVE_STATUS Get tray position, etc.
CDROM_DISC_STATUS Get disc type, etc.
CDROM_CHANGER_NSLOTS Get number of slots
CDROM_LOCKDOOR lock or unlock door
CDROM_DEBUG Turn debug messages on/off
CDROM_GET_CAPABILITY get capabilities
DVD-ROM Specific ioctls

DVD_READ_STRUCT Read structure
DVD_WRITE_STRUCT Write structure
DVD_AUTH Authentication
writing cdroms

CDROM_SEND_PACKET send a packet to the drive
CDROM_NEXT_WRITABLE get next writable block
CDROM_LAST_WRITTEN get last block written on disc
capability flags used with the uniform CD-ROM driver

  CDC_CLOSE_TRAY          0x1     /* caddy systems _can't_ close */
  CDC_OPEN_TRAY           0x2     /* but _can_ eject.  */
  CDC_LOCK                0x4     /* disable manual eject */
  CDC_SELECT_SPEED        0x8     /* programmable speed */
  CDC_SELECT_DISC         0x10    /* select disc from juke-box */
  CDC_MULTI_SESSION       0x20    /* read sessions>1 */
  CDC_MCN                 0x40    /* Medium Catalog Number */
  CDC_MEDIA_CHANGED       0x80    /* media changed */
  CDC_PLAY_AUDIO          0x100   /* audio functions */
  CDC_RESET               0x200   /* hard reset device */
  CDC_IOCTLS              0x400   /* driver has non-standard ioctls */
  CDC_DRIVE_STATUS        0x800   /* driver implements drive status */
  CDC_GENERIC_PACKET      0x1000  /* driver implements generic packets */
  CDC_CD_R                0x2000  /* drive is a CD-R */
  CDC_CD_RW               0x4000  /* drive is a CD-RW */
  CDC_DVD                 0x8000  /* drive is a DVD */
  CDC_DVD_R               0x10000 /* drive can write DVD-R */
  CDC_DVD_RAM             0x20000 /* drive can write DVD-RAM */

drive status possibilities returned by CDROM_DRIVE_STATUS ioctl

CDS_NO_INFO if not implemented
CDS_NO_DISC
CDS_TRAY_OPEN
CDS_DRIVE_NOT_READY
CDS_DISC_OK
return values for the CDROM_DISC_STATUS ioctl can also return CDS_NO_[INFO|DISC], from above

CDS_AUDIO
CDS_DATA_1
CDS_DATA_2
CDS_XA_2_1
CDS_XA_2_2
CDS_MIXED
User-configurable behavior options for the uniform CD-ROM driver

CDO_AUTO_CLOSE close tray on first open()
CDO_AUTO_EJECT open tray on last release()
CDO_USE_FFLAGS use O_NONBLOCK information on open
CDO_LOCK lock tray on open files
CDO_CHECK_TYPE check type on open for data


*//


i wish i hgad the enough capabilities to translate C into DELPHI, i would have posted the needed code !!!

IF YOU CAN I CAN EMAIL YOU THE c++ CODE, I THINK I STILL HAVE YOUR EMAIL !!!

REGARDS,
</rUSLAN>
0
 
LVL 3

Expert Comment

by:neostudio
Comment Utility
You Will Need To Notice This From The Mess I Just Posted..



drive status possibilities returned by CDROM_DRIVE_STATUS ioctl

CDS_NO_INFO if not implemented
CDS_NO_DISC
CDS_TRAY_OPEN
CDS_DRIVE_NOT_READY
CDS_DISC_OK
return values for the CDROM_DISC_STATUS ioctl can also return CDS_NO_[INFO|DISC], from above





Regards again,
</Ruslan>
0
 
LVL 3

Expert Comment

by:neostudio
Comment Utility
Great, Just Great...

Let Me Be Some Kinda Selfish, ;-p

for some more points am gonna post the Delphi Unit, i have it ready !!

regards,
</Ruslan>
0
 
LVL 1

Author Comment

by:Dennis9
Comment Utility
ok 100 plint is that enough?
0
 
LVL 3

Accepted Solution

by:
neostudio earned 100 total points
Comment Utility
Check It Out............
=========================
PS> READ THE NOTES, THIS IS A LOW-LEVEL CD-ROM ACCESS, IT IS MORE A CODE TO TELL bryan7 THAT I CAN DO IT, MORE THAN IT IS THE NEEDED CODE TO SOLVE YOUR PROBLEM, EVEN THOUGH, IT NEEDS A ONE HOUR WORK TO RE-FROMAT IT INTO CLEAN DELPHI CODE !!

HAVE FUN !!




{
Contributor: NORBERT IGL Nov. (1992)
############################
Corrections: Ruslan K. Abu Zant, 2001
############################
PS>
 1-     Only First Available CD-ROM Is
         Accessable !!
 2-     This Is A Low-level CD access .
############################
}
Unit CDROM;

Interface

Type
   CD_Record = Record
                    Status : Word;    { Drives Status }
                    DrvChar: Char;    { Drive Name }
                    DrvNo  : Byte;    { Drive Byte Number (0...) }
                    HSG_RB : Byte;    { Adressierungs-Modus }

                    Sector : LongInt; { Laser-Head Address }
                    VolInfo: Array[1..8] of Byte; { Volume Information }
                    DevPar : LongInt; { Device-parameter }
                    RawMode: Boolean; { Raw/Cooked-Mode ? }
                    SecSize: Word;    { Bytes/Sector }
                    VolSize: LongInt; { CD Volume }

                    MedChg : Byte;    { Disk gewechselt? }

                    LoAuTr : Byte;    { Lowest Audio-Track #ID }
                    HiAuTr : Byte;    { Highest Audio-Track #ID }
                    endAdr : LongInt; { Outlet groove Address (8-) }

                    TrkNo  : Byte;    { Track #. Input Value ! }
                    TrkAdr : LongInt; { Address of this Track }
                    TrkInf : Byte;    { Additional Information: Bit Filled }

                    CntAdr : Byte;   { CONTROL and ADDRESS, from LW }
                    CTrk   : Byte;   { track # }
                    Cindx  : Byte;   { point/index }
                    CMin   : Byte;   { minute\  }
                    CSek   : Byte;   { seconds > In Track }
                    CFrm   : Byte;   { frame /  }
                    Czero  : Byte;   { immer =0 }
                    CAmin  : Byte;   { minute \ }
                    CAsec  : Byte;   { Seconds > In Disk }
                    CAFrm  : Byte;   { frame  / }

                    Qfrm   : LongInt;{ start-frame address }
                    Qtrfs  : LongInt;{ Buffer address }
                    Qcnt   : LongInt;{ Number the Sectors }
                      { Per Sector 96 bytes are copied after buffer }

                    Uctrl  : Byte;  { CONTROL And ADR Byte }
                    Upn    : Array[1..7] of Byte; { EAN CODE }
                    Uzero  : Byte;  { Always = 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 variables =============}

Var    CD           : CD_Record;
       CD_AVAIL     : Boolean;
       VtoC         : VolumeTableOfContens;
       CD_REDPos    : String;
       CD_HSGPos    : String;

{===== general functions  ===================}

Function CD_Reset   : Boolean;
Function CD_HeadAdr : Boolean;
Function CD_Position: Boolean;
Function CD_MediaChanged: Boolean;


{===== Tray/Caddy-Fuctions ===================}

Function CD_Open:  Boolean;
Function CD_Close: Boolean;
Function CD_Eject: Boolean;

{==== Audio-Fuctions =========================}

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 );

{==== Transformations =============================}

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;               { It is implemented with program end }
begin
  if Old_Exit <> NIL
    then ExitProc := Old_Exit;      { Diversion take back again }
{$I-}
  Close(H);
  If IoResult = 0 then;              { 'H' Close, falls offen, }
{$I+}                                      { Perhaps mistakes reject }
end;


Function CD_Init:  Boolean;    { Initialization on the program start.  }
begin
 FillChar( CD, SizeOf( CD ), 0);
 With R do
 begin
   AX := $1500;
   BX := $0000;
   CX := $0000;
   Intr( $2F, R );
   CD_Init := (BX > 0);                  { Number of the CD disk drives.  }
   If BX > 0
    then begin
      CD.DrvChar                           { CD-disk drive letter }
         := Char( CL + Byte('A') );
      CD.DrvNo := CL;
      If CD_HeadAdr then
        If CD_GetVol then;
    end
    else CD.DrvChar := '?';                      { In case of mistakes...}
 end
end;

Procedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );
begin
  T := Tracks[nr]
end;

Function OpenCDHandle:Word;
Const Name : String[8] = 'MSCD001';        { adapt...!!! ? }
begin
  Assign(H, Name);                         { Get FileHandle }
(*$I-*)
  Reset(H);
(*$I+*)
  if IoResult = 0 then
  begin
    Handle := TextRec(H).Handle;                { Getting FileHandle }
    Old_Exit := ExitProc;           { By end /must demolite  'H'... }
    ExitProc := @CD_Exit;      { ...Automatically are closed }
  end
  else Handle := 0;
  OpenCDHandle := Handle;
end;

Procedure CloseCDHandle;
begin
  if TextRec(H).Mode <> FmClosed
     then ExitProc := Old_Exit;     { Diversion take back again }
  Old_Exit := NIL;
{$I-}
  Close(H);
  If IoResult = 0 then;             { 'H' Close, if open,  }
{$I+}                                     { perhaps mistakes eject }
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;                                { ..Let Off }
  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;                                   { Eject CD }
  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;                             { req-hdr Length }
  CtlBlk[1] := 0;                                       { sub-Unit }
  CtlBlk[2] := $84;                                     { Command #ID }
  CtlBlk[3] := 0;                                    { Status-WORD }
  CtlBlk[4] := 0;
  CtlBlk[5] := 0;
  CtlBlk[13]:= CD.HSG_RB;                             { HSG-Mode }

  CD.Sector := VtoC.Titles[no].Start;          { is with HSG-Format }

  Move( CD.Sector, CtlBlk[14], 4 );                 { Start-Sector }
  if len = -1
    then All := $FFFF
    else All := len;
  Move( All      , CtlBlk[18], 4 );               { Sector Number }
  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);      { The outlet groove 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;                             { req-hdr length again }
  CtlBlk[1] := 0;                                       { sub-Unit }
  CtlBlk[2] := $85;                                     { Command #ID }
  CtlBlk[3] := 0;                                    { Status-WORD }
  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                                                 { Resume Audio}
  CtlBlk[0] := 3;                              { req-hdr length }
  CtlBlk[1] := 0;                                       { sub-Unit }
  CtlBlk[2] := $88;                                     { Command #ID }
  CtlBlk[3] := 0;                                    { Status-WORD }
  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;                           { Get The volume }
  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;                          { Set The Volume }
  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;                     { The head position in the 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-Number   }
  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-Size }
  If CD_IOCtl(IoCtlRead, 3)                              { & Mode }
    then Move(CtlBlk[1], CD.RawMode, 3 );

  CtlBlk[0] := 8;                                   { Volume-Size }
  If CD_IOCtl(IoCtlRead, 4)
    then Move(CtlBlk[1], CD.VolSize, 4 );

  CtlBlk[0] := 12;                                  { Audio Info  }
  If CD_IOCtl(IoCtlRead,10)
    then Move(CtlBlk[1], CD.CntAdr, 10);

  CtlBlk[0] := 11;                                  { Track-Info   }
  CtlBlk[1] := CtlBlk[2];                           { More current... }
  If CD_IOCtl(IoCtlRead, 6)
    then Move(CtlBlk[1], CD.TrkNo, 6 );

  CD_VtoC;

end;

{========= Minimal initialization =============}
begin
  CD_Avail := CD_Init;
  if CD_Avail then CD_INFO
end. Norbert

{======================== THE END =========================}












{
--- 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 Test Program',#10);
  With CD do
  if CD_Avail then
  begin
   WriteLn('CD Disk Drive: ',DrvChar,': Found!');
   Write  (Actual 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(' Terms : ');
   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('! Error-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('No CD-ROM Drive Was Found...');
end.




regards,
</Ruslan>
0
 
LVL 3

Expert Comment

by:neostudio
Comment Utility
On More Great And Nice Code Is Available At This Address, It Also Provide Some Flags For The CD-ROM DOOR,

[Open-Close]

Here We Go...


http://home.student.utwente.nl/h.vanwelbergen/code/pascal/cd.html



regards,
</Ruslan>
0
 
LVL 3

Expert Comment

by:bryan7
Comment Utility
ummmm... wow, can't wait to test that..
can I have the C files ? or maybe the
translated one ? can't wait to test it..
0
 

Expert Comment

by:waltham
Comment Utility
i know you are a delphi programmer but i think the information in this link will help a lot ( my vb group use to use this information )

http://www.mvps.org/vbnet/index.html?code/toc/tocbyuse.htm

0
 
LVL 1

Expert Comment

by:yk030299
Comment Utility
interesting
0
 
LVL 1

Expert Comment

by:pnh73
Comment Utility
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

Accept answer from neostudio

Please leave any comments here within the next seven days.
 
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
 
Paul (pnh73)
EE Cleanup Volunteer
0
 
LVL 3

Expert Comment

by:neostudio
Comment Utility
Thanks In Advance pnh73






==========================================
Ruslan K. Abu Zant
phpX(c) CEO
http://www.phpx.info/
PHP Xperts Community
public@phpx.info
==========================================
Learn How To Ask Questions And Open Discussion Threads
http://catb.org/~esr/faqs/smart-questions.html
==========================================
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now