Recent

Author Topic: CD Eject  (Read 10243 times)

J-G

  • Hero Member
  • *****
  • Posts: 953
CD Eject
« on: February 21, 2019, 04:42:25 am »
I've searched the standard components but don't see anything that I think might be used to open a CD/DVD Player.

I know that it can be done via software - I just don't have any idea how.

The issue is that I'm about to build a new system which will be a 'Home Theatre' type PC with a slot-feed DVD Drive and the case doesn't have an [Eject] button - just a slot, so I need to provide a software solution and I'd rather write one myself than use a utility from an unknown source.
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

440bx

  • Hero Member
  • *****
  • Posts: 3946
Re: CD Eject
« Reply #1 on: February 21, 2019, 05:18:07 am »
I know that it can be done via software - I just don't have any idea how.
Check the alternative (2nd answer) found at https://stackoverflow.com/questions/1449410/programatically-ejecting-and-retracting-the-cd-drive-in-vb-net-or-c-sharp/1449438#1449438
the code is C# but is quite easy to translate to Pascal.

HTH.
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

balazsszekely

  • Guest
Re: CD Eject
« Reply #2 on: February 21, 2019, 06:11:33 am »
Windows:
Code: Pascal  [Select][+][-]
  1. uses mmsystem;
  2.  
  3. procedure TForm1.Button1Click(Sender: TObject);
  4. begin
  5.   mciSendString('Set cdaudio door open wait', nil, 0, 0);
  6. end;
  7.  

Nix:
Code: Pascal  [Select][+][-]
  1. uses process;
  2.  
  3. procedure TForm1.Button1Click(Sender: TObject);
  4. var
  5.   AProcess: TProcess;
  6. begin
  7.   AProcess := TProcess.Create(nil);
  8.   try
  9.     AProcess.Executable:= 'eject';
  10.     AProcess.Options := AProcess.Options + [poWaitOnExit];
  11.     AProcess.Execute;
  12.   finally
  13.     AProcess.Free;
  14.   end;
  15. end;

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #3 on: February 21, 2019, 06:24:34 am »
Thanks for the response 440bx but since posting, I did a little more digging and found the answer in a post from Lestroso in April last year pointing to a Wiki article of May 2013 - albeit in German - and I've since written the routine which displays a permanent button at the bottom right of the screen - just above the task-bar.

I don't understand the logic but it does the job.

It's not flexible yet in that the drive letter is fixed but I may well work on it further so that on first run it asks for (or finds) the drive letter and thereafter shows only the borderless button.

Whilst I was typing this - GetMem has posted the same (very simple) code - Thanks.
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

440bx

  • Hero Member
  • *****
  • Posts: 3946
Re: CD Eject
« Reply #4 on: February 21, 2019, 08:08:14 am »
It's not flexible yet in that the drive letter is fixed but I may well work on it further so that on first run it asks for (or finds) the drive letter and thereafter shows only the borderless button.

Whilst I was typing this - GetMem has posted the same (very simple) code - Thanks.
You're welcome.  I'm pleased you found something that works for you. 

About the drive letter being fixed, there is an easy solution to that.  The API GetLogicalDrives gives you a bitmap (DWORD) of the drives installed, you can iterate through the bitmap (one bit at a time, each bit is a drive letter starting with A) using the API GetDriveType.  For every optical device locally  installed, it returns "DRIVE_CDROM".  Two API calls in a loop will tell you how many optical devices are installed and the letters assigned to them.  That way you don't have to hard code the CD ROM drive letter(s).

HTH.

ETA:

I thought you might want an example of how the above is done.  I attached a simple console program that does what I suggested and a screenshot showing what you should expect as output.




« Last Edit: February 21, 2019, 09:09:17 am by 440bx »
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #5 on: February 21, 2019, 01:40:37 pm »
Windows:
Code: Pascal  [Select][+][-]
  1. uses mmsystem;
  2. procedure TForm1.Button1Click(Sender: TObject);
  3. begin
  4.   mciSendString('Set cdaudio door open wait', nil, 0, 0);
  5. end;
  6.  
Thanks for your input GetMem but that is only part of the code that I found elsewhere and I can't see how the drive letter is assigned.

The Code I found has a preceding line :
Code: Pascal  [Select][+][-]
  1.   if MCISendString(PChar('Open '+Dr+': type cdaudio alias cdlw'),nil,0,0) = 0 then
...which does use the drive letter (Dr).

More to the point, using just your line doesn't do the job (on my system anyway).
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #6 on: February 21, 2019, 01:55:35 pm »
I thought you might want an example of how the above is done.  I attached a simple console program that does what I suggested and a screenshot showing what you should expect as output.
That is very useful 440bx - and I can understand most of the logic :)  -  which effectively means that I can go forward using at least the GetLogicalDrives call from which I can iterate with an 'If Found' logic, stopping as soon as the CD is located.

Of course it might be prudent to continue until the end in case there is more than one Optical Drive but that would also demand that the main program offers a second (or third??) Eject Button!!  Not beyond the wit of man but for my current need definitely 'over the top'.
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #7 on: February 21, 2019, 03:56:45 pm »
Really Solved !!

With the help of 440bx, I have a small .EXE (2.39Mb) which first finds the Drive Letter assigned to the Optical Drive and puts a small button on the desktop at the bottom right - just above the task-bar, taking full account of the screen resolution in use.

I don't understand some of the logic but am happy to accept that it works. Here is the full code:
Code: Pascal  [Select][+][-]
  1. unit EjectUnit;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows, Classes, StdCtrls, Forms, MMSystem;
  9.  
  10.  
  11. //  SysUtils, FileUtil, Controls, Graphics, Dialogs,
  12.  
  13.  
  14. type
  15.  
  16.   { TForm1 }
  17.  
  18.   TForm1 = class(TForm)
  19.     Label1: TLabel;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure Label1Click(Sender: TObject);
  22.   private
  23.     { private declarations }
  24.   public
  25.     { public declarations }
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. implementation
  32.  
  33. {$R *.lfm}
  34.  
  35. { TForm1 }
  36.  
  37. Var
  38.   DriveBitmap  : DWORD;
  39.   Found  : boolean;
  40.   Dr     : Packed array[0..3] of char;
  41.   DrType : UINT;
  42.   DrLet  : char;
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. Var
  46.   i : byte;
  47.   w,h : word;
  48. begin
  49.   w := screen.Width;
  50.   h := screen.Height;
  51.   Left := w-120;
  52.   Top  := h-65;
  53.  
  54.   DriveBitmap := GetLogicalDrives;
  55.  
  56.   ZeroMemory(@Dr, sizeof(Dr));     // initialize DriveLetter
  57.   lstrcpy(Dr, 'A:\');
  58.  
  59.   found := false;
  60.   i := 0;
  61.   while not found do
  62.     begin
  63.       Dr[0]  := char(ord('A')+i);
  64.       DrType := GetDriveType(Dr);
  65.       if DrType = 5 then
  66.         begin
  67.           found := true;
  68.           DrLet := Dr[0];
  69.         end
  70.       else
  71.         inc(i);
  72.     end;
  73. end;
  74.  
  75. procedure TForm1.Label1Click(Sender: TObject);
  76. begin
  77.   if MCISendString(PChar('Open '+DrLet+': type cdaudio alias cdlw'),nil,0,0) = 0 then
  78.     MCISendString('set cdlw door open wait',nil,0,0)
  79.   else
  80.     MCISendString('set cdlw door open wait',nil,0,0);
  81. end;
  82.  
  83. end.
  84.  


I don't understand what lines 56 & 57 do but without them, line 65 always returns '1' ?

The Label1Click (line 75) procedure looks odd since it appears to do the same thing whether or not line 77 returns True or False, but without both it only works the first time it is run.

It does not take account of the fact that an Optical Drive is not present but since I intend to use it only on systems which do have one I don't consider that important. :)
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: CD Eject
« Reply #8 on: February 21, 2019, 06:58:13 pm »
I don't understand what lines 56 & 57 do but without them, line 65 always returns '1' ?

Unless you initialize it, the array of char Dr contains garbage; since you're using it as a PChar, ZeroMemory() boths initialize it and ensures it ends in zero: lstrcpy then copies the 'A:\' to the first three places.

Quote
The Label1Click (line 75) procedure looks odd since it appears to do the same thing whether or not line 77 returns True or False, but without both it only works the first time it is run.

Because you don't send the MCI command to "close", the second and subsequent calls to "Open '+DrLet+': type cdaudio alias cdlw" fail: That's why it works as it does. As it is, you can simply disregard the return value of the first MCISendString() and replace all with just:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Label1Click(Sender: TObject);
  2. begin
  3.   MCISendString(PChar('Open '+DrLet+': type cdaudio alias cdlw'),nil,0,0) ;
  4.   MCISendString('set cdlw door open wait',nil,0,0);
  5. end;

Quote
It does not take account of the fact that an Optical Drive is not present but since I intend to use it only on systems which do have one I don't consider that important. :)

If it becomes important, the solution is easy: Add a check for found = false in your OnCreate handler, after the while not found ....

BTW, that while isn't sound: it'll keep going forever if it doesn't find a CD drive. This one is more robust:
Code: Pascal  [Select][+][-]
  1.   found := false;
  2.   i := 0;
  3.   {Keep going until found *or* until we pass "Z"}
  4.   while (not found) and (i < 26) do
  5.     begin
  6.       Dr[0]  := char(ord('A')+i);
  7.       DrType := GetDriveType(Dr);
  8.       if DrType = 5 then
  9.         begin
  10.           found := true;
  11.           DrLet := Dr[0];
  12.         end
  13.       else
  14.         inc(i);
  15.     end;
« Last Edit: February 21, 2019, 09:12:04 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #9 on: February 21, 2019, 08:40:49 pm »
Thanks Lucamar,

I've done very little work with pointers and your explanation is clear and concise!

Of course I needed to check for past 'Z'  :-[

I've also added a message in the event of no Optical Drive.

The MCI call is now good but your version must not have the last '= 0' since it is no longer a boolean test.
FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: CD Eject
« Reply #10 on: February 21, 2019, 09:04:24 pm »
The MCI call is now good but your version must not have the last '= 0' since it is no longer a boolean test.

Oops!  :-[
Copy/paste: never do it in haste! :)
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

440bx

  • Hero Member
  • *****
  • Posts: 3946
Re: CD Eject
« Reply #11 on: February 22, 2019, 01:14:05 am »
@Lucamar:

Thank you for explaining what those lines of code do.

Of course I needed to check for past 'Z'  :-[
I just want to mention a few things that have more to do with "programming style" than getting the information you need.

As you have already noticed having a construct such as
Code: Pascal  [Select][+][-]
  1. while not found ...
opens the possibility to an infinite loop - something "rarely" desirable.  That's why in the example I provided I used
Code: Pascal  [Select][+][-]
  1. for I := 0 to ord('Z') - ord('A') do ...
ord('Z') - ord('A') is the zero based count of letters between A and Z.  That loop is guaranteed to end and it doesn't process the superfluous bits in the bitmap (bits 26 through 31.)

if you want to exit the loop when the first CD drive is found simply add a test, such as
Code: Pascal  [Select][+][-]
  1. if DriveType = DRIVE_CDROM then break;
after getting the DriveType; (of course, you might want to either save the drive index  somewhere or change the procedure to function and return its index to the caller.) if you know the zero based index, char(index + ord('A')) yields the drive letter.

About the
Code: Pascal  [Select][+][-]
  1. ZeroMemory(@DriveLetter, sizeof(DriveLetter));
Lucamar's explanation is right on the money.  I just want to add that, in this particular case, it really isn't necessary because the call to
Code: Pascal  [Select][+][-]
  1. lstrcpy(DriveLetter, 'A:\');
not only puts the character sequence in there but, it also zero terminates it, therefore it overwrites the zeroes put in the variable by the call to ZeroMemory.  I've just gotten into the habit of initializing all the buffers to zeroes.  It prevents bugs (or makes them obvious) and it also makes debugging easier because you can tell at a glance what fields (e.g, in a  record) have been set by your program and which ones have not.  It also prevents having non-null terminated strings which are a common cause of buffer overruns.  It's a good habit.

Another suggestion I'd like to make, use fullnames (or close to fullnames) for variables.  having "Dr" for drive, saves typing but, doesn't help code readability. Good code is readable, which makes it easy to understand.  Both, desirable features obtained with very little extra effort on the programmer's part.

« Last Edit: February 22, 2019, 01:38:25 am by 440bx »
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

J-G

  • Hero Member
  • *****
  • Posts: 953
Re: CD Eject
« Reply #12 on: February 22, 2019, 01:28:38 pm »
Very useful comments 440bx - exactly why I subscribe to this forum, to gain an education :)

Whilst I agree with virtually everything, I am conscious that I am often accused of being overly complex in my speech, so the construct :
Code: Pascal  [Select][+][-]
  1. for I := 0 to ord('Z') - ord('A') do ...

seems (to me) 'over the top' - particularly since I want to exit the loop as soon as there is a positive result. I also don't like the use of 'Break' (or GoTo) - but that is personal and I wouldn't berate anyone for using it.

As far as 'Programming Style' is concerned, yes I can see that 'Drive' is more readable than 'Dr' but in my defence I do use DrType, DrLet etc. as well and, now I have tidied up the code, the global variables declaration is:
Code: Pascal  [Select][+][-]
  1. Var
  2.   Dr     : Packed array[0..3] of char;
  3.   DrMap  : DWORD;
  4.   DrType : Byte;
  5.   DrLet  : Char;
  6.   Found  : Boolean;

So I find that perfectly legible.

You will no doubt notice that I have changed DrType from UINT to Byte.

I was not aware that you could specify 'Unsigned Integer' (it doesn't appear in table 3.2 'Predefined Integer Types'  - - -  mind you, neither does DWORD ??? ) and in this case the possible value is in the range 0..6 so Byte is adequate.

I've removed the 'ZeroMemory' line without problem. When testing, I added that in prior to 'lstrcpy' to see what caused the not working on second attempt and didn't try without it once I'd succeeded.

FPC 3.0.0 - Lazarus 1.6 &
FPC 3.2.2  - Lazarus 2.2.0 
Win 7 Ult 64

440bx

  • Hero Member
  • *****
  • Posts: 3946
Re: CD Eject
« Reply #13 on: February 22, 2019, 02:27:45 pm »
You will no doubt notice that I have changed DrType from UINT to Byte.

I was not aware that you could specify 'Unsigned Integer' (it doesn't appear in table 3.2 'Predefined Integer Types'  - - -  mind you, neither does DWORD ??? ) and in this case the possible value is in the range 0..6 so Byte is adequate.
The change from UINT to byte is, I'll be nice and simply say that it's not a good idea.  The system can have more than 8 "devices" that have been assigned drive letters.  Using a byte means potentially throwing away 16 devices (I've seen a good  number of systems where the CDROM was assigned letter R or W).  Byte is definitely inadequate in this case, it borders on erroneous.  You should change that variable back to UINT.

The rest, is mostly a matter of style and will not comment on it, other than simply state what is already obvious, which is that I use a different style.

The only other thing I would suggest is that you give the "break" statement another chance.  It is often useful to simplify logic flow.

About the unsigned integer, DWORD, etc... when programming in the windows environment, there are more data types around than ice in the north pole (and that was before global warming) and, all they are, are synonyms of a handful of the basic types.  If there is one thing that C programmers really excel at is producing data types (which the compiler excels at ignoring.... chuckle..  in fairness, C++ improved that over C quite a bit.)

here is another way of writing the for loop I used that you may like better and may not consider to be "over the top"
Code: Pascal  [Select][+][-]
  1. const
  2.   // drive letter bit indexes
  3.   A =  0;  
  4.   Z = 25;  
  5.  ...
  6. begin
  7.   for I in [A..Z] do
  8.   etc
  9. end;


(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: CD Eject
« Reply #14 on: February 22, 2019, 04:47:16 pm »
I have this set of functions.

Code: Pascal  [Select][+][-]
  1. type
  2.  
  3.   TDriveType = (dtUnknown, dtNoRootDir, dtRemovable, dtFixed, dtRemote, dtCdrom, dtRamDisk);
  4.   TDriveTypes = set of TDriveType;
  5.  
  6.  
  7. function GetDriveType(ADrive: Char): TDriveType;
  8. var
  9.   WinDriveType: UINT;
  10. begin
  11.   WinDriveType := Windows.GetDriveType(PChar(LowerCase(ADrive+':\')));
  12.   case WinDriveType of
  13.     DRIVE_UNKNOWN: Result := dtUnknown;
  14.     DRIVE_NO_ROOT_DIR: Result := dtNoRootDir;
  15.     DRIVE_REMOVABLE: Result := dtRemovable;
  16.     DRIVE_FIXED: Result := dtFixed;
  17.     DRIVE_REMOTE: Result := dtRemote;
  18.     DRIVE_CDROM: Result := dtCdrom;
  19.     DRIVE_RAMDISK: Result := dtRamDisk;
  20.     else Result := dtUnknown;
  21.   end; //case
  22. end;
  23.  
  24.  
  25. function DiskInDrive(Drive: Char): Boolean;
  26. var
  27.   ErrorMode: word;
  28. begin
  29.   { maak er een hoofdletter van }
  30.   Drive := UpCase(Drive);
  31.   if not (Drive in ['A'..'Z']) then
  32.     raise EConvertError.Create('Geen geldige stationsaanduiding: '+Drive+':');
  33.   { schakel kritieke fouten uit }
  34.   ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  35.   try
  36.     { drive 1 = a, 2 = b, 3 = c, etc. }
  37.     if DiskSize(Ord(Drive) - Ord('A') + 1) = -1 then
  38.       Result := False
  39.     else
  40.       Result := True;
  41.   finally
  42.     { restore old error mode }
  43.     SetErrorMode(ErrorMode);
  44.   end;
  45. end;
  46.  
  47. function GetAvailableDrives(DiskMustBeInDrive: Boolean = False): TSysCharSet;
  48. var
  49.   D, Mask: DWORD;
  50.   C: Char;
  51. begin
  52.   Result := [];
  53.   D := GetLogicalDrives;
  54.   for C := 'A' to 'Z' do
  55.   begin
  56.     Mask := (1 shl (Ord(C) - Ord('A')));
  57.     if (Mask and D) = Mask then
  58.     begin
  59.       if (not DiskMustBeInDrive) or DiskInDrive(C) then
  60.       Include(Result, C);
  61.     end;
  62.   end;
  63. end;  
  64.  
  65.  

In one of my components I use it to fill a combobox with all available removable disks:

Code: Pascal  [Select][+][-]
  1. procedure TFSICustomDriveComboBox.RefreshDriveList;
  2. var
  3.   C: Char;
  4.   ADriveType: TDriveType;
  5. begin
  6. ...
  7.   for C in GetAvailableDrives(FMountedDrivesOnly) do //FMountedDrivesOnly is a boolean
  8.   begin
  9.     ADriveType := GetDriveType(C);
  10.     if ADriveType in DriveTypes then  //DriveTypes is a property of this component [dtCDRom] would do for you
  11.       Items.Add(C + ':\');
  12.   end;
  13. end;

Bart

 

TinyPortal © 2005-2018