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] The WatchMan 0.4

  • 1 Respuestas
  • 1695 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Diciembre 01, 2013, 11:39:32 pm »
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 :



El codigo.

Código: Delphi
  1. // The WatchMan 0.4
  2. // (C) Doddy Hackman 2013
  3. // Credits : Based on
  4. // http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-i.html
  5. // http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-ii.html
  6. // http://delphimagic.blogspot.com.ar/2008/12/webcam-con-delphi-iii.html
  7. // Thanks to Javier Par
  8.  
  9. unit the;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  15.   Dialogs, sSkinManager, ComCtrls, sStatusBar, sPageControl, StdCtrls,
  16.   sGroupBox, sButton, sRadioButton, sEdit, sListView, ExtCtrls, ShellApi, acPNG,
  17.   sLabel;
  18.  
  19. type
  20.   TForm1 = class(TForm)
  21.     sSkinManager1: TsSkinManager;
  22.     sPageControl1: TsPageControl;
  23.     sStatusBar1: TsStatusBar;
  24.     sTabSheet1: TsTabSheet;
  25.     sTabSheet3: TsTabSheet;
  26.     sGroupBox1: TsGroupBox;
  27.     sTabSheet4: TsTabSheet;
  28.     sGroupBox2: TsGroupBox;
  29.     sButton1: TsButton;
  30.     sButton2: TsButton;
  31.     sGroupBox4: TsGroupBox;
  32.     sRadioButton3: TsRadioButton;
  33.     sEdit1: TsEdit;
  34.     sRadioButton4: TsRadioButton;
  35.     sGroupBox6: TsGroupBox;
  36.     sListView1: TsListView;
  37.     Guardar: TSaveDialog;
  38.     Image1: TImage;
  39.     sGroupBox3: TsGroupBox;
  40.     Image2: TImage;
  41.     sLabel1: TsLabel;
  42.     procedure sButton1Click(Sender: TObject);
  43.     procedure sButton2Click(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.  
  46.     procedure sListView1DblClick(Sender: TObject);
  47.   private
  48.     { Private declarations }
  49.   public
  50.     { Public declarations }
  51.   end;
  52.  
  53. var
  54.   Form1: TForm1;
  55.   toyaca: hwnd;
  56.  
  57. const
  58.  
  59.   control = WM_USER;
  60.   conec = control + 10;
  61.   uno = control + 52;
  62.   dos = control + 50;
  63.  
  64.   tres = control + 20;
  65.   cuatro = control + 62;
  66.   chau = control + 11;
  67.  
  68. implementation
  69.  
  70. uses tiny, full;
  71.  
  72. FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint;
  73.   x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: hwnd;
  74.   nId: integer): hwnd;
  75. STDCALL EXTERNAL 'AVICAP32.DLL';
  76. {$R *.dfm}
  77.   procedure TForm1.FormCreate(Sender: TObject);
  78.   var
  79.     dir: string;
  80.     busqueda: TSearchRec;
  81.   begin
  82.  
  83.     sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
  84.       + 'Data';
  85.     sSkinManager1.SkinName := 'matrix';
  86.     sSkinManager1.Active := True;
  87.  
  88.     dir := ExtractFilePath(Application.ExeName) + '/captures';
  89.  
  90.     if not(DirectoryExists(dir)) then
  91.     begin
  92.       CreateDir(dir);
  93.     end;
  94.  
  95.     ChDir(dir);
  96.  
  97.     FindFirst(dir + '\*.avi', faAnyFile + faReadOnly, busqueda);
  98.  
  99.     with sListView1.Items.Add do
  100.     begin
  101.       Caption := ExtractFileName(busqueda.Name);
  102.       SubItems.Add(dir + '/' + busqueda.Name);
  103.     end;
  104.  
  105.     while FindNext(busqueda) = 0 do
  106.     begin
  107.  
  108.       with sListView1.Items.Add do
  109.       begin
  110.         Caption := ExtractFileName(busqueda.Name);
  111.         SubItems.Add(dir + '/' + busqueda.Name);
  112.       end;
  113.  
  114.     end;
  115.     FindClose(busqueda);
  116.  
  117.   end;
  118.  
  119.   procedure TForm1.sButton1Click(Sender: TObject);
  120.   begin
  121.  
  122.     sStatusBar1.Panels[0].Text := '[+] Recording';
  123.     Form1.sStatusBar1.Update;
  124.  
  125.     Form2.Show;
  126.  
  127.     toyaca := capCreateCaptureWindowA('Unknown_888', WS_CHILD OR WS_VISIBLE,
  128.       Form2.Image1.Left, Form2.Image1.Top, Form2.Image1.Width,
  129.       Form2.Image1.Height, Form2.Handle, 0);
  130.  
  131.     SendMessage(toyaca, conec, 0, 0);
  132.     SendMessage(toyaca, uno, 40, 0);
  133.     SendMessage(toyaca, dos, 1, 0);
  134.  
  135.     SendMessage(toyaca, tres, 0, longint(PCHAR('tt')));
  136.  
  137.     SendMessage(toyaca, cuatro, 0, 0);
  138.  
  139.   end;
  140.  
  141.   procedure TForm1.sButton2Click(Sender: TObject);
  142.   var
  143.     fecha: TDateTime;
  144.     fechafinal: string;
  145.     nombrefecha: string;
  146.  
  147.   BEGIN
  148.  
  149.     sStatusBar1.Panels[0].Text := '[+] Stopped';
  150.     Form1.sStatusBar1.Update;
  151.  
  152.     SendMessage(toyaca, chau, 0, 0);
  153.  
  154.     Form2.Hide;
  155.  
  156.     if (sRadioButton3.Checked) then
  157.     begin
  158.       RenameFile('t', sEdit1.Text);
  159.     end;
  160.  
  161.     if (sRadioButton4.Checked) then
  162.     begin
  163.       fecha := now();
  164.       fechafinal := DateTimeToStr(fecha);
  165.       nombrefecha := fechafinal + '.avi';
  166.  
  167.       nombrefecha := StringReplace(nombrefecha, '/', ':', [rfReplaceAll,
  168.         rfIgnoreCase]);
  169.       nombrefecha := StringReplace(nombrefecha, ' ', '', [rfReplaceAll,
  170.         rfIgnoreCase]);
  171.       nombrefecha := StringReplace(nombrefecha, ':', '_', [rfReplaceAll,
  172.         rfIgnoreCase]);
  173.  
  174.       RenameFile('t', nombrefecha);
  175.  
  176.     end;
  177.  
  178.   end;
  179.  
  180.   procedure TForm1.sListView1DblClick(Sender: TObject);
  181.   begin
  182.  
  183.     ShellExecute(0, nil, PCHAR(sListView1.Selected.SubItems[0]), nil, nil,
  184.       SW_SHOWNORMAL);
  185.  
  186.   end;
  187.  
  188. end.
  189.  
  190. // The End ?
  191.  

Si lo quieren bajar lo pueden hacer de No tienes permisos para ver links. Registrate o Entra con tu cuenta.

Desconectado CrazyKade

  • *
  • Underc0der
  • Mensajes: 182
  • Actividad:
    0%
  • Reputación 0
  • Я только знаю что ничего не знаю!
    • Ver Perfil
« Respuesta #1 en: Diciembre 01, 2013, 11:51:50 pm »
Tiene muy buena pinta amigo!
Felicitaciones!

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1984
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3258
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2886
Último mensaje Febrero 24, 2010, 04:54:23 pm
por ANTRAX
[Delphi] Project Spartacus 1.0 (Regalo de Navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 1603
Último mensaje Diciembre 26, 2014, 11:54:34 pm
por n4pst3r