Solved

How to lock the cd-rom door?

Posted on 1998-08-04
23
1,013 Views
Last Modified: 2010-05-19
How can i lock the cd-rom door using delphi codes?

Some samples... please

Thanks for your time!!!

           
                          KORT77
0
Comment
Question by:kort77
  • 7
  • 6
  • 5
  • +4
23 Comments
 
LVL 8

Expert Comment

by:ZifNab
ID: 1359712
kort77,

the only possible solution I could find till know was, capturing the WM_DEVICECHANGE message and then give some message that it isn't allowes (blah, blah), and then again close the cd-tray, see my freeware component at :

http://www.delphi.magsoft.com.pl/Download/cdevents.zip


I read, there should be a really good solution, but I can't get it myself to work!

here are the code snippets I had so far, maybe you've more luck! If so, let me know of it!

Snippet 1
---
[this is supposed to work! Have you got some luck? - Zif]

Try this...

const
     VWIN32_DIOC_DOS_IOCTL = 1;
     VWIN32_DIOC_DOS_INT13 = 4;

procedure TForm1.Button1Click(Sender: TObject);
  type
   PDIOC_REG = ^TDIOC_Registers;
   TDIOC_Registers = record
     Reg_EBX, Reg_EDX, Reg_ECX, Reg_EAX,
     Reg_EDI, Reg_ESI, Reg_Flags : DWORD
   end;
Var I, W: dWord;
    WBuffer: array[0..512 * 18] of byte;
    Reg: TDIOC_Registers;
    Result: Boolean;
    cb: dword;
begin
  Device:= CreateFile('\\.\vwin32',0, FILE_SHARE_READ or
                      FILE_SHARE_WRITE, nil, 0,
FILE_FLAG_DELETE_ON_CLOSE, 0);
// Locking...

  reg.reg_EAX:= $440D;
  reg.reg_EBX:= $0000; // BL $00 to $7F for Floppy, $80 to $FF for
Hard-disk
  reg.reg_ECX:= $084B;
  reg.reg_EDX:= $0000;
  Result:= DeviceIoControl(Device, VWIN32_DIOC_DOS_IOCTL, @reg,
sizeof(reg),
                           @reg, sizeof(reg), cb, nil);
  if ((Result = False) or ((reg.reg_Flags and $0001) = 1)) then
    ShowMessage('Lock failure...');

// Unlocking

  reg.reg_EAX:= $440D;
  reg.reg_EBX:= $0000; // BL $00 to $7F for Floppy, $80 to $FF for
Hard-disk
  reg.reg_ECX:= $086B;
  reg.reg_EDX:= $0000;
  Result:= DeviceIoControl(Device, VWIN32_DIOC_DOS_IOCTL, @reg,
sizeof(reg),
                           @reg, sizeof(reg), cb, nil);
  if ((Result = False) or ((reg.reg_Flags and $0001) = 1)) then
    ShowMessage('Unlock failure...');

  CloseHandle(Device);

end;

See too: Interrupt 21h Function 440Dh Minor Code 6Bh Unlock Physical
Volume, and
 Interrupt 21h Function 440Dh Minor Code 4Bh Lock Physical Volume in
Win32.HLP

Good luck...
------------

Snippet 2
---------------
you can try the following code. Perhaps it will work on Windows 95, i tried
it on my CD-ROM drive on NT 4 (not logged in as admin) and the lock failed.
Since i'm too lazy to boot into Win95 or log in as admin for the test you
have to do the hard work <g>. I just hope i translated the IOCTL codes
correctly, this specific header is an absolute mess of nested macros.

procedure TForm1.Button2Click(Sender: TObject);
const
  { from winioctl.h }
  FILE_DEVICE_DISK = $00000007;
  FILE_DEVICE_FILE_SYSTEM = $00000009;
  METHOD_BUFFERED = 0;
  IOCTL_DISK_BASE = FILE_DEVICE_DISK;
  FILE_READ_ACCESS = 1; // file & pipe
  FILE_ANY_ACCESS = 0;

  IOCTL_DISK_EJECT_MEDIA = ( IOCTL_DISK_BASE shl 16) or ( $0202 shl 14) or
( METHOD_BUFFERED shl 2) or FILE_READ_ACCESS ;
  FSCTL_LOCK_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or (
6 shl 14) or ( METHOD_BUFFERED shl 2) or FILE_ANY_ACCESS ;
  FSCTL_UNLOCK_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or (
7 shl 14) or ( METHOD_BUFFERED shl 2) or FILE_ANY_ACCESS ;

var
  drivehandle: THandle;
  dummy: DWORD;
begin
  drivehandle := CreateFile(
                   '\\.\F:',
                   GENERIC_READ,
                   FILE_SHARE_READ or FILE_SHARE_WRITE,
                   Nil,
                   OPEN_EXISTING,
                   FILE_ATTRIBUTE_NORMAL,
                   0 );
  If drivehandle <> INVALID_HANDLE_VALUE Then Begin
    If DeviceIOControl(
         drivehandle,
         FSCTL_LOCK_VOLUME,
         Nil,
         0,
         Nil,
         0,
         dummy,
         Nil)
    Then Begin
      label2.caption := 'locked';
      If DeviceIOControl(
           drivehandle,
           IOCTL_DISK_EJECT_MEDIA,
           Nil,
           0,
           Nil,
           0,
           dummy,
           Nil)
      Then
        label1.caption := 'Done'
      Else
        label1.caption := 'Failed, '+SysErrorMessage(GetLastError);
      DeviceIOControl(
         drivehandle,
         FSCTL_UNLOCK_VOLUME,
         Nil,
         0,
         Nil,
         0,
         dummy,
         Nil);
    End
    Else
      label1.caption := 'Lock Failed, '+SysErrorMessage(GetLastError);

    closeHandle( drivehandle );
  End
  Else
    label1.caption := 'CreateFile failed, '+ SysErrorMessage(GetLastError);

end;
------------

Well I also tried to do it with DeviceIOControl, and FSCTL_LOCK_VOLUME, ... but to no avail. Reading the manual about this function though it should be possible.

I'll give another try, if you try these things also and you let me know of the results.

Regards, Zif.

0
 
LVL 7

Expert Comment

by:BlackMan
ID: 1359713
There is no API / MCI command to lock the door, so I don't think that you'll find any generic code...
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1359714
Black, I thought do too, but some said the above code should work, but I had no luck so I believe you for 99,9%.

The way I first proposed, checking for WM_DEVICECHANGE, if it is the open message, then just close the door again, is a solution.

Regards, Zif.
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1359715
You could use a hidden mplayer, and if the door opens you close or something lie that!

//Vik
0
 
LVL 20

Accepted Solution

by:
Madshi earned 300 total points
ID: 1359716
Sorry, ZifNab, you're quite near to it...
Here's my complete solution:

type TOperatingSystem = (osWin311, osWin95, osWin98, osWinNT, osUnknown);
function GetOperatingSystem : TOperatingSystem;
var os1 : TOSVersionInfo;
begin
  os1.dwOSVersionInfoSize:=sizeOf(os1); GetVersionEx(os1);
  case os1.dwPlatformID of
    VER_PLATFORM_WIN32s        : result:=osWin311;
    VER_PLATFORM_WIN32_WINDOWS : if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=0) then
                                   result:=osWin95
                                 else if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=10) then
                                   result:=osWin98
                                 else result:=osUnknown;
    VER_PLATFORM_WIN32_NT      : result:=osWinNT;
    else                         result:=osUnknown;
  end;
end;

function DosIOCTL(action: integer; drive: char) : boolean;
 function ldoit : boolean;
 var hDevice : THandle;
     cb      : DWORD;
     s1,s2   : string;
     reg     : record
                 reg_EBX, reg_EDX, reg_ECX, reg_EAX : DWORD;
                 reg_EDI, reg_ESI, reg_Flags        : DWORD;
               end;
     pb      : packed record
                 operation, NumLocks : BYTE;
               end;
 const VWIN32_DIOC_DOS_IOCTL = 1;
 begin
   result:=false;
   drive:=Upcase(drive); if (drive<'A') or (drive>'Z') then exit;
   case action of
     0: begin
          s2:='Sperren des Volumes "'+drive+':".';
          reg.reg_EAX:=$440D;                        // IOCTL for block devices
          reg.reg_EBX:=ord(drive)-ord('A')+1;        // zero-based drive ID
          reg.reg_ECX:=$0848;                        // Lock / Unlock Volume command
          reg.reg_EDX:=DWORD(@pb);                   // Paramblock
          pb.operation:=0;                           // Lock
        end;
     1: begin
          s2:='Entsperren des Volumes "'+drive+':".';
          reg.reg_EAX:=$440D;                        // IOCTL for block devices
          reg.reg_EBX:=ord(drive)-ord('A')+1;        // zero-based drive ID
          reg.reg_ECX:=$0848;                        // Lock / Unlock Volume command
          reg.reg_EDX:=DWORD(@pb);                   // Paramblock
          pb.operation:=1;                           // Unlock
        end;
   end;
   reg.reg_Flags:=1;                                       // assume error (carry flag set)
   hDevice:=CreateFile('\\.\vwin32', 0, 0, nil, 0, 0, 0);
   if hDevice=INVALID_HANDLE_VALUE then begin
     // error
     exit;
   end;
   try
     s1:='';
     if (not DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
                             @reg, sizeof(reg), @reg, sizeof(reg), cb, nil)) or
        odd(reg.reg_Flags) then begin
       // error
       exit;
     end;
     result:=true;
   finally CloseHandle(hDevice) end;
 end;
begin
  result:=ldoit; if not result then result:=ldoit;
end;

function WinIOCTL(action: integer; drive: char) : boolean;
var i1 : integer;
    h1 : THandle;
    b1 : integer;
    w1 : DWORD;
    s1 : string;
const                                 // DeviceType      Access        Function
  IOCTL_STORAGE_MEDIA_REMOVAL : DWORD = ($2D shl 16) or (1 shl 14) or ($201 shl 2);
  IOCTL_STORAGE_EJECT_MEDIA   : DWORD = ($2D shl 16) or (1 shl 14) or ($202 shl 2);
  FSCTL_LOCK_VOLUME           : DWORD = ( $9 shl 16) or (0 shl 14) or (  $6 shl 2);
  FSCTL_UNLOCK_VOLUME         : DWORD = ( $9 shl 16) or (0 shl 14) or (  $7 shl 2);
begin
  result:=false;
  drive:=Upcase(drive); if (drive<'A') or (drive>'Z') then exit;
  case action of
    0: s1:=     'Sperren des Volumes "'+drive+':".';
    1: s1:=  'Entsperren des Volumes "'+drive+':".';
  end;
  i1:=GENERIC_READ; if action=5 then i1:=i1+GENERIC_WRITE;
  h1:=CreateFile(PChar('\\.\'+drive+':'), i1,
                 FILE_SHARE_READ+FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if h1=INVALID_HANDLE_VALUE then begin
    // error
    exit;
  end;
  try
    case action of
      0,1: begin
             b1:=1-action;
             result:=DeviceIOControl(h1, IOCTL_STORAGE_MEDIA_REMOVAL, @b1,
                                     SizeOf(b1), nil, 0, w1, nil);
           end;
    end;
  finally CloseHandle(h1) end;
end;

function LockDrive(drive: char) : boolean;
begin
  result:=false;
  drive:=UpCase(drive);
  if not (drive in ['A'..'Z']) then exit;
  case GetOperatingSystem of
    osWin95,osWin98: result:=DosIOCTL(0,drive);
    osWinNT:         result:=WinIOCTL(0,drive);
  end;
end;

function UnlockDrive(drive: char) : boolean;
begin
  result:=false;
  drive:=UpCase(drive);
  if not (drive in ['A'..'Z']) then exit;
  case GetOperatingSystem of
    osWin95,osWin98: result:=DosIOCTL(1,drive);
    osWinNT:         result:=WinIOCTL(1,drive);
  end;
end;
0
 

Author Comment

by:kort77
ID: 1359717
Sometimes it doesn´t  work... but it´s really good!  :)
0
 
LVL 1

Expert Comment

by:EmmDieh
ID: 1359718
Madshi's answer is nearly correct. For unlocking the drive
you have to repeat the unlock-op until the lock counter is
zero.
See the following KB-Articles for details:
Q125713 - HOWTO: Opening Volumes Under Windows 95
Q168180 - HOWTO: Eject Removable Media on Windows 95:
Q165721 - HOWTO: Eject Removable Media in Windows NT

0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1359719
KB articles?
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1359720
To EmmDieh,

you're right, but sometimes you call lock two times, then unlock one time and you want it to be locked still...
Unfortunately that works not always, so perhaps it would be better to unlock the drive entirely, like you said.
0
 
LVL 1

Expert Comment

by:EmmDieh
ID: 1359721
Madshi, your right, too. But I wanted to express that there
is such a thing as a lock counter. I wouldn't have thought
it is.
ZifNab, KB means Knowledge Base, Microsofts invaluable
answer database. Goto Microsoft (or Kleinstweich here in Germany)
http://www.microsoft.com/Support/ click on support online
and type in your request.
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 1359722
EmmDieh, Thanks.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Expert Comment

by:perkley
ID: 2820108
I can get Madshi's code to Lock my CD-ROM drawer (I am on Windows 98 machine), but it doesn't seem to want to unlock.

EmmDieh, you mentioned something about the lock counter.  Could you please show the code that would need to be updated to do this.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2820122
It works alright for me. Which API call fails and with which error code?
0
 

Expert Comment

by:perkley
ID: 2820136
I do not know what fails.  It does not give an error at all, my CD-ROM just won't open anymore.  I can not get it to unlock it.
0
 

Expert Comment

by:perkley
ID: 2820139
Just to make sure this is the correct way of running your functions:

procedure TForm1.Button1Click(Sender: TObject);
begin
    LockDrive('F');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    UnlockDrive('F');
end;

F is my CD Drive letter.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2820150
Replace the DeviceIoControl part in DosIoctl with this one:

     s1:='';
     if (not DeviceIoControl(hDevice, VWIN32_DIOC_DOS_IOCTL,
                             @reg, sizeof(reg), @reg, sizeof(reg), cb, nil)) or
        odd(reg.reg_Flags) then begin
       case reg.reg_EAX of
         $01: s1:='Diese Funktion ist nicht unterstützt.';
         $05: s1:='Zugriff verweigert oder kein Volume eingelegt.';
         $B0: s1:='Das Volume im Laufwerk ist nicht gesperrt.';
         $B1: s1:='Das Volume im Laufwerk ist gesperrt.';
         $B2: s1:='Das Volume ist nicht "Removable".';
         $B4: s1:='Der Sperrzähler ist übergelaufen.';
         $B5: s1:='Die Herauswerfen-Anforderung ist fehlgeschlagen.';
       end;
       if s1='' then s1:='windows error ' + IntToStr(GetLastError);
       MessageBox(0, pchar(s1), 'error', 0);
       exit;
     end;

Or is it the CreateFile call that fails? Please trace through the code when the local function "ldoit" is called the second time.
0
 

Expert Comment

by:perkley
ID: 2820173
I replaced the code, and then I get this message twice:

Zugriff verweigert oder kein Volume eingelegt.

I tried tracing the code, but I am unsure what I am looking for that would help you solve the problem.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2820200
Well, that means ACCESS_DENIED. I just don't know why. It works alright on my win98 PC.
I looked through the code again and found that I added something in my code. Please add this directly after both "pb.operation := ..." calls:

pb.numLocks := 0;

If that still doesn't help, I'm out of ideas...
0
 

Expert Comment

by:perkley
ID: 2820221
Okay, thanks for your help.  That still did not fix it, I will try it on some other computers around here and see what is going on.  I don't have anything special either, I just have Win98, 32x Panasonic CD-ROM, AMD-Processor, and that's about it.  I'll try to trace it more and see if I can see where it is having the fit.

One thought that I will check out: I did not have a CD in the drive when I locked it, maybe that causes it not to open again.
0
 

Expert Comment

by:perkley
ID: 2820234
Hmm, I switched the pb.numLocks to be before the pb.Operation, and then it unlocked it.  I don't know if this had anything to do with it, or if it just finally worked.  I don't see why it would, but anyway, it finally unlocked.  Strange.
0
 
LVL 8

Expert Comment

by:ZifNab
ID: 2820280
perkley, you won't be able to unlock it if you've locked it without a cd-rom...

If you've locked it with a CD-rom, it just unlock ok.

Zif.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2820295
Hi Zif...  :-)

Yep, Zif's right. You didn't mention that you had no CD-ROM in it...

Whether pb.Operation is before or after pb.numLocks can't have any effect on this stuff. At least I can't image that.
0
 

Expert Comment

by:perkley
ID: 2822155
Yep, it was the CD problem.  I just didn't imagine that it would cause it not to unlock.  I was just trying the code, didn't think to put a CD in it.  Anyway, great code, thanks.
0

Featured Post

IT, Stop Being Called Into Every Meeting

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!

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
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.

746 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

12 Experts available now in Live!

Get 1:1 Help Now