elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Usando Git para manipular el directorio de trabajo, el índice y commits (segunda parte)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Evitar la seleccion de la camara web
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Evitar la seleccion de la camara web  (Leído 3,193 veces)
illuminat3d

Desconectado Desconectado

Mensajes: 231



Ver Perfil WWW
Evitar la seleccion de la camara web
« en: 25 Marzo 2016, 20:42 pm »

Es un codigo sencillo, es para capturar la camara web, lo que quiero saber es como evitar que salga el dialogo para seleccionar el source de la camara, obtenerlo por otro medio el source y seleccionarlo de una forma diferente, la linea que muestra el dialogo es la siguiente :

Código
  1. SendMessage mCapHwnd, 1034, 0, 0

El codigo solo necesita un picturebos y un timer para que lo prueben.

Código
  1. Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  2. Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
  3.  
  4. Private mCapHwnd As Long
  5. Private Sub Form_Load()
  6. STARTCAM
  7. End Sub
  8.  
  9. Private Sub Timer1_Timer()
  10. SendMessage mCapHwnd, 1084, 0, 0
  11. SendMessage mCapHwnd, 1054, 0, 0
  12. Picture1.Picture = Clipboard.GetData
  13. End Sub
  14.  
  15. Sub STARTCAM()
  16. mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
  17. 'DoEvents
  18. SendMessage mCapHwnd, 1034, 0, 0
  19. End Sub
  20.  
  21.  

Un saludo y espero algunas ideas! ;)


En línea

Lekim

Desconectado Desconectado

Mensajes: 268



Ver Perfil
Re: Evitar la seleccion de la camara web
« Respuesta #1 en: 1 Abril 2016, 02:03 am »

Hola

He probado tu código y a mi no me aparece ningún diálogo.



Código
  1.  
  2. Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
  3.    Alias "capCreateCaptureWindowA" ( _
  4.    ByVal lpszWindowName As String, _
  5.    ByVal dwStyle As Long, _
  6.    ByVal x As Long, _
  7.    ByVal y As Long, _
  8.    ByVal nWidth As Long, _
  9.    ByVal nHeight As Long, _
  10.    ByVal hwndParent As Long, _
  11.    ByVal nID As Long) As Long
  12.  
  13. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
  14.    ByVal hwnd As Long, _
  15.    ByVal wMsg As Long, _
  16.    ByVal wParam As Long, _
  17.    lParam As Any) As Long
  18.  
  19. Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
  20.  
  21. Private Const CONNECT As Long = 1034
  22. Private Const DISCONNECT As Long = 1035
  23. Private Const GET_FRAME As Long = 1084
  24. Private Const COPY As Long = 1054
  25. Private hWndCap As Long
  26. '//Activar Cámara web
  27. Private Sub Command1_Click()
  28. Conectar
  29. Timer1.Enabled = True
  30. End Sub
  31. '//Desconecta la cámara web
  32. Private Sub Command2_Click()
  33. Dim ClearImage As IPictureDisp
  34. Desconectar
  35. Timer1.Enabled = False
  36. Picture1.Refresh
  37. Picture1.Picture = ClearImage
  38. End Sub
  39.  
  40. Public Sub CapturarCamara()
  41. Dim x As Long
  42. Picture1.Refresh
  43. x = SendMessage(hWndCap, GET_FRAME, 0, 0)
  44. x = SendMessage(hWndCap, COPY, 0, 0)
  45. Picture1.Picture = Clipboard.GetData
  46. End Sub
  47. Sub Conectar()
  48.   Dim x As Long
  49.    hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
  50.    DoEvents
  51.    x = SendMessage(hWndCap, CONNECT, 0, 0)
  52.  
  53. End Sub
  54. Sub Desconectar()
  55. Dim x As Long
  56.    DoEvents
  57.    x = SendMessage(hWndCap, DISCONNECT, 0, 0)
  58.    x = DestroyWindow(hWndCap)
  59. End Sub
  60.  
  61. Private Sub Form_Load()
  62. Timer1.Interval = 1
  63. Timer1.Enabled = False
  64. End Sub
  65.  
  66. Private Sub Form_Unload(Cancel As Integer)
  67.   Dim x As Long
  68.   Desconectar
  69.    x = DestroyWindow(hWndCap)
  70. End Sub
  71.  
  72. Private Sub Timer1_Timer()
  73. CapturarCamara
  74. End Sub
  75.  
  76.  
  77.  


En línea

illuminat3d

Desconectado Desconectado

Mensajes: 231



Ver Perfil WWW
Re: Evitar la seleccion de la camara web
« Respuesta #2 en: 1 Abril 2016, 16:42 pm »


En línea

Lekim

Desconectado Desconectado

Mensajes: 268



Ver Perfil
Re: Evitar la seleccion de la camara web
« Respuesta #3 en: 5 Abril 2016, 17:40 pm »

Al parecer tienes más de un controlador.

Como no tengo más dispositivos no puedo probar lo que te voy a proponer así que ya me contarás.

Este código obtiene una descripción de las versiones de controladores de captura:

Código
  1. Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Long, _
  2. ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, _
  3. ByVal cbVer As Long) As Boolean
  4.  
  5. Private Sub Form_Load()
  6. Dim strName As String
  7. Dim strVer As String
  8. Dim iReturn As Boolean
  9. Dim X As Long
  10.  
  11. X = 0
  12. strName = Space(100)
  13. strVer = Space(100)
  14.  
  15. Do
  16. iReturn = capGetDriverDescriptionA(X, strName, 100, strVer, 100)
  17. If iReturn Then List1.AddItem Trim$(strName)
  18. X = X + 1
  19. Loop Until iReturn = False
  20. End Sub
  21.  

Obtiene un lista de controladores.

El NOMBRE de la lista del controlador que quieres utilizar es el que se debe establecer en

capCreateCaptureWindowA
:

Código:
capCreateCaptureWindowA(NOMBRE ,dwStyle, X, Y, nWidth, hWnd nID                 )

En dwStyle puedes establecer las constantes :
Código
  1. Const WS_CHILD As Long = &H40000000
  2. Const WS_VISIBLE As Long = &H10000000

Si pones List1.List(0), utilizará el primero de la lista.

Tú has puesto "WebcamCapture", quizás este sea el problema.

He realizado este código a partir del que encontré aquí:

Manejo de cámara

Está muy bien porque no necesitas el Timer y la transición entre imágenes es muy suave. La diferencia con el de la página es que uso el nombre del controlador en lugar de iDevice que es un número, y capCreateCaptureWindowA demanda String y reservo el índice en IndexDevice  para el SendMessage. Además puedes guardar imagen de un frame en un instante determinado sin que la captura que se muestra en el Picture se congele.

Necesitas tres botones, un listbox y un Picture, con los nombres:
cmdConectar
cmdDesconectar
cmdGuardar
List1
Picture1

Código
  1.  
  2. Const WM_CAP As Integer = &H400
  3.  
  4. Const WM_CAP_DRIVER_CONNECT As Long = 1034
  5. Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
  6. Const WM_CAP_DRIVER_GET_FRAME As Long = 1084
  7. Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
  8.  
  9. Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
  10. Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP + 52
  11. Const WM_CAP_SET_SCALE As Long = WM_CAP + 53
  12. Const WS_CHILD As Long = &H40000000
  13. Const WS_VISIBLE As Long = &H10000000
  14. Const SWP_NOMOVE As Long = &H2
  15. Const SWP_NOSIZE As Integer = 1
  16. Const SWP_NOZORDER As Integer = &H4
  17. Const HWND_BOTTOM As Integer = 1
  18.  
  19.  
  20. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  21. (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  22. lParam As Any) As Long
  23.  
  24. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
  25. ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
  26. ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  27.  
  28. Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
  29.  
  30. Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
  31. (ByVal lpszWindowName As String, ByVal dwStyle As Long, _
  32. ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
  33. ByVal nHeight As Integer, ByVal hWndParent As Long, _
  34. ByVal nID As Long) As Long
  35.  
  36. Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Long, _
  37. ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, _
  38. ByVal cbVer As Long) As Boolean
  39.  
  40.  
  41. Dim strDevice As String
  42. Dim IndexDevice As Integer
  43. Dim hHwnd As Long
  44.  
  45. Private Sub cmdDesconectar_Click()
  46. cmdConectar.Enabled = True
  47. cmdGuardar.Enabled = False
  48. cmdDesconectar.Enabled = False
  49. Desconectar
  50. End Sub
  51.  
  52. Private Sub cmdGuardar_Click()
  53. On Error GoTo EvitarError:
  54. Dim objPic As IPictureDisp
  55.  
  56. '//Guarda una imagen de un frame
  57. SendMessage hHwnd, WM_CAP_EDIT_COPY, 0, 0
  58. If Clipboard.GetFormat(vbCFBitmap) Then
  59. Set objPic = Clipboard.GetData(vbCFBitmap)
  60. SavePicture objPic, App.Path & "\ImagenWebCam1.bmp"
  61.  
  62. End If
  63. EvitarError:
  64. If Err.Number <> 0 Then
  65. MsgBox (Err.Description)
  66. End If
  67. End Sub
  68.  
  69. Private Sub cmdConectar_Click()
  70.  
  71. strDevice = List1.List(List1.ListIndex)
  72. IndexDevice = List1.ListIndex
  73. ConectarCamara
  74. End Sub
  75. '//Conecta la cámara
  76. Private Sub ConectarCamara()
  77.  
  78. '//Activa la webcam
  79. hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hwnd, 0)
  80. If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0) Then
  81. SendMessage hHwnd, WM_CAP_SET_SCALE, False, 0
  82. SendMessage hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0
  83. SendMessage hHwnd, WM_CAP_SET_PREVIEW, True, 0
  84.  
  85.  
  86. SetWindowPos hHwnd, HWND_BOTTOM, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
  87. SWP_NOMOVE Or SWP_NOZORDER
  88.  
  89. cmdGuardar.Enabled = True
  90. cmdDesconectar.Enabled = True
  91. cmdConectar.Enabled = False
  92.  
  93. Else
  94. DestroyWindow hHwnd
  95. cmdGuardar.Enabled = False
  96. End If
  97.  
  98. End Sub
  99.  
  100. '//Muestra una lista de controladores
  101. Private Sub CargarListaControladores()
  102. Dim strName As String
  103. Dim strVer As String
  104. Dim iReturn As Boolean
  105. Dim x As Long
  106.  
  107. x = 0
  108. strName = Space(100)
  109. strVer = Space(100)
  110. Do
  111. iReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
  112. If iReturn Then List1.AddItem Trim$(strName)
  113. x = x + 1
  114. Loop Until iReturn = False
  115. End Sub
  116. '//Descanecta la camara
  117. Sub Desconectar()
  118. Dim x As Long
  119.    DoEvents
  120.    x = SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
  121.    x = DestroyWindow(hHwnd)
  122. End Sub
  123.  
  124.  
  125.  
  126. Private Sub Form_Load()
  127. cmdConectar.Caption = "Conectar"
  128. cmdDesconectar.Caption = "Desconectar"
  129. cmdGuardar.Caption = "Guardar frame"
  130. cmdGuardar.Enabled = False
  131. cmdDesconectar.Enabled = False
  132.  
  133. CargarListaControladores
  134. 'Seleciona el primer controlador de la lista
  135. If List1.ListCount > 0 Then
  136. List1.Selected(0) = True
  137. cmdConectar.Enabled = True
  138. Else
  139. cmdConectar.Enabled = False
  140. MsgBox ("No Device Available")
  141. End If
  142.  
  143.  
  144. End Sub
  145.  
  146.  


El índice del controlador queda guardado en IndexDevice cuando se selecciona en el ListBox. Se envía un mensaje con este índice y si dicho índice no está en la lista no se activa.

Código:
SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0)

Prueba a ir cambiando el controlador de la lista a ver si no te aparece el diálogo.

Una vez me apareció cuando conecté y desconecté rápidamente pero, por mucho que lo he vuelto a hacer no me vuelve a salir. No tengo ni idea de porqué. Si el controlador está siendo usado por otra apliación, el picture aparece de color verde.




s2s
« Última modificación: 5 Abril 2016, 18:00 pm por Lekim » En línea

illuminat3d

Desconectado Desconectado

Mensajes: 231



Ver Perfil WWW
Re: Evitar la seleccion de la camara web
« Respuesta #4 en: 7 Abril 2016, 15:57 pm »

Gracias Lekim por tomarte la molestia lo primero que todo, es cierto que sin un timer la muestra de imagenes es mas fluida, lo que no veo eso el principal problema, ten en cuenta que para que no envie tantas capturas al cliente. Esta muy bien tu codigo el unico problema es que seguimos sin conseguir el resultado, porque la api capGetDriverDescriptionA obtiene una descripcion pero no el nombre del dispositivo de video, ¿tu crees que poniendo el nombre del dispositivo de video en lugar de "WebCamCapture" seleccionaria directamente el controlador ese sin necesidad de seleccionarlo?.



Un saludo y muchas gracias igual sigo revisando el codigo!  ;-)
En línea

Lekim

Desconectado Desconectado

Mensajes: 268



Ver Perfil
Re: Evitar la seleccion de la camara web
« Respuesta #5 en: 7 Abril 2016, 19:05 pm »

Mi teoría es que  la función llama a capCreateCaptureWindowA para obtener el handle (hwnd) y posteriormente se manda el mensaje para conectar pero el paso de uno al otro es demasiado rápido, casi simultáneo y se intenta conectar ANTES de haber recibido el handle o preparar el dispositivo, yo que se  :P.

Una solución podría ser crear una espera entre un proceso y el otro

Por ejemplo:


Código
  1. Do
  2. hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hwnd, 0)
  3. DoEvents
  4. Loop While hwnd = 0

O mejor:

Código
  1.  
  2. '//...
  3. Private Sub Espera(Segundos As Single)
  4.  Dim ComienzoSeg As Single
  5.  Dim FinSeg As Single
  6.  ComienzoSeg = Timer
  7.  FinSeg = ComienzoSeg + Segundos
  8.  Do While FinSeg > Timer
  9.      DoEvents
  10.      If ComienzoSeg > Timer Then
  11.          FinSeg = FinSeg - 24 * 60 * 60
  12.      End If
  13.  Loop
  14. End Sub
  15.  
  16.  
  17. '//Conecta la cámara
  18. Private Sub ConectarCamara()
  19.  
  20. '//Activa la webcam
  21. hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hWnd, 0)
  22.  
  23. Espera (2) '///<---Esperar dos segundos antes de conectar
  24.  
  25. Dim Retry As Boolean, I As Integer
  26.  
  27. For I = 1 To 10 '//Hace diez intentos para conectar
  28. Retry = SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0)
  29.  
  30.    If Retry = True Then
  31.        SendMessage hHwnd, WM_CAP_SET_SCALE, False, 0
  32.        SendMessage hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0
  33.        SendMessage hHwnd, WM_CAP_SET_PREVIEW, True, 0
  34.  
  35.        SetWindowPos hHwnd, HWND_BOTTOM, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
  36.        SWP_NOMOVE Or SWP_NOZORDER
  37.  
  38.        cmdGuardar.Enabled = True
  39.        cmdDesconectar.Enabled = True
  40.        cmdConectar.Enabled = False
  41.        Exit For
  42.    End If
  43. Next I
  44.  
  45. If Retry = False Then
  46.        DestroyWindow hHwnd
  47.        cmdGuardar.Enabled = False
  48. End If
  49.  
  50. End Sub
  51.  
  52.  
  53. '//...
  54.  
  55.  




Me he basado en las respuestas de este otro usuario que tenía el mismo problema:

http://stackoverflow.com/questions/10721085/webcam-video-source-dialog-comes-up


Código:
...

2
down vote
Finally I Found a solution for this.
The problem happens in Windows 7 / 8

First you need this API function

Private Declare Function GetTickCount Lib "kernel32" () As Long
Then... after you call capCreateCaptureWindowA() you have to wait 1 second processing events, (note: sleep don't work the same)

IniTime = GetTickCount()
While GetTickCount() < (IniTime + 1000)
   DoEvents
Wend
then you call WM_CAP_DRIVER_CONNECT (maybe a couple of times).. and THAT's IT ... no more video source dialog

'...

With this solution it works perfect. The GetTickCount() waiting for events worked along with calling the function until it returned true.

Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)    
    hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0,
   0, pbCtrl.Handle.ToInt64, 0)    
    Dim IniTime As Long = GetTickCount()
    While GetTickCount() < (IniTime + 1000)
        Application.DoEvents()
    End While    
    Dim OKAnswer As Boolean = False
    For xretries As Integer = 1 To 10
          ' I'll give you Only 10 tries to connect, otherwise I AM LEAVING MICROSOFT!
          OKAnswer = SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0)
          If OKAnswer Then
              Exit For
          End If    
    Next    
    If okanswer Then
          SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
          SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
          SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
          SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, pbCtrl.Width, pbCtrl.Height, SWP_NOMOVE Or SWP_NOZORDER)    
    Else
          DestroyWindow(hWnd)    
    End If    
End Sub

Claro que esto es en Net
« Última modificación: 7 Abril 2016, 19:27 pm por Lekim » En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines