Delphi 检测U盘状态

uses StdCtrls,shlobj,Activex,ComObj;

 

procedure WMDEVICECHANGE(var msgx:Tmessage);message WM_DEVICECHANGE;

 

function GetLastMoveDrive:String;
var
Drivetype:Integer;
root:String;
i:Integer;
begin
Result:='';
for i:=67 to 91 do //从C：盘开始到Z：盘
begin
root:=char(i)+':\';
Drivetype:=GetDriveType(pChar(root));
if Drivetype=DRIVE_REMOVABLE then
begin
Result:='插入U盘 '+root;
Break;
end;
end;
end;

procedure WMDEVICECHANGE(var msgx: Tmessage);
const
DBT_DEVICEARRIVAL=$8000;
DBT_DEVICEREMOVECOMPLETE=$8004;
begin
inherited;
case msgx.WParam of
DBT_DEVICEARRIVAL:
Label1.Caption:=GetLastMoveDrive;
DBT_DEVICEREMOVECOMPLETE:
Label1.Caption:='U盘被取走';
end;
end;

 

 

 

 

procedure TForm1.Button1Click(Sender: TObject);
var
reg:TRegistry;
begin
Try
reg:=tregistry.create;
reg.rootkey:=HKEY_LOCAL_MACHINE;
reg.openkey('\SYSTEM\CurrentControlSet\Control',true);

if reg.CreateKey('\SYSTEM\CurrentControlSet\Control\StorageDevicePolicies') then
begin
reg.openkey('\SYSTEM\CurrentControlSet\Control\StorageDevicePolicies',true);
reg.WriteInteger('WriteProtect',1); //添加注册表项和建值
end;

reg.CloseKey; //关闭KEY
reg.Free; //释放
MessageBox(Handle,'禁止U盘拷入功能','提示',MB_OK);
Except
MessageBox(Handle,'设置失败','提示',MB_OK);
end;

end;

 

procedure TForm1.Button2Click(Sender: TObject);
var
reg:tregistry;
begin
Try
reg:=tregistry.Create;
reg.rootkey:=HKEY_LOCAL_MACHINE;
reg.DeleteKey('\SYSTEM\CurrentControlSet\Control\StorageDevicePolicies'); //删除注册表项
reg.CloseKey;
reg.Free;
MessageBox(Handle,'解除禁止U盘拷入功能','提示',MB_OK);
Except
MessageBox(Handle,'设置失败','提示',MB_OK);
end;
end;

转载于:https://www.cnblogs.com/lzj1981/archive/2013/04/28/3049394.html