Bloqueo de USB

Hola que tal Gente ... este es un proyecto que realice en mi trabajo,
como muchos tenemos el problema que los usuarios meten las memorias usb, y sabra Dios en donde mas las habran metido, por lo que tal vez la galeria de virus que traen es muy buena, para evitarme este problema, hice un programa que me bloqueara solo las memorias usb; las impresoras, mouse, y demas accesorios usb si se pueden accesar.


El programa necesita ejecutarse una sola vez y lo que hace es:
- Crea un registro en el que hace que se inicie junto con Windows
- Deshabilita los puertos USB; Bloquea el registro, y cambia el nombre de los archivos que contienen los drivers, por lo que si es la primera vez que se conecta la memoria no lo va a instalar, y si ya estaba instalado, no lo permite por que el registro esta deshabilitado.
- Tanto la ruta como la contraseña son fijas, es decir, no se pueden cambiar, al menos que se cambie desde código.
- Para habilitar los puertos, es necesario dar clic derecho en él, este estará iconizado (al lado izquierdo del reloj)
- Al introducir la contraseña este mostrara un botón para habilitar el puerto, y entonces si puedes conectar la memoria USB
- La próxima vez que se inicie, este deshabilitará los puertos USB solo para memorias


aqui les dejo el enlace...



http://cid-dd6c7076675d0866.office.live.com/self.aspx/P%c3%bablico/Programas%20Varios/UsbLocal.rar


el programa se tendria que poner en "C:\Archivos de Programa\" para que se ejecute siempre desde ahi.....



el programa esta hecho en delphi 7.0, por lo que aqui les dejo el código
unit FUsb;

interface

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

const
WM_ICONTRAY = WM_USER + 1; // Mensaje definido por el usuario

type
Tusbs = class(TForm)
BHabilitar: TButton;
BDeshabilitar: TButton;
Pass: TEdit;
Minimizar: TButton;
BMostrar: TButton;
Timer1: TTimer;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MinimizarClick(Sender: TObject);
procedure BMostrarClick(Sender: TObject);
procedure Icontray(var Msg: TMessage); message WM_ICONTRAY;
procedure BDeshabilitarClick(Sender: TObject);
procedure BHabilitarClick(Sender: TObject);
procedure PassKeyPress(Sender: TObject; var Key: Char);
procedure Timer1Timer(Sender: TObject);
Procedure MadrearArchivo(Sender: TObject);
Procedure ComponerArchivo(Sender: TObject);
private
{ Private declarations }

public
{ Public declarations }
end;

var
usbs : Tusbs;

NotifyIconData : TNotifyIconData;
Hecho : Boolean;
Intentos: Integer;
SearchRec: TSearchRec;

implementation

Uses PopupMenu1;
{$R *.dfm}

{-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+
este proceso cambia el nombre del usbtor para
que no se instale la memoria usb
-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+}
Procedure Tusbs.MadrearArchivo(Sender: TObject);
Var
lpFileOp: TSHFileOpStruct;
ArchivoABuscar1,ArchivoABuscar2:String;
Begin
ArchivoABuscar1:='C:\WINDOWS\inf\usbstor.inf';
If FindFirst(ArchivoABuscar1, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Self.Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINDOWS\inf\usbstor.inf' + #0#0);
lpFileOp.pTo := PChar('C:\WINDOWS\inf\usbstorinf.Txt' + #0#0);
lpFileOp.fFlags:= FOF_SIMPLEPROGRESS or FOF_FILESONLY;
lpFileOp.fAnyOperationsAborted := FALSE;
lpFileOp.hNameMappings := nil;
lpFileOp.lpszProgressTitle := PChar('Trasladando archivos al disco D' + #0#0);
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstor.inf a usbstorinf.Txt');
end
Else
Begin
ArchivoABuscar1:='C:\WINNT\inf\usbstor.inf';
If FindFirst(ArchivoABuscar1, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINNT\inf\usbstor.inf' + #0#0);
lpFileOp.pTo := PChar('C:\WINNT\inf\usbstorinf.Txt' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstor.inf a usbstorinf.Txt');
End;
End;



ArchivoABuscar2:='C:\WINDOWS\inf\usbstor.PNF';
If FindFirst(ArchivoABuscar2, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINDOWS\inf\usbstor.PNF' + #0#0);
lpFileOp.pTo := PChar('C:\WINDOWS\inf\usbstorPNF.Txt' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstor.PNF a usbstorPNF.Txt');
End
Else
Begin
ArchivoABuscar2:='C:\WINNT\inf\usbstor.PNF';
If FindFirst(ArchivoABuscar2, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINNT\inf\usbstor.PNF' + #0#0);
lpFileOp.pTo := PChar('C:\WINNT\inf\usbstorPNF.Txt' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstor.PNF a usbstorPNF.Txt');
end;
End;

End;
{-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+
Regresa a la nomralidad los archivos para que se
instalen las memorias
-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+-*/+}
Procedure Tusbs.ComponerArchivo(Sender: TObject);
Var
lpFileOp: TSHFileOpStruct;
ArchivoABuscar1,ArchivoABuscar2:String;
SearchRec: TSearchRec;
Begin


ArchivoABuscar1:='C:\WINDOWS\inf\usbstorinf.Txt';
If FindFirst(ArchivoABuscar1, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINDOWS\inf\usbstorinf.Txt' + #0#0);
lpFileOp.pTo := PChar('C:\WINDOWS\inf\usbstor.inf' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstorinf.Txt a usbstor.inf');
End
Else
Begin
ArchivoABuscar1:='C:\WINNT\inf\usbstorinf.Txt';
If FindFirst(ArchivoABuscar1, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINNT\inf\usbstorinf.Txt' + #0#0);
lpFileOp.pTo := PChar('C:\WINNT\inf\usbstor.inf' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstorinf.Txt a usbstor.inf');
End;
end;


ArchivoABuscar2:='C:\WINDOWS\inf\usbstorPNF.Txt';
If FindFirst(ArchivoABuscar2, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINDOWS\inf\usbstorPNF.Txt' + #0#0);
lpFileOp.pTo := PChar('C:\WINDOWS\inf\usbstor.PNF' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstorPNF.Txt a usbstor.PNF');
end
Else
Begin
ArchivoABuscar2:='C:\WINNT\inf\usbstorPNF.Txt';
If FindFirst(ArchivoABuscar2, faAnyFile and not (faVolumeID or faDirectory), SearchRec) = 0 then
Begin
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_RENAME;
lpFileOp.pFrom := PChar('C:\WINNT\inf\usbstorPNF.Txt' + #0#0);
lpFileOp.pTo := PChar('C:\WINNT\inf\usbstor.PNF' + #0#0);
lpFileOp.fFlags:= FOF_ALLOWUNDO or FOF_RENAMEONCOLLISION;
if ShFileOperation(lpFileOp) <> 0 then
ShowMessage('Ha Fallado El cambio de Nombre de Archivo de usbstorPNF.Txt a usbstor.PNF');
end;
end;

End;

procedure Tusbs.Icontray(var Msg: TMessage);
var
CursorPos : TPoint;
begin
if Msg.lParam = WM_RBUTTONDOWN then begin
GetCursorPos(CursorPos);
usbs.Show;
end else
inherited;
end;



{procedimiento para habilitar o deshabilitar el usb}
procedure EnableUSB(Value: Boolean);
begin
with TRegistry.Create do
try
RootKey:= HKEY_LOCAL_MACHINE;
if OpenKey('\SYSTEM\CurrentControlSet\Services\USBSTOR',TRUE) then
begin
if Value then WriteInteger('Start',3)
else WriteInteger('Start',4);
CloseKey;
end;
finally
Free;
end;
end;

{procedimiento para hacer que el programa se inicie con windows}
procedure RunForEver(pCaption, pPath : String);
var Registro :TRegistry;
begin
//pCaption es el caption del programa, y path la ruta completa donde se encuentra el .exe
Registro:=TRegistry.create;
Registro.RootKey := HKEY_LOCAL_MACHINE;
If Registro.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run\',FALSE) then
If Not (Registro.ReadString(pCaption) = pPath) Then
Registro.WriteString(pCaption, pPath);

Registro.Free;
end;

{Al Crearse la forma}
procedure Tusbs.FormCreate(Sender: TObject);
begin
{ Desabilitamos el Puerto USB}
EnableUSB(False);
{mandamos llamar el procedimiento para que truene los archivos}
MadrearArchivo(Sender);
{Activamos el programa para que se inicie con windows}
RunForEver('Usb.exe','C:\Archivos de Programa\Usb.exe');

end;

{Oculta la Aplicacion de la barra de tareas}
procedure Tusbs.FormShow(Sender: TObject);
begin
ShowWindow(application.Handle, SW_HIDE );
Intentos:=0;
Pass.Text := '';
end;
{*******************************************************
BOTON PARA MINIMIZAR LA PANTALLA
*******************************************************}
procedure Tusbs.MinimizarClick(Sender: TObject);
begin
usbs.Hide;
with NotifyIconData do begin
hIcon := Icon.Handle;
StrPCopy(szTip, Application.Title);
Wnd := Handle;
uCallbackMessage := WM_ICONTRAY;
uID := 1;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
cbSize := sizeof(TNotifyIconData);
end;
Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;
{*******************************************************
BOTON PARA QUITAR EL ICONO DE LA BARRA DE TAREAS
*******************************************************}
procedure Tusbs.BMostrarClick(Sender: TObject);
begin
Show;
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); //para quitar el icono de la barra de notificación
end;

procedure Tusbs.BDeshabilitarClick(Sender: TObject);
begin
EnableUSB(False);
MadrearArchivo(Sender);
BHabilitar.Visible :=False;
end;

procedure Tusbs.BHabilitarClick(Sender: TObject);
begin
EnableUSB(True);
ComponerArchivo(Sender);
end;

procedure Tusbs.PassKeyPress(Sender: TObject; var Key: Char);
begin
If Intentos >= 3 Then
MinimizarClick(Sender);
If key=#13 Then
If pass.Text ='entra2' Then
BHabilitar.Visible := True
else
Begin
BHabilitar.Visible := False;
Intentos := Intentos +1;
End;
end;

procedure Tusbs.Timer1Timer(Sender: TObject);
begin
If Hecho =False then
Begin
MinimizarClick(sender);
hecho:=True;
end;

end;