//Ö»¹¤×÷ÔÚ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;
{ ==================================================== }
{ 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[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;
{ ----------------------------------------------------- }
{ 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.