Últimos Temas de: dyanyta21

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