Con este ejemplo vamos a ver como nos conectamos a un servidor externo, por un puerto indicado, recogeremos la hora actual GMT y actualizaremos las hora de nuestro ordenador. Utilizaremos el protocolo TCP del control Microsoft WinSock Control (MsWinSck.Ocx).
Vamos a conectarnos con el servidor www.boulder.nist.gov. Usando el puerto 13.
Este servicio trabaja de la siguiente manera (nosotros seremos el cliente):
- Servidor: Esta escuchando en el puerto 13.
- Cliente: Conectamos con el puerto 13
- S: Nos envía la hora
- C: Recibimos la cadena de la hora actual
- C: Cerramos la conexión
- S: Cierra la conexión
El servidor esta escuchando en el puerto 13 a al espera de las posibles conexiones que puedan realizarse. Cuando se establece una conexión, el servidor reenvía el valor horario y cierra la conexión. Si el servidor no esta disponible la conexión será rechazada o cerrada sin enviar nada.
Código del Programa
En principio no supone mayor problema si conocemos un poco el funcionamiento de los Socket. Vamos a por el código para ver lo simple que resulta:
Para este proyecto hay que añadir el componente "Microsoft Winsock Control 5.0" y vamos a llamarle "Socket".
Option Explicit
Private Sub Form_Load()
' Si no esta cerrado lo cerramos, pura precaución
If Socket.State <> sckClosed Then Socket.Close
' Configuramos el puerto
Socket.Protocol = sckTCPProtocol
Socket.RemoteHost = "www.boulder.nist.gov"
Socket.RemotePort = 13
' Conectamos
Socket.Connect
End Sub
Private Sub Socket_Close()
' Si se cierra el socket
If Socket.State <> 0 Then Socket.Close
End Sub
Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
Dim DatosRecibidos As String
DatosRecibidos = String(bytesTotal, " ")
Socket.GetData DatosRecibidos, vbString, bytesTotal
MsgBox "Hora Actual: " & DatosRecibidos
End SubComo veis el proceso es muy sencillo, es conectar y esperar la respuesta.
Ahora vamos a formatear los datos recibidos para presentarlo adecuadamente y prepararlo para asignar la hora al sistema.
Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
Dim DatosRecibidos As String ' Contenedor de los datos recibidos
Dim FechaActual As Date ' Para convertir la fecha
Dim Resultado As Long ' Respuesta del API
Dim HoraSistema As SYSTEMTIME ' Asignación para el API
Dim TxtTmp As String ' Variable de apoyo para los procesos
DatosRecibidos = String(bytesTotal, " ")
Socket.GetData DatosRecibidos, vbString, bytesTotal
Debug.Print DatosRecibidos
' Vamos a eliminar los caracteres que no nos sirven CHR(10) por "" (caracteres nulos)
' Estan al principio y final
If Left(DatosRecibidos, 1) = Chr(10) Then DatosRecibidos = Mid(DatosRecibidos, 2)
If Right(DatosRecibidos, 1) = Chr(10) Then DatosRecibidos = Left(DatosRecibidos, Len(DatosRecibidos) - 1)
' Extraemos la fecha con formato yy-mm-dd y la hora hh:nn:ss
TxtTmp = Mid(DatosRecibidos, InStr(DatosRecibidos, Chr(32)) + 1, 17)
' Convertimos a fecha con formato dd/mm/yy
FechaActual = CDate(Mid$(TxtTmp, 7, 2) & "/" & Mid$(TxtTmp, 4, 2) & "/" & Mid$(TxtTmp, 1, 2) & " " & Mid$(TxtTmp, 10))
' Ahora preparamos los datos para actualizar el reloj del sistema
With HoraSistema
.wYear = DatePart("yyyy", FechaActual)
.wMonth = DatePart("m", FechaActual)
.wDay = DatePart("d", FechaActual)
.wHour = DatePart("h", FechaActual)
.wMinute = DatePart("n", FechaActual)
.wSecond = DatePart("s", FechaActual)
.wMilliseconds = 0
End With
' Asignamos la hora al sistema
Resultado = SetSystemTime(HoraSistema)
MsgBox FechaActual & vbCrLf & DatosRecibidos & " GMT"
End Sub
La función SetSystemTime actualiza la hora teniendo en cuenta la diferencia horaria con respecto a la hora GMT o UTC.
Y ya tenemos el programa terminado, bueno faltan las declaraciones de la API y del Tipo de Datos SYSTEMTIME:
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Enviado
feb 26 2002, 11:54
por
Maverick