Delphi 如何锁定光驱?

Question

NT下面还是可以实现。这是一个函数
{****************************************************************************
  函数: LockCDROM
  作者: BlackFox
  日期: 2002-5-6
  功能: 锁定一个光驱
  入口: CONST strName: STRING; CONST lock: boolean
        strName。光驱盘符
        lock.是否锁定
  返回: boolean
        成功返回TURE
****************************************************************************}function LockCDROM(const strName: string; const lock: boolean): boolean;
const
  IOCTL_STORAGE_MEDIA_REMOVAL = 2967556;var
  CDRomHandle: thandle;
  Remove: TPREVENT_MEDIA_REMOVAL;
  CB: dword;
  OverLapped: _OVERLAPPED;begin  if not GetCDROMOpen(strName) then
    self.OpenOrClose(strName);  CDRomHandle := CreateFile(pchar('\\.\' + CurrentCDROM[1] + ':'), GENERIC_READ, FILE_SHARE_READ,
    nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);  if CDRomHandle = 0 then
    Exit;
  ZeroMemory(@OverLapped, sizeof(OverLapped));
  Remove.PreventMediaRemoval := lock;
  result := DeviceIoControl(CDRomHandle, IOCTL_STORAGE_MEDIA_REMOVAL,
    @Remove, sizeof(Remove), nil, 0,
    CB, @OverLapped);
  // '释放光驱句柄
  CloseHandle(CDRomHandle);end;
这也只是锁住光驱门而以。。呵呵。我可以提供一个思路。你可以用IShellExecuteHook实现一个外挂。
在
function TShell.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
begin if ShellExecuteInfo.lpFile是光驱下的文件 then
 begin
        MessageBox(0,PCHAR('拒绝访问'),PCHAR(''),MB_OK);
result:=S_FALSE;
exit;
end;
        result:=S_OK;
end;

Answer 1

//只工作在win9x下，对nt无效
type 
TRegDWord = packed record 
case Integer of 
0 : (Lo,Hi : Word); 
1 : (X : DWord); 
end; TDevIoCtl_Reg = packed record 
Reg_BX : DWord; 
Reg_DX : DWord; 
Reg_CX : DWord; 
Reg_AX : DWord; 
Reg_DI : DWord; 
Reg_SI : DWord; 
Reg_Flags : DWord; 
end; TParamBlock = packed record 
PB_Operation : Byte; 
PB_NumLocks : Byte; 
end; const 
VWin32_DIOC_DOS_IoCtl = 1; // interrupt 21h function DriveCharToNum(Drivechar : Char) : Word; 
begin 
DriveChar:=Upcase(DriveChar); 
Result:= Ord(DriveChar)-Ord('A')+1; 
end; function AccessDevice(Var Reg : TDevIoCtl_Reg) : Integer; 
var 
DevIoHandle : THandle; 
BytesReturned : DWord; 
Res : Boolean; 
begin 
Result:=-1; 
Reg.Reg_Flags:=$0001; 
DevIoHandle := 
CreateFile('\\.\vwin32',0,0,nil,0,File_Flag_Delete_On_Close,0); 
if DevIoHandle <> Invalid_Handle_Value then begin 
Res := 
DeviceIoControl(DevIoHandle,VWin32_DIOC_DOS_IoCtl,@Reg,SizeOf(Reg),@Reg,SizeOf(Reg),BytesReturned,nil); if (Res and ((Reg.Reg_Flags and $0001) = 0)) Then Result:=0 
else Result:=Reg.Reg_AX; 
CloseHandle(DevIoHandle); 
end; 
end; function DriveEject(DriveChar : Char) : Integer; 
Var 
Reg : TDevIoCtl_Reg; 
begin 
with Reg do begin 
Reg_AX := $440d; 
Reg_CX := $0849; 
Reg_BX := DriveCharToNum(Drivechar); 
Reg_Flags := $0001; 
end; 
Result:=AccessDevice(Reg); 
end; function DriveLock(DriveChar : Char) : Integer; 
Var 
Reg : TDevIoCtl_Reg; 
Param : TParamBlock; 
begin 
With Param DO begin 
PB_Operation:=0; 
PB_NumLocks :=0; 
end; 
with Reg do begin 
Reg_AX := $440d; 
Reg_BX := DriveCharToNum(Drivechar); 
Reg_CX := $0848; 
Reg_DX := Integer(@Param); 
end; 
Result:=AccessDevice(Reg); 
end; 
/////////////////////////////////////////
//对也nt有效
HANDLE h=CreateFile("\\\\.\\E:",GENERIC_READ,0,NULL,OPEN_EXISTING,0,NULL);
if(h==INVALID_HANDLE_VALUE)
  RaiseLastWin32Error();DWORD n;
PREVENT_MEDIA_REMOVAL s={true};
//要是开锁
//PREVENT_MEDIA_REMOVAL s={false};
if(!DeviceIoControl(h,IOCTL_STORAGE_MEDIA_REMOVAL,&s,sizeof s,NULL,0,&n,NULL))
  RaiseLastWin32Error();
CloseHandle(h);
///////////////////////////////////////
unit eLanCDRom;

Answer 2

{ You are free to use, modify and distribute this code }
{ as you like. But I ask you to send me a copy of new  }
{ versions. And please give me credit when you use     }
{ parts of my code in other components or applications.}{ ==================================================== }
{ Properties, Methods and Events ：                               }
{ ---------------------------------------------------- }
{ DrvName
  MonitorState
  Close
  Eject
  StartMonitor
  EndMonitor
  Lock
  StartOnMonitor
  OnDiscArrive
  OnDiscRemove{ ---------------------------------------------------- }
interface
uses
  MMSystem, Classes, Messages, Controls, SysUtils, Windows,
  WinProcs, Forms;const
   DBT_DeviceArrival       =32768;
   DBT_DeviceRemoveComplete=32772;
   DBT_DEVTYP_OEM          =1;    //OEM- or IHV-defined device type
   DBT_DEVTYP_VOLUME       =2;    //Logical volume.
   DBT_DEVTYP_PORT         =3;    //Port device (serial or parallel)
   DBTF_MEDIA              =1;type
  DEVIOCTL_REGISTERS = packed record
    reg_EBX   : DWORD;
    reg_EDX   : DWORD;
    reg_ECX   : DWORD;
    reg_EAX   : DWORD;
    reg_EDI   : DWORD;
    reg_ESI   : DWORD;
    reg_Flags : DWORD;
  end;
  PDEVIOCTL_REGISTERS = ^DEVIOCTL_REGISTERS;{  MID = packed record //Interrupt 21h Function 440Dh Minor Code 66h
    midInfoLevel : WORD  ;
    midSerialNum : DWORD ;
    midVolLabel : array[0..10] of byte;
    midFileSysType: array[0..8] of byte;
  end;
  PMID = ^ MID;}  PARAMBLOCK = packed record
    Operation : WORD;     //Interrupt 21h Function 440Dh Minor Code 48h
    NumLocks  : WORD;
  end;const
  WIN95_IOCTL_DEV = '\\.\vwin32';
  VWIN32_DIOC_DOS_IOCTL  = 1;Type
   TCDRomAct  = (eEject, eClose);
   TMonitorState = (eMonitorOn, eMonitorOff);   TDEV_BROADCAST_VOLUME = record
      dbcv_Size      :Byte ;
      dbcv_DeviceType:Integer ;
      dbcv_Reserved  :Integer ;
      dbcv_UnitMask  :Integer ;
      dbcv_Flags     :Smallint ;
   end;
   PDEV_BROADCAST_VOLUME =^TDEV_BROADCAST_VOLUME;   TCDNotifyEvent = procedure(Sender: TObject;Drv:String) of object;   TeLanCDRomMonitor = Class(TComponent)
   private
      MyOwner        : TForm;
      MyOwnerHandle  : THandle;
      fDrvName       : String;
      fOnDiscArrive  : TCDNotifyEvent;
      fOnDiscRemove  : TCDNotifyEvent;
      fMonitorState  : TMonitorState;
      fStartOnMonitor: Boolean;
      fLocked        : Boolean;
      //fP             : PDEV_BROADCAST_VOLUME;
      function   GetDrvName(fDrvMask:Integer):String;
      procedure  CDRomAction(Action:TCDRomAct);
      procedure  SetStartOnMonitor(const Value: Boolean);
      procedure  DoLockCDRom(const fLock:Boolean; const Drv:String);
   protected
      OldWndProc : TFarProc;
      NewWndProc : Pointer;
      procedure    HookWin;
      procedure    UnhookWin;
      procedure    HookWndProc(var AMsg: TMessage);
   public
      procedure   Eject;
      procedure   Close;
      procedure   Lock; overload;
      procedure   Lock(const DrvName:Char);overload;
      procedure   Unlock;overload;
      procedure   Unlock(const DrvName:Char);overload;
      procedure   StartMonitor;
      procedure   EndMonitor;
      property    MonitorState :TMonitorState read fMonitorState;
      property    DrvName : String read FDrvName;
      constructor Create(AOwner:tComponent);Override;
      destructor  Destroy;Override;
      procedure   Loaded;override;
   published
      property    OnDiscArrive:TCDNotifyEvent read fOnDiscArrive Write fOnDiscArrive;
      property    OnDiscRemove:TCDNotifyEvent read fOnDiscRemove write fOnDiscRemove;
      property    StartOnMonitor:Boolean  read FStartOnMonitor write SetStartOnMonitor default True;
      property    Locked:boolean read fLocked;
   end;   procedure Register;implementationprocedure Register;
begin
  RegisterComponents('eLan Soft',[TeLanCDRomMonitor]);
end;{ TeLanCDRom }procedure TeLanCDRomMonitor.CDRomAction(Action: TCDRomAct);
var
   MCIDevice:TMCI_Open_Parms;
begin
   MCIDevice.lpstrDeviceType :='CDAudio';
   mciSendCommand(0,MCI_OPEN,MCI_OPEN_TYPE ,Integer(@MCIDevice ));
   case Action of
        eEject: mciSendCommand(MCIDevice.wDeviceID,MCI_SET, MCI_SET_DOOR_OPEN ,0);
        eClose: mciSendCommand(MCIDevice.wDeviceID,MCI_SET, MCI_SET_DOOR_CLOSED ,0);
   end;
   mciSendCommand(MCIDevice.wDeviceID,MCI_CLOSE,0,0);
end;procedure TeLanCDRomMonitor.Close;
begin
   CDRomAction(eClose);
end;procedure TeLanCDRomMonitor.Eject;
begin
   CDRomAction(eEject);
end;

Answer 3

constructor TeLanCDRomMonitor.Create(AOwner: tComponent);
var I:Integer;
begin
   for I:=0 to AOwner.ComponentCount -1 do
     if AOwner.Components[I] is Self.ClassType then
       raise Exception.Create(
         Self.ClassName + ' component Duplicated');   inherited Create(aOwner);
   with AOwner as TForm do
   begin
     MyOwner := TForm(AOwner);  { My pointer to my owner form }
     MyOwnerHandle := MyOwner.Handle;
     //New(fP);
     FStartOnMonitor :=true;
   end;  fLocked:=False;
end;destructor TeLanCDRomMonitor.Destroy;
begin
  if fLocked then Unlock;
  if fMonitorState = eMonitorOn then UnhookWin;
  //if Assigned(fP) then Dispose(fP);
  inherited Destroy;  {Call default processing.}
end;procedure TeLanCDRomMonitor.Loaded;
begin
  if (fStartOnMonitor) and not (csDesigning in MyOwner.ComponentState) then
  begin
    HookWin;
    fMonitorState :=eMonitorOn;
  end
  else
    fMonitorState :=eMonitorOff;end;procedure TeLanCDRomMonitor.EndMonitor;
begin
   if fMonitorState = eMonitorOn then
   begin
      UnhookWin;
      fMonitorState := eMonitorOff;
   end;
end;procedure TeLanCDRomMonitor.StartMonitor;
begin
   if fMonitorState = eMonitorOff then
   begin
      HookWin;
      fMonitorState :=eMonitorOn;
   end;
end;function TeLanCDRomMonitor.GetDrvName(fDrvMask: Integer): String;{ 用于将 TDEV_BROADCAST_VOLUME 结构的 dbcv_unitmask 成员}
{ 掩码转换成 000001 格式的字符串，按顺序分别代表 A、B、 }
{ D、… 驱动器，其中 1 表示该对应的驱动器发生变化。     }
{ 在弹出或关闭光驱时返回光驱所在的盘符                  }
{ ----------------------------------------------------- }
var
  TemStr:string;
  iPos  :integer;
begin
  //MessageBox(0,pchar(IntToStr(fdrvmask)),'',mb_OK);
  while fDrvMask>1 do
  begin
    TemStr   := TemStr+IntToStr(fDrvMask mod 2);
    fDrvMask := fDrvMask div 2;
  end;
  TemStr := TemStr+IntToStr(fDrvMask);
  { 找到第一个 1 出现的位置 }
  iPos   := Integer(StrPos(PChar(TemStr),'1')) - Integer(Pchar(TemStr));
  iPos   := iPos+65;           {A 的ASCII值为65}
  Result := Char(iPos)+':\';
end;procedure TeLanCDRomMonitor.SetStartOnMonitor(const Value: Boolean);
begin
  //if (csDesigning in MyOwner.ComponentState) then
  FStartOnMonitor := Value;
end;procedure TeLanCDRomMonitor.HookWin;
begin
  OldWndProc := TFarProc(GetWindowLong(MyOwnerHandle, GWL_WNDPROC));
  NewWndProc := MakeObjectInstance(HookWndProc);
  SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(NewWndProc));
end;  { HookWin }procedure TeLanCDRomMonitor.HookWndProc(var AMsg: TMessage);
var fP : PDEV_BROADCAST_VOLUME;
begin
   New(fP);
   try
   if AMsg.Msg = WM_DeviceChange then
   begin
      if (AMsg.LParam <> 0) then
      begin
        fP:=PDEV_BROADCAST_VOLUME(AMsg.LParam);      case AMsg.WParam of
         DBT_DeviceArrival :
         begin
         if (fP.dbcv_DeviceType = dbt_DEVTYP_VOLUME) and
            (Assigned(fOnDiscArrive)) then
            begin
              fDrvName :=GetDrvName(fP.dbcv_UnitMask);
              fOnDiscArrive(self,fDrvName);
            end;
         end;         DBT_DeviceRemoveComplete:
         begin
         if (fP.dbcv_DeviceType = dbt_DEVTYP_VOLUME) and
            (Assigned(fOnDiscRemove)) then
            begin
              fDrvName :=GetDrvName(fP.dbcv_UnitMask);
              fOnDiscRemove(self,fDrvName);
            end;
         end;
      end;
      end;
   end;
   finally
     fP:=nil;
     Dispose(fP);
   end;
   AMsg.Result := CallWindowProc(OldWndProc,MyOwnerHandle, AMsg.Msg, AMsg.wParam, AMsg.lParam);
end;procedure TeLanCDRomMonitor.UnhookWin;
begin
  if Assigned(NewWndProc) then
  begin
    SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(OldWndProc));
    FreeObjectInstance(NewWndProc);
    NewWndProc := nil;
  end;
end;  { UnHookWin }procedure TeLanCDRomMonitor.Lock;
var DrvName : Char;
begin
  if fLocked then Exit;
  DrvName:='a';
  repeat
    if GetDriveType(pchar(drvname+':\')) = DRIVE_CDROM then
      DoLockCDRom(True,DrvName);
    Inc(DrvName);
  until DrvName = 'z';
end;procedure TeLanCDRomMonitor.Lock(const DrvName: Char);
begin
  if fLocked then Exit;
  DoLockCDRom(True,DrvName);
end;procedure TeLanCDRomMonitor.Unlock;
var DrvName : Char;
begin
  if not fLocked then Exit;
  DrvName:='a';
  repeat
    if GetDriveType(pchar(drvname+':\')) = DRIVE_CDROM then
      DoLockCDRom(FAlse,DrvName);
    Inc(DrvName);
  until DrvName = 'z';
end;procedure TeLanCDRomMonitor.Unlock(const DrvName: Char);
begin
  if not fLocked then Exit;
  DoLockCDRom(FAlse,DrvName);
end;procedure TeLanCDRomMonitor.DoLockCDRom(const fLock: Boolean;
  const Drv: String);  function DoIOCTL(Reg : DEVIOCTL_REGISTERS):BOOL;
var
  hDevice : THandle;
  fResult : BOOL;
  cb      : DWORD ;
begin
  Result:=False;
  hDevice :=0;
  Reg.reg_Flags := $8000; // assume error (carry flag set)
  try
  hDevice := CreateFile('\\.\vwin32',
               GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
               nil, OPEN_EXISTING,
               FILE_ATTRIBUTE_NORMAL, 0);
  if hDevice = 0 then
    Exit
  else
  begin
    fResult := DeviceIoControl(hDevice,
                               VWIN32_DIOC_DOS_IOCTL,
                               @reg, sizeof(reg),
                               @reg, sizeof(reg), cb, nil);
    if not fResult then Exit;
    Result:= TRUE;
  end;
  finally
    CloseHandle(hDevice);
  end;
end;var
  reg : DEVIOCTL_REGISTERS;
  ParamB : PARAMBLOCK;
begin
  if fLock then ParamB.Operation :=0
     else ParamB.Operation :=1;  reg.reg_EAX := $440D;      // IOCTL for block devices
  reg.reg_EBX := Integer(LowerCase(Drv)) - Integer('a') + 1;     // zero-based drive ID
  reg.reg_ECX := $0848;      // Get LockStatus
  reg.reg_EDX := DWORD(@ParamB); // receives media ID info
  DoIOCTL(reg);
  fLocked :=not fLocked;
end;end.