AYUDA CON WINSOCK
Publicado por mariano (1 intervención) el 26/02/2005 18:15:07
El sistemita es un Cyber control, desde el servidor habilitamos la maquina que queremos, con un determinado tiempo y despues, le envio el tiempo al cliente, este se habilita y cuando pasa el tiempo se deshabilita y le avisa al servidor.
El problema es que cuando pasa el tiempo no se deshabilita ni le avisa al servidor a a pasado el tiempo.
este es el codigo:
CLIENTE
Private Sub Form_Load()
'Procedimiento que setea las variable de inicializacion
Seteo
'Numero de IP del servidor
' Invoca el método Connect para iniciar
' una conexión
LeerParam
Me.Caption = NomHost
Load cliente(1)
Estado = eDisp
ConectarIN
ConectarOUT
bloqueo
contador = 0
End Sub
Private Sub tContador_Timer()
If Conexion Then
If contador = Tiempo Then
Estado = eDisp
contador = 0
ConectarOUT
bloqueo
End If
contador = contador + 1
End If
End Sub
Private Sub tValidarCnn_Timer()
If Not Conexion Then
ConectarOUT
End If
End Sub
Private Sub cliente_Connect(Index As Integer)
Conexion = True
cliente(0).SendData Estado
End Sub
Private Sub cliente_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If cliente(1).State <> sckClosed Then cliente(1).Close
cliente(1).Accept requestID
End Sub
Private Sub cliente_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim DatosIn As String
cliente(1).GetData DatosIn
Tiempo = Val(DatosIn)
If Estado = eDisp Then
DesBloquear
Estado = eNoDisp
ConectarOUT
End If
ConectarIN
End Sub
Private Sub ConectarOUT()
On Error GoTo CheckErr:
Conexion = False
If cliente(0).State <> sckClosed Then cliente(0).Close
cliente(0).RemoteHost = IPServer
cliente(0).LocalPort = 0
cliente(0).RemotePort = 1001
cliente(0).Connect
Exit Sub
CheckErr:
MsgBox Err.Description
End Sub
Private Sub ConectarIN()
On Error GoTo CheckErr:
If cliente(1).State <> sckClosed Then cliente(1).Close
Call cliente(1).Bind(1001, IPLocalHost)
cliente(1).Listen
Exit Sub
CheckErr:
MsgBox Err.Description
End Sub
SERVIDOR
Private Sub Form_Load()
Me.Width = 10575: Me.Height = 6930
Load Servidor(1)
Call Servidor(1).Bind(PuertoIN, IPServer)
Servidor(1).Listen
End Sub
'Private Sub Servidor_Close(Index As Integer)
'If Index <> 0 Then
' Unload Servidor(Index)
'End If
'End Sub
Private Sub cHabilitar_Click()
Dim oUsuario As New clsUsuario
Dim Estado As String
On Error GoTo CheckErr:
Me.MousePointer = vbHourglass
oMaq.NumMaq = Maquina
oUsuario.Codigo = txtCodigo
If oUsuario.Existe And oMaq.ExistexMaq And gMaquinas.TextMatrix(gMaquinas.Row, 2) <> "No Disponible" Then
Conexion oMaq.IP
IPActual = oMaq.IP
UsuarioActual = oUsuario.Codigo
txtCodigo = ""
lblMaquina.Caption = ""
Else
MsgBox "El usuario no existe o la maquina no esta acivada", vbInformation, "Mensaje"
End If
Me.MousePointer = vbDefault
Exit Sub
CheckErr:
MsgBox Err.Description
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_Connect(Index As Integer)
Dim i As Integer
Me.MousePointer = vbHourglass
For i = 1 To Max
If MxAud(i).IP = "" Then
MxAud(i).IP = IPActual
MxAud(i).HoraIni = Now
MxAud(i).Usuario = UsuarioActual
Exit For '----------------------------->
End If
Next i
Servidor(Index).SendData CalcularTiempo
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Me.MousePointer = vbHourglass
' Comprueba si el estado del control es cerrado.
' De lo contrario, cierra la conexión antes de
' aceptar la nueva conexión.
' Acepta la petición con el parámetro
' requestID.
If Index = 1 Then
Indice = Servidor.UBound + 1
Load Servidor(Indice)
Servidor(Indice).Accept requestID
'Servidor(1).LocalPort = 1001
'Servidor(1).Listen
End If
'If Servidor(1).State <> sckClosed Then Servidor(1).Close
'Call Servidor(1).Bind(PuertoIN, IPServer)
'Servidor(1).Listen
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Cadena As String
Dim i As Integer
Me.MousePointer = vbHourglass
oMaq.IP = Servidor(Index).RemoteHostIP
If oMaq.ExistexIP Then
Servidor(Index).GetData Cadena
'procedimiento para la auditoria
If Cadena = eDisp Then
AsentarAud Servidor(Index).RemoteHostIP
End If
oMaq.Estado = Cadena
oMaq.Modificacion
RefrescarGrid
DoEvents
Else
MsgBox "El servidor no puede reconocer al cliente", vbInformation, "Mensaje"
End If
Me.MousePointer = vbDefault
End Sub
Private Sub Conexion(ByVal IP As String)
If Servidor(0).State <> sckClosed Then Servidor(0).Close
Servidor(0).RemotePort = 1001
Servidor(0).LocalPort = 0
Servidor(0).RemoteHost = IP
Servidor(0).Connect
End Sub
El problema es que cuando pasa el tiempo no se deshabilita ni le avisa al servidor a a pasado el tiempo.
este es el codigo:
CLIENTE
Private Sub Form_Load()
'Procedimiento que setea las variable de inicializacion
Seteo
'Numero de IP del servidor
' Invoca el método Connect para iniciar
' una conexión
LeerParam
Me.Caption = NomHost
Load cliente(1)
Estado = eDisp
ConectarIN
ConectarOUT
bloqueo
contador = 0
End Sub
Private Sub tContador_Timer()
If Conexion Then
If contador = Tiempo Then
Estado = eDisp
contador = 0
ConectarOUT
bloqueo
End If
contador = contador + 1
End If
End Sub
Private Sub tValidarCnn_Timer()
If Not Conexion Then
ConectarOUT
End If
End Sub
Private Sub cliente_Connect(Index As Integer)
Conexion = True
cliente(0).SendData Estado
End Sub
Private Sub cliente_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If cliente(1).State <> sckClosed Then cliente(1).Close
cliente(1).Accept requestID
End Sub
Private Sub cliente_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim DatosIn As String
cliente(1).GetData DatosIn
Tiempo = Val(DatosIn)
If Estado = eDisp Then
DesBloquear
Estado = eNoDisp
ConectarOUT
End If
ConectarIN
End Sub
Private Sub ConectarOUT()
On Error GoTo CheckErr:
Conexion = False
If cliente(0).State <> sckClosed Then cliente(0).Close
cliente(0).RemoteHost = IPServer
cliente(0).LocalPort = 0
cliente(0).RemotePort = 1001
cliente(0).Connect
Exit Sub
CheckErr:
MsgBox Err.Description
End Sub
Private Sub ConectarIN()
On Error GoTo CheckErr:
If cliente(1).State <> sckClosed Then cliente(1).Close
Call cliente(1).Bind(1001, IPLocalHost)
cliente(1).Listen
Exit Sub
CheckErr:
MsgBox Err.Description
End Sub
SERVIDOR
Private Sub Form_Load()
Me.Width = 10575: Me.Height = 6930
Load Servidor(1)
Call Servidor(1).Bind(PuertoIN, IPServer)
Servidor(1).Listen
End Sub
'Private Sub Servidor_Close(Index As Integer)
'If Index <> 0 Then
' Unload Servidor(Index)
'End If
'End Sub
Private Sub cHabilitar_Click()
Dim oUsuario As New clsUsuario
Dim Estado As String
On Error GoTo CheckErr:
Me.MousePointer = vbHourglass
oMaq.NumMaq = Maquina
oUsuario.Codigo = txtCodigo
If oUsuario.Existe And oMaq.ExistexMaq And gMaquinas.TextMatrix(gMaquinas.Row, 2) <> "No Disponible" Then
Conexion oMaq.IP
IPActual = oMaq.IP
UsuarioActual = oUsuario.Codigo
txtCodigo = ""
lblMaquina.Caption = ""
Else
MsgBox "El usuario no existe o la maquina no esta acivada", vbInformation, "Mensaje"
End If
Me.MousePointer = vbDefault
Exit Sub
CheckErr:
MsgBox Err.Description
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_Connect(Index As Integer)
Dim i As Integer
Me.MousePointer = vbHourglass
For i = 1 To Max
If MxAud(i).IP = "" Then
MxAud(i).IP = IPActual
MxAud(i).HoraIni = Now
MxAud(i).Usuario = UsuarioActual
Exit For '----------------------------->
End If
Next i
Servidor(Index).SendData CalcularTiempo
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Me.MousePointer = vbHourglass
' Comprueba si el estado del control es cerrado.
' De lo contrario, cierra la conexión antes de
' aceptar la nueva conexión.
' Acepta la petición con el parámetro
' requestID.
If Index = 1 Then
Indice = Servidor.UBound + 1
Load Servidor(Indice)
Servidor(Indice).Accept requestID
'Servidor(1).LocalPort = 1001
'Servidor(1).Listen
End If
'If Servidor(1).State <> sckClosed Then Servidor(1).Close
'Call Servidor(1).Bind(PuertoIN, IPServer)
'Servidor(1).Listen
Me.MousePointer = vbDefault
End Sub
Private Sub Servidor_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Cadena As String
Dim i As Integer
Me.MousePointer = vbHourglass
oMaq.IP = Servidor(Index).RemoteHostIP
If oMaq.ExistexIP Then
Servidor(Index).GetData Cadena
'procedimiento para la auditoria
If Cadena = eDisp Then
AsentarAud Servidor(Index).RemoteHostIP
End If
oMaq.Estado = Cadena
oMaq.Modificacion
RefrescarGrid
DoEvents
Else
MsgBox "El servidor no puede reconocer al cliente", vbInformation, "Mensaje"
End If
Me.MousePointer = vbDefault
End Sub
Private Sub Conexion(ByVal IP As String)
If Servidor(0).State <> sckClosed Then Servidor(0).Close
Servidor(0).RemotePort = 1001
Servidor(0).LocalPort = 0
Servidor(0).RemoteHost = IP
Servidor(0).Connect
End Sub
Valora esta pregunta


0