如何动态实现禁止和恢复物理光驱 ( 积分: 200 )

  • 主题发起人 主题发起人 muzi9298
  • 开始时间 开始时间
M

muzi9298

Unregistered / Unconfirmed
GUEST, unregistred user!
  请问各位大侠 如何动态实现禁止和恢复物理光驱
本人一软件需要光盘,现做一模拟光驱. 但必须要禁止物理光驱后,虚拟光驱才能起作用.  请问如何实现???
 
  请问各位大侠 如何动态实现禁止和恢复物理光驱
本人一软件需要光盘,现做一模拟光驱. 但必须要禁止物理光驱后,虚拟光驱才能起作用.  请问如何实现???
 
有一个是屏蔽光驱的,没有找到相应的对应代码,自己看看应差不多,就是写注册表,你把NoDrive删除了应该就是对应的方法了

procedure ShieldCDs;
function IsCDROM(DriveChar: Char): Boolean;
begin
Result := GetDriveType(PChar(DriveChar + ':/')) = DRIVE_CDROM;
end;
const
_PATH = '/Software/Microsoft/Windows/CurrentVersion/Policies/Explorer';
var
I, T: Integer;
Buffer, Mask: DWORD;
R: TRegistry;
begin
Mask := 0;
for I := 0 to 25 do
if IsCDROM(Char(I + Ord('A'))) then Mask := Mask + 1 shl I;
R := TRegistry.Create;
R.Rootkey := HKEY_CURRENT_USER;
R.CreateKey(_PATH);
R.OpenKey(_PATH, False);
if R.ReadBinaryData('NoDrives', Buffer, SizeOf(Buffer)) = 0 then Buffer := 0;
Buffer := Buffer and not Mask or Mask; // 为了不破坏对其它驱动器的设置。
R.WriteBinaryData('NoDrives', Buffer, SizeOf(Buffer));
R.Free;
end;

另外请看
http://www.delphibbs.com/delphibbs/dispq.asp?lid=186334

网上转的

unit eLanCDRom;
{ ==================================================== }
{ Component TeLanCDRomMonitor }
{ ==================================================== }
{ 作 者 :eLan }
{ E-mail : eLan@126.com }
{ 创建时间 :1998-09-04 }
{ 最后修改时间:1998-11-18 }
{ ==================================================== }
{ 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
}
{ ==================================================== }
{ 修改记录: }
{
1998-09-05 晚 第一次调试成功
1998-10-31 修改
1998-11-09 添加 TCDNotifyEvent 类型,以便给响应事件传
递盘符参数
}
{ ---------------------------------------------------- }
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;

implementation

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

constructor TeLanCDRomMonitor.Create(AOwner: tComponent);
var I:Integer;
begin
for I:=0 to AOwner.ComponentCount -1 do
if AOwner.Components 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;
{ ----------------------------------------------------- }
{ 98-8-29 陈华珊编写 }
{ 用于将 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.
 

Similar threads

后退
顶部