Código:
Option Explicit
Dim PATH As String
Dim PAGINA As String
Private Sub Estado_Click()
If Estado.Caption = "Iniciar" Then
PATH = DRaiz.Text ' Path indica una ruta de acceso
Estado.Caption = "Detener"
WS.LocalPort = 80 ' Devuelve o establece el puerto local que desea usar.
WS.Listen 'Deja a la escucha el puerto
LEventos.Clear
Me.Caption = "XServer - Iniciado en http://" & WS.LocalIP & "/"
Else
Estado.Caption = "Iniciar"
Me.Caption = "XServer - Detenido"
WS.Close 'necesario para aceptar la conexion
End If
End Sub
Private Sub Eventos(Texto As String)
LEventos.AddItem Texto 'introducir texto
LEventos.ListIndex = LEventos.NewIndex 'Indica el número de la lista más recientemente seleccionado
End Sub
Private Sub Form_Load()
DRaiz = App.PATH & "\" 'identifica el directorio en el cuál está el archivo de nuestra pagina
End Sub
Private Sub WS_ConnectionRequest(ByVal requestID As Long) 'cuando se intente conectar a este (servicio,puerto,socket,o etc..) recojera su ip y ejecutara el siguiente codigo:
Eventos "Solicitud de conexion..." & requestID
If WS.RemoteHostIP = "198.23.33.33" Then 'esto hara que se ponga la ip remota del servidor, en este caso se indica nuestra direccin ip.
Eventos "conexion " & requestID & " Denegada"
Exit Sub
End If
If WS.State <> sckClosed Then WS.Close 'Comprueba el estado de la red, si se está conectado a ninguna red no arranca la vigilancia del puerto
WS.LocalPort = 0 'El número de puerto
WS.Accept requestID 'acepta cualquier conexion entrante
Eventos "conexion " & requestID & " Aceptada"
Eventos "Enviando Datos..."
DoEvents
If ExisteArchivo(PATH & "/" & PAGINA) Then
WS.SendData AbrirArchivo(PATH & "/" & PAGINA)
Else
WS.SendData "<html><font face='Verdana' size='1'><b>NO SE ENCUENTRA - " & PAGINA & "</b></font></html>" 'ERROR 404
End If
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long) 'es la llegada de datos
Dim DATA As String
Dim STRAUX As String
Dim BUSCAR_ENVIAR As String
Dim BUSCAR_RECIBIR As String
WS.GetData DATA 'metemos en la variable DATA los datos que nos lleguen
If Mid(DATA, 1, 3) = "GET" Then 'coger el tamaño del 1 al 3 caracter de la variable data
BUSCAR_ENVIAR = InStr(DATA, "GET ")
STRAUX = InStr(BUSCAR_ENVIAR + 5, DATA, " ")
PAGINA = Mid(DATA, BUSCAR_ENVIAR + 4, STRAUX - (BUSCAR_ENVIAR + 4))
ElseIf Mid(DATA, 1, 4) = "POST" Then
BUSCAR_RECIBIR = InStr(DATA, "POST ")
STRAUX = InStr(BUSCAR_RECIBIR + 5, DATA, " ")
PAGINA = Mid(DATA, BUSCAR_RECIBIR + 5, STRAUX - (BUSCAR_RECIBIR + 5))
End If
End Sub
Private Sub WS_SendComplete()
Eventos "Datos Enviados (" & PAGINA & ")"
WS.Close
WS.LocalPort = 80
WS.Listen
End Sub