jmusb.pas

计算机移动设备的管理工具 1、U盘的开启及禁用 2、开启与禁用所有USB设备 3、开启与禁用光驱 4、开启与禁用软驱 很简单的小工具

unit Jmusb;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,Registry, SkinCaption, WinSkinData, ExtCtrls;

type
  TfrmJmusb = class(TForm)
    btnClose: TBitBtn;
    grp1: TGroupBox;
    btnCloseUstore: TBitBtn;
    btnOpenUstore: TBitBtn;
    btnClosehub: TBitBtn;
    btnOpenhub: TBitBtn;
    grp2: TGroupBox;
    btnClosecd: TBitBtn;
    btnOpencd: TBitBtn;
    btnClosefpy: TBitBtn;
    btnOpenfpy: TBitBtn;
    btnOk: TBitBtn;
    bvl1: TBevel;
    SkinData1: TSkinData;
    SkinCaption1: TSkinCaption;
    procedure FormCreate(Sender: TObject);
    procedure btnOpenfpyClick(Sender: TObject);
    procedure btnOpencdClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure btnOpenhubClick(Sender: TObject);
    procedure btnClosehubClick(Sender: TObject);
    procedure btnClosecdClick(Sender: TObject);
    procedure btnClosefpyClick(Sender: TObject);
    procedure btnOpenUstoreClick(Sender: TObject);
    procedure btnCloseUstoreClick(Sender: TObject);
    procedure Shieldremovable(stopcd,stopfpy:Boolean);
  private
    stopcd,stopfpy:Boolean;
    function writekey(keystr:string;keyvalue:integer):Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmJmusb: TfrmJmusb;

implementation

{$R *.dfm}
Function Readusbvalue(newkey:String):String;
var
   Defaultkey:String;
   FRegFile: TRegistry;
begin
  FRegFile:= TRegistry.Create;
  FRegFile.RootKey := HKEY_LOCAL_MACHINE;
  if FRegFile.OpenKey(Defaultkey,False) then
    Result:=FRegFile.Readstring(newkey)
  else
       Result:='';
    FregFile.Free;
end;
//写入背景文件
procedure TfrmJmusb.btnClosehubClick(Sender: TObject);
begin
  if writekey('\SYSTEM\CurrentControlSet\Services\UsbStor',4) and
    writekey('\SYSTEM\CurrentControlSet\Services\UsbHUB',4) THEN
    Application.MessageBox('禁用所有USB设备成功', 'USB管理工具', MB_OK);
  btnClosehub.Enabled:=False;
  btnOpenhub.Enabled:=True;
end;

procedure TfrmJmusb.btnOpenhubClick(Sender: TObject);
begin
   IF writekey('\SYSTEM\CurrentControlSet\Services\UsbStor',3) and
     writekey('\SYSTEM\CurrentControlSet\Services\Usbhub',3) THEN
     Application.MessageBox('启用所有USB设备成功','USB管理工具', MB_OK);
    btnClosehub.Enabled:=True;
    btnOpenhub.Enabled:=False;
end;

procedure TfrmJmusb.btnOkClick(Sender: TObject);
begin
  Shieldremovable(stopcd,stopfpy);
end;

procedure TfrmJmusb.btnOpencdClick(Sender: TObject);
begin
  stopcd:=False;
  btnClosecd.Enabled:=True;
  btnOpencd.Enabled:=False;
end;

procedure TfrmJmusb.btnOpenfpyClick(Sender: TObject);
begin
  stopfpy:=False;
  btnClosefpy.Enabled:=True;
  btnOpenfpy.Enabled:=False;
end;

procedure TfrmJmusb.btnOpenUstoreClick(Sender: TObject);
begin
   IF writekey('\SYSTEM\CurrentControlSet\Services\UsbStor',3) THEN
     Application.MessageBox('开启USB口成功','USB管理工具', MB_OK);
   btnCloseUstore.Enabled:=True;
   btnOpenUstore.Enabled:=False;
end;

procedure TfrmJmusb.btnClosecdClick(Sender: TObject);
begin
  stopcd:=True;
  btnClosecd.Enabled:=False;
  btnOpencd.Enabled:=True;
end;

procedure TfrmJmusb.btnClosefpyClick(Sender: TObject);
begin
  stopfpy:=True;
  btnClosefpy.Enabled:=False;
  btnOpenfpy.Enabled:=True;
end;

procedure TfrmJmusb.btnCloseUstoreClick(Sender: TObject);
begin
   if writekey('\SYSTEM\CurrentControlSet\Services\UsbStor',4) THEN
    Application.MessageBox('关闭USB口成功', 'USB管理工具', MB_OK);
   btnCloseUstore.Enabled:=False;
   btnOpenUstore.Enabled:=True;
end;


function TfrmJmusb.writekey(keystr:string;keyvalue:integer):Boolean;
var
   FRegFile: TRegistry;
begin
    result:=FAlse;
    FRegFile:= TRegistry.Create;
    FRegFile.RootKey := HKEY_LOCAL_MACHINE;
    if FRegFile.OpenKey(keystr,True) then
    begin
       fRegFile.Writeinteger('start',keyvalue);
       result:=True;
    end;
    FregFile.Closekey;
    FregFile.Free;
end;

procedure TfrmJmusb.FormCreate(Sender: TObject);
begin
  stopcd:=False;
  stopfpy:=False;
//  if readusbvalue('\SYSTEM\CurrentControlSet\Services\UsbStor') = '4' then
//  begin
//     btnCloseUstore.Enabled:=False;
//     btnOpenUstore.Enabled:=True;
//  end
//  else
//  begin
//     btnCloseUstore.Enabled:=True;
//     btnOpenUstore.Enabled:=False;
//  end;
//  if readusbvalue('\SYSTEM\CurrentControlSet\Services\UsbHub') = '4' then
//  begin
//     btnClosehub.Enabled:=False;
//     btnOpenhub.Enabled:=True;
//  end
//  else
//  begin
//     btnClosehub.Enabled:=True;
//     btnOpenhub.Enabled:=False;
//  end;
end;

//禁用光驱或软驱
procedure TfrmJmusb.Shieldremovable(stopcd,stopfpy:Boolean);
  function IsCDROM(DriveChar: Char): Boolean;
  begin
    Result := GetDriveType(PChar(DriveChar + ':\')) = DRIVE_CDROM;
  end;
  function IsFLOPPY(DriveChar: Char): Boolean;
  begin
    Result := GetDriveType(PChar(DriveChar + ':\')) = DRIVE_REMOVABLE;
  end;
const
  _PATH = '\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer';
var
  I: Integer;
  Buffer, Mask: DWORD;
  R: TRegistry;
begin
  Mask := 0;
  for I := 0 to 25 do
  begin
    if stopcd  and (IsCDROM(Char(I + Ord('A')))) then
       Mask := Mask + 1 shl I;
    if stopfpy and (Isfloppy(Char(I + Ord('A')))) then
        Mask := Mask + 1 shl I;
  end;
  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;


end.