Autor
Paso a la explicacion (despues de haber leido y releido muchos postt relacionados con esta aplicacion) tengo muchas gana de aprender, pero he tenido varios problemas al tratar de terminar este proyecto (el mio) reconozco que los codigos no son muy eficientes y que tambien no son mios (de mi creacion), bueno despues de aclar esto paso a exponerles mi problema..... o mejor les publico el code del proyecto...!!!
FUNCIONES DE LA APLICACION:
1.- ES UNA APLICACION CLIENTE SERVIDOR (SERVIDOR/CLIENTE A LA INVERSA)
2.- TRANSMISION DE ARCHIVOS (IMAGENES) DEL SERVIDOR Y ENVIADAS AL CLIENTE (NO ENTIENDO MUY BIEN A PLENITUD LA TRANFERENCIA DE ARCHIVOS
3.- NO ENTIENDO QUE ERROR ESTOY COMETIENDO....!!!! (ME PODRIAN HACERLO VER, CORRIENDO ESTE CODE Y SEÑALARME LAS FALLLAS)
EL CLIENTE:
Código:
Dim DataFile As String
Dim LenFile As Long
Dim Envio As Boolean
Private Sub Command1_Click()
Select Case Command1.Caption
Case "Iniciar Captura"
Ws.SendData "Pantalla|" & "IniciarPantalla"
Command1.Caption = "Parar Captura"
Case "Parar Captura"
Ws.SendData "Pantalla|" & "PararPantalla"
Command1.Caption = "Iniciar Captura"
End Select
End Sub
Private Sub Command2_Click()
Select Case Command2.Caption
Case "Iniciar WebCam"
Ws.SendData "WebCam|" & "IniciarWebCam"
Command2.Caption = "Parar WebCam"
Case "Parar WebCam"
Ws.SendData "WebCam|" & "PararWebCam"
Command2.Caption = "Iniciar WebCam"
End Select
End Sub
Private Sub Form_Load()
Ws.LocalPort = 2848
Ws.Listen
Envio = False
End Sub
Private Sub Ws_Close()
Ws.Close
Ws.Listen
End Sub
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
Ws.Close
Ws.Accept requestID
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Ws.GetData data
If Envio = True Then
DataFile = DataFile & data
If Len(DataFile) = LenFile Then
Open "C:\Captura2.jpg" For Binary As #1
Put #1, , DataFile
Close #1
DataFile = ""
MsgBox "El Fichero se a Recibido Correctamente"
Envio = False
'Una vez lo tenemos lo mostramos
Picture1.Cls
Picture1.Picture = LoadPicture("C:\Captura2.jpg")
Kill "C:\Captura2.jpg"
End If
End If
'Confirma la palabra clave "Tamaño:" (7 caracteres)y el tamaño del archivo
If Left(data, 7) = "Tamaño:" Then
'Almacena el tamaño del archivo
LenFile = Mid(data, 8) '(imagen)
'Activa el envio del archivo (imagen)
Envio = True
'Solicita el envio del archivo enviando la palabra clave "EnviarArchivo" (imagen al servidor)
Ws.SendData "EnviarArchivo"
End If
End Sub
EL SERVIDOR:
Código:
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
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
Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private hWndCap As Long
'///////////////////////////////////////////////////////////////////////////////////
Dim Buffer() As Byte
Dim lBytes As Long
Private Sub Form_Load()
Ws.Close
Ws.CONNECT "127.0.0.1", 2848
TimerPantalla.Enabled = False
TimerPantalla.Interval = 1
TimerWebcam.Enabled = False
TimerWebcam.Interval = 1
End Sub
Private Sub Ws_Close()
Ws.Close
Ws.Listen
End Sub
Private Sub ws_Connect()
MsgBox "Estas Conectado con el Cliente"
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim Enviar As String
Dim vData As Variant
Ws.GetData data
vData = Split(data, "|")
'////////////////////////////////SELECCION DE ACCIONES\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Select Case vData(0)
Case "Pantalla"
Select Case vData(1)
Case "IniciarPantalla"
Call IniciarPantalla
Case "PararPantalla"
Call PararPantalla
End Select
Case "WebCam"
Select Case vData(1)
Case "IniciarWebCam"
Call IniciarWebcam
Case "PararWebCam"
Call PararWebcam
End Select
End Select
'////////////////////////////////ENVIO DE ARCHIVO CAPTURA\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
If Left(data, 13) = "EnviarArchivo" Then
Open "c:\foto\captura1.jpg" For Binary As #1
Enviar = Space(LOF(1))
Get #1, , Enviar
Close #1
Ws.SendData Enviar
Kill ("c:\foto\captura1.jpg")
End If
End Sub
'////////////////////////////////PANTALLA\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Sub IniciarPantalla()
TimerPantalla.Enabled = True
End Sub
Sub PararPantalla()
TimerPantalla.Enabled = False
End Sub
Private Sub TimerPantalla_Timer()
Dim Foto As New cJpeg
Foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
Foto.Quality = 50 ' aqui ajustas la calidad desde 1 a 100 asi bajas calidad bajas peso
Foto.SampleScreen
Foto.SaveFile ("c:\foto\captura1.jpg")
'Envia Tamaño del archivo (imagen capturada y guardada en la ruta indicada)
Ws.SendData "Tamaño:" & FileLen("c:\foto\captura1.jpg")
'Carga el archivo (imagen capturada desde la ruta indicada)
Picture1.Picture = LoadPicture("c:\foto\captura1.jpg")
End Sub
'////////////////////////////////WEBCAM\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Sub IniciarWebcam()
hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 160, 120, Me.hwnd, 0)
DoEvents
SendMessage hWndCap, CONNECT, 0, 0
TimerWebcam.Enabled = True
End Sub
Sub PararWebcam()
DoEvents: SendMessage hWndCap, DISCONNECT, 0, 0
TimerWebcam.Enabled = False
End Sub
Private Sub TimerWebcam_Timer()
'Obtiene frames para Picture1
SendMessage hWndCap, GET_FRAME, 0, 0
SendMessage hWndCap, COPY, 0, 0
SendMessage hWndc, SET_SCALE, True, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
SavePicture Picture1.Picture, "c:\foto\captura1.jpg"
'Envia Tamaño del archivo (imagen capturada y guardada en la ruta indicada)
Ws.SendData "Tamaño:" & FileLen("c:\foto\captura1.jpg")
'Carga el archivo (imagen capturada desde la ruta indicada)
Picture1.Picture = LoadPicture("c:\foto\captura1.jpg")
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyWindow hWndCap
End Sub
Y UN MODULO LLAMADO cJPEG.CLS
CODIGO DEL PROYECTO.....!!!
http://www.savefile.com/files/993534
En línea
