HanDs
管理员

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


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
检测
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复