Un simple programa que graba todos los registros de la webcam en un video con formato avi.

Tenia pensado usarlo como camara de vigilancia en el frente de mi casa pero todavia le faltan varios (mas bien muchos) retoques.

Una imagen :

Imagen


El codigo.

Código: Seleccionar todo

// The WatchMan 0.4
// (C) Doddy Hackman 2013
// Credits : Based on
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-i.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-ii.html
// http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
// Thanks to Javier Par

unit the;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  sGroupBox, sButton, sRadioButton, sEdit, sListView, ExtCtrls, ShellApi, acPNG,
  sLabel;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sPageControl1: TsPageControl;
    sStatusBar1: TsStatusBar;
    sTabSheet1: TsTabSheet;
    sTabSheet3: TsTabSheet;
    sGroupBox1: TsGroupBox;
    sTabSheet4: TsTabSheet;
    sGroupBox2: TsGroupBox;
    sButton1: TsButton;
    sButton2: TsButton;
    sGroupBox4: TsGroupBox;
    sRadioButton3: TsRadioButton;
    sEdit1: TsEdit;
    sRadioButton4: TsRadioButton;
    sGroupBox6: TsGroupBox;
    sListView1: TsListView;
    Guardar: TSaveDialog;
    Image1: TImage;
    sGroupBox3: TsGroupBox;
    Image2: TImage;
    sLabel1: TsLabel;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

    procedure sListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  toyaca: hwnd;

const

  control = WM_USER;
  conec = control + 10;
  uno = control + 52;
  dos = control + 50;

  tres = control + 20;
  cuatro = control + 62;
  chau = control + 11;

implementation

uses tiny, full;

FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint;
  x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: hwnd;
  nId: integer): hwnd;
STDCALL EXTERNAL 'AVICAP32.DLL';
{$R *.dfm}
  procedure TForm1.FormCreate(Sender: TObject);
  var
    dir: string;
    busqueda: TSearchRec;
  begin

    sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
      + 'Data';
    sSkinManager1.SkinName := 'matrix';
    sSkinManager1.Active := True;

    dir := ExtractFilePath(Application.ExeName) + '/captures';

    if not(DirectoryExists(dir)) then
    begin
      CreateDir(dir);
    end;

    ChDir(dir);

    FindFirst(dir + '\*.avi', faAnyFile + faReadOnly, busqueda);

    with sListView1.Items.Add do
    begin
      Caption := ExtractFileName(busqueda.Name);
      SubItems.Add(dir + '/' + busqueda.Name);
    end;

    while FindNext(busqueda) = 0 do
    begin

      with sListView1.Items.Add do
      begin
        Caption := ExtractFileName(busqueda.Name);
        SubItems.Add(dir + '/' + busqueda.Name);
      end;

    end;
    FindClose(busqueda);

  end;

  procedure TForm1.sButton1Click(Sender: TObject);
  begin

    sStatusBar1.Panels[0].Text := '[+] Recording';
    Form1.sStatusBar1.Update;

    Form2.Show;

    toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
      Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
      Form2.Image1.Height, Form2.Handle, 0);

    SendMessage(toyaca, conec, 0, 0);
    SendMessage(toyaca, uno, 40, 0);
    SendMessage(toyaca, dos, 1, 0);

    SendMessage(toyaca, tres, 0, longint(PCHAR('tt')));

    SendMessage(toyaca, cuatro, 0, 0);

  end;

  procedure TForm1.sButton2Click(Sender: TObject);
  var
    fecha: TDateTime;
    fechafinal: string;
    nombrefecha: string;

  BEGIN

    sStatusBar1.Panels[0].Text := '[+] Stopped';
    Form1.sStatusBar1.Update;

    SendMessage(toyaca, chau, 0, 0);

    Form2.Hide;

    if (sRadioButton3.Checked) then
    begin
      RenameFile('t', sEdit1.Text);
    end;

    if (sRadioButton4.Checked) then
    begin
      fecha := now();
      fechafinal := DateTimeToStr(fecha);
      nombrefecha := fechafinal + '.avi';

      nombrefecha := StringReplace(nombrefecha, '/', ':', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ' ', '', [rfReplaceAll,
        rfIgnoreCase]);
      nombrefecha := StringReplace(nombrefecha, ':', '_', [rfReplaceAll,
        rfIgnoreCase]);

      RenameFile('t', nombrefecha);

    end;

  end;

  procedure TForm1.sListView1DblClick(Sender: TObject);
  begin

    ShellExecute(0, nil, PCHAR(sListView1.Selected.SubItems[0]), nil, nil,
      SW_SHOWNORMAL);

  end;

end.

// The End ?
Si lo quieren bajar lo pueden hacer de [Enlace externo eliminado para invitados].
Estaría bueno que empezara a gravar al detectar algún movimiento, de lo contrario consume mucho espacio en disco.

PD: Buena tool.

//Regards.
Ikarus: Backdoor.VBS.SafeLoader
Agnitum: Trojan.VBS.Safebot.A
http://indeseables.github.io/
Scorpio escribió:Estaría bueno que empezara a gravar al detectar algún movimiento, de lo contrario consume mucho espacio en disco.

PD: Buena tool.

//Regards.

Eso mismo hace el Cammy Cam. (Sensor de movimiento). Después lo critican diciendo mil pavadas. dX
Imagen
Imagen
no entendia como diablos funcionaba un detector de movimiento por software
y encontre esta referencia :

"Los sensores por software tienen un buffer en el que guardan las últimas imágenes capturadas y están continuamente comparando las antiguas con las nuevas. Si hay cambio entre ambas, salta el detector"
asi que programarlo te va a resultar facil, encontre algunos ejemplos en la red.

osea si hay cambio en la imagen guarda el jpg si no se desactiva el guardado.
exelente idea.
paresco malo ,pero soy bueno
No está mal, es un misterio que no funcione bien esto y toque renombrarlo al final:

SendMessage(hWndVent, WM_CAP_FILE_SET_CAPTURE_FILEA, LongInt(PCHAR(sedit1.Text)));

Gracias
UDTools.net
GitHub: https://github.com/MetalUDT
No puedo editar, pero te dejo la solución al 'problema' mencionado, así no necesitas renombrar el fichero, faltaría el del otro checkbox pero solo es acomodarlo:
procedure TForm1.sButton1Click(Sender: TObject);
  var
    Fichero: ansistring;
  begin

    sStatusBar1.Panels[0].Text := '[+] Recording';
    Form1.sStatusBar1.Update;
    Fichero:= sedit1.Text;

    Form2.Show;

    toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
      Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
      Form2.Image1.Height, Form2.Handle, 0);

    SendMessage(toyaca, conec, 0, 0);
    SendMessage(toyaca, uno, 40, 0);
    SendMessage(toyaca, dos, 1, 0);
    SendMessage(toyaca, tres, 0, integer(pointer(Fichero)));
    SendMessage(toyaca, cuatro, 0, 0);
  end;
O así si quieres ahorrarte la variable:
SendMessage(toyaca, tres, 0, integer(pointer(ansistring(sedit1.Text))));
Saludos.
UDTools.net
GitHub: https://github.com/MetalUDT
Ah no sabia que los detectores de movimiento los hacían por software... Pensaba que lo tendrían solo algunas cams por hardware. Claro tiene sentido el texto citado por muy ofuscado, pero claro el software tiene que estar continuamente capturando la cam en segundo plano hasta que detecta varios diferencias frente a la anterior para que se ponga a grabar, pues si estaría bueno que le pusieras esa opción Doddy!, y cuando detecte movimiento se ponga a grabar y mande el .avi por mail o ftp.

Felicidades por la herramienta, estoy seguro que la mejorarás. Estoy atento a tus tools!

Saludos!
Soy un camaleón, en tu cama, leona ♪
Responder

Volver a “Nuestros Programas”