Hola a todos o a los que lean
hace un parde dias que estoy intentando hacer una especie de servidor web
funciona casi todo bien, el casi es por que no puedo hacer que mande archivos correctamente
si alguien me puede ayudar o sabe como hacer para que lo mande correctamente le agradeceria mucho pero enserio
hasta les mando una foto diciendo gracias
el codigo es el sig
saludos
Dim Dato As String
Dim Requestedpage As String
Private Function ExisteArchivo(ByVal Archivo As String) As Integer
Dim I As Integer
On Error Resume Next
I = Len(Dir(Archivo))
If Err Or I = 0 Then
ExisteArchivo = False
Else
ExisteArchivo = True
End If
End Function
Private Function LoadBinary(ByVal strFileName As String) As String
Dim ff As Integer
ff = FreeFile
Open strFileName For Binary As #ff
LoadBinary = Input(FileLen(strFileName), #ff)
Close #ff
End Function
Private Function Pagina_Prueba()
Dim x As String
x = ""
x = x & "" & vbCrLf
x = x & " " & vbCrLf
x = x & "" & vbCrLf
x = x & "
x = x & "content=""text/html; charset=iso-8859-1"">" & vbCrLf
x = x & "jcq web server" & vbCrLf
x = x & "" & vbCrLf
x = x & " " & vbCrLf
x = x & "" & vbCrLf
x = x & "" & vbCrLf
x = x & " " & vbCrLf
x = x & "jcq web server " & vbCrLf
x = x & " " & vbCrLf
x = x & " " & vbcrlft
x = x & " " & vbCrLf
x = x & " " & vbcrlft
x = x & "
x = x & "href=""http://jcq.dnsalias.com/Cliente_Jcq_BETA.exe"">http://jcq.dnsalias.com/Cliente_Jcq_BETA.exe " & vbCrLf
x = x & "
x = x & "href=""http://jcq.dnsalias.com/prueba.mp3"">http://jcq.dnsalias.com/prueba.mp3 " & vbCrLf
x = x & "
x = x & "href=""http://jcq.dnsalias.com/download.zip"">http://jcq.dnsalias.com/download.zip " & vbCrLf
x = x & "" & vbCrLf
x = x & "" & vbCrLf
'x = x & " " & vbcrlf
'x = x & " " & vbcrlf
'x = x & " " & vbcrlf
'x = x & " " & vbcrlf
Pagina_Prueba = x
End Function
Private Sub Form_Load()
List1.Clear
Winsock1.LocalPort = 80
Winsock1.Listen
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
On Error GoTo solucion
Winsock1.Close
Winsock1.LocalPort = 0
Winsock1.Accept requestID
List1.AddItem Winsock1.RemoteHostIP
DoEvents
If Requestedpage = "/" Or Requestedpage = "" Then 'manda la pagina de inicio
Winsock1.SendData Pagina_Prueba
Else
'aca tengo que hacer que mande las cosas que le pido, por ej los archivos
Requestedpage = Right(Requestedpage, Len(Requestedpage) - 1)
If ExisteArchivo(App.Path + "\" + Requestedpage) Then
Text1.Text = LoadBinary(App.Path + "\" + Requestedpage)
Winsock1.SendData LoadBinary(App.Path + "\" + Requestedpage)
DoEvents
Else
Winsock1.SendData "Error"
End If
End If
Exit Sub
solucion:
MsgBox Err.Number & " " & Err.Description
Text1.Text = Err.Number & " " & Err.Description
Winsock1.Close
Winsock1.LocalPort = 80
Winsock1.Listen
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Dim dato As String
Winsock1.GetData Dato
Text2.Text = ""
Text2.Text = Dato
If Mid(Dato, 1, 3) = "GET" Then
findget = InStr(Dato, "GET ")
spc2 = InStr(findget + 5, Dato, " ")
pagetoget = Mid(Dato, findget + 4, spc2 - (findget + 4))
Requestedpage = pagetoget
Form1.Caption = Requestedpage
List2.AddItem Requestedpage
ElseIf Mid(Dato, 1, 4) = "POST" Then
findpost = InStr(Dato, "POST ")
spc2 = InStr(findpost + 5, Dato, " ")
pagetopost = Mid(Dato, findpost + 5, spc2 - (findpost + 5))
Requestedpage = pagetopost
End If
End Sub
Private Sub Winsock1_SendComplete()
Winsock1.Close
Winsock1.LocalPort = 80
Winsock1.Listen
End Sub
|
