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
  • 1744 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 aca.

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!



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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3265
Ú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: 2054
Ú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: 3512
Ú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: 2987
Ú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: 1680
Último mensaje Diciembre 26, 2014, 11:54:34 pm
por n4pst3r