Este codigo es de HADES que conste, lo que lo he echo algunas modificaciones para ver si logro el resultado..
CODIGO ORIGINAL AGREGENLE un BOTON, Winsock y un ComonDialog
Const Host = "
www.tupagina.com" 'acá metes tu página, a la que queres mandar el archivo
Const Puerto = 80 'el puerto de conexión
Private Sub Abrir_Click()
Dim x 'declaramos variable
CD.CancelError = False 'hacemos que no tire error al darle en cancelar
CD.ShowOpen 'mostramos el diálogo para abrir el archivo
x = MsgBox("Esta seguro de enviar el archivo?", vbYesNo + vbCritical, "
") 'damos a x el valor de lo que escogimos: "sí" , "no"
If x = vbYes Then
UploadRequest (CD.FileName) 'Si es sí, entonces llamamos a esta función con la ruta del archivo
Else
MsgBox "Lastima
"
End If
End Sub
Public Sub UploadRequest(Archivo$) 'Este es el sub principal, para construir la petición y mandar el archivo, recibe parámetro del archivo
Dim CodigoA$, CuerpoM$, CuerpoN$, Contenido$, LongitudR# 'Variables
Contenido = AbrirArch(Archivo) 'Llamamos a la función AbrirArch (para continuar mirar más abajo)
If Contenido <> "" Then
CodigoA = AlphaMix 'generamos el código especificado más arriba
CuerpoM = "--" & CodigoA & vbCrLf & _
"Content-Disposition: form-data; name=""archivo""; filename=""" & CD.FileTitle & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & Contenido & vbCrLf & _
"--" & CodigoA & "--" 'empezamos a armar la cabecera, en estos momentos queda esta parte
'(codigo) (crlf)
'(Content-Disposition)(
(datos) (crlf)
'(Content-Type)(
(Tipo archivo) (crlf)
'(crlf)
'(contenido archivo) (crlf)
'(codigo)
LongitudR = Len(CuerpoM) 'la longitud para el content-length
CuerpoN = "POST /script.php HTTP/1.1" & vbCrLf & _
"Host: " & Host & vbCrLf & _
"Content-Type: multipart/form-data, boundary=" & CodigoA & vbCrLf & _
"Content-Length: " & LongitudR & vbCrLf & vbCrLf & CuerpoM 'armamos la otra cabecera...
'quedaría:
'POST (Recurso) (Versión protocolo) (crlf)
'(Content-Type)(
(Tipo de contenido)(,) (boundary)(=)(codigo) (crlf)
'(Content-Length)(
(Longitud de datos del cuerpo del mensaje) (crlf)
'(crlf) + el contenido del archivo con sus respectivos códigos
Ws.Connect Host, Puerto 'conectamos al host
repetir:
Do While Ws.State <> sckConnected
DoEvents
GoTo repetir
Loop
Ws.SendData CuerpoN 'mandamos archivo
End If
End Sub
Public Function AlphaMix() As String 'este es el generados del código que delimita los post
Dim CodigoA$, x&, W&
For x = 0 To 31
W = Random(0, 2)
Select Case Val(W)
Case 0
CodigoA = CodigoA & Chr$(Random(48, 57))
Case 1
CodigoA = CodigoA & Chr$(Random(65, 90))
Case 2
CodigoA = CodigoA & Chr$(Random(97, 122))
End Select
Next x
AlphaMix = CodigoA
End Function
Private Function AbrirArch(RutaArchivo$) As String 'recibimos la ruta
Dim Retorno$, Longitud# 'declaramos variables
Longitud = FileLen(RutaArchivo) 'miramos la longitud de ese archivo
Retorno = String$(Longitud, Chr(0)) 'hacemos el buffer con la longitud
On Error GoTo ErrH
Open RutaArchivo For Binary As #1 'abrimos el archivo en modo binari0
Get #1, , Retorno 'obtenemos el contenido del archivo y lo guardamos en el buffer
Close #1 'cerramos canal
AbrirArch = Retorno 'retornamos el archivo
ErrH:
If Err.Description <> "" Then 'si ocurre algún error, la función devuelve un nulo
AbrirArch = ""
Err.Clear
End If
End Function
Private Function Random(ByVal Menor As Variant, ByVal Mayor As Variant) As Single 'función para retornar un número aleatorio
Randomize
Random = (Mayor - Menor + 1) * Rnd + Menor
If Random > Mayor Then Random = Mayor
End Function
CODIGO MODIFICADO AGREGENLE un BOTON, TEXTBOX, Winsock y un ComonDialog
Const Host = "10.10.10.1" 'aqui sustitui la direccion de la pag por mi proxy
Const Puerto = 3128 'el puerto del proxy
Dim sendtext As String, first As Byte, CodigoA$
Private Sub Abrir_Click()
'Dim x 'declaramos variable
'CD.CancelError = False 'hacemos que no tire error al darle en cancelar
'CD.ShowOpen 'mostramos el diálogo para abrir el archivo
'x = MsgBox("Esta seguro de enviar el archivo?", vbYesNo + vbCritical, "
") 'damos a x el valor de lo que escogimos: "sí" , "no"
'If x = vbYes Then
' UploadRequest (CD.FileName) 'Si es sí, entonces llamamos a esta función con la ruta del archivo
'Else
' MsgBox "Lastima
"
'End If
UploadRequest
End Sub
Public Sub UploadRequest() '(Archivo$) 'Este es el sub principal, para construir la petición y mandar el archivo, recibe parámetro del archivo
Dim CodigoA$, CuerpoM$, CuerpoN$, Contenido$, LongitudR# 'Variables
If first <> 1 Then 'Para chequear si ya se envio la instruccion por 1era vez de ser asi envio entonces el texto del TXT como tal y ya
'Contenido = AbrirArch(Archivo) 'Llamamos a la función AbrirArch (para continuar mirar más abajo)
'If Contenido <> "" Then
CodigoA = AlphaMix 'generamos el código especificado más arriba
CuerpoM = "--" & CodigoA & vbCrLf & _
"Content-Disposition: form-data; name=""archivo""; filename=""log.txt""" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & Text1 & vbCrLf '& _
"--" & CodigoA & "--" 'empezamos a armar la cabecera, en estos momentos queda esta parte
'LongitudR = Len(CuerpoM) 'la longitud para el content-length
CuerpoN = "POST
http://Http://localhost/script.php HTTP/1.1" & vbCrLf & _
"Host: " & "localhost" & vbCrLf & _
"Content-Type: multipart/form-data, boundary=" & CodigoA & vbCrLf & _
"Content-Length: " & LongitudR & vbCrLf & vbCrLf & CuerpoM 'armamos la otra cabecera...
Ws.Connect Host, Puerto 'conectamos al host
repetir:
Do While Ws.State <> sckConnected
DoEvents
GoTo repetir
Loop
Ws.SendData CuerpoN 'mandamos archivo
first = 1
Timer1.Enabled = True
Else
Ws.SendData Text1
End If
'End If
End Sub
Public Function AlphaMix() As String 'este es el generados del código que delimita los post
Dim CodigoA$, x&, W&
For x = 0 To 31
W = Random(0, 2)
Select Case Val(W)
Case 0
CodigoA = CodigoA & Chr$(Random(48, 57))
Case 1
CodigoA = CodigoA & Chr$(Random(65, 90))
Case 2
CodigoA = CodigoA & Chr$(Random(97, 122))
End Select
Next x
AlphaMix = CodigoA
End Function
Private Function AbrirArch(RutaArchivo$) As String 'recibimos la ruta
Dim Retorno$, Longitud# 'declaramos variables
Longitud = FileLen(RutaArchivo) 'miramos la longitud de ese archivo
Retorno = String$(Longitud, Chr(0)) 'hacemos el buffer con la longitud
On Error GoTo ErrH
Open RutaArchivo For Binary As #1 'abrimos el archivo en modo binari0
Get #1, , Retorno 'obtenemos el contenido del archivo y lo guardamos en el buffer
Close #1 'cerramos canal
AbrirArch = Retorno 'retornamos el archivo
ErrH:
If Err.Description <> "" Then 'si ocurre algún error, la función devuelve un nulo
AbrirArch = ""
Err.Clear
End If
End Function
Private Function Random(ByVal Menor As Variant, ByVal Mayor As Variant) As Single 'función para retornar un número aleatorio
Randomize
Random = (Mayor - Menor + 1) * Rnd + Menor
If Random > Mayor Then Random = Mayor
End Function
La cosa es la siguiente...lo que quiero es simular como que envio un archivo, pero cuando modifico la cabecera
"Content-Length: " & LongitudR & vbCrLf & vbCrLf & CuerpoM
por "Content-Length: " & "1000" & vbCrLf & vbCrLf & CuerpoM
se me fastidia, pues el proxy me lo filtra y me llega la peticion incompleta, pq me puede estar pasando esto... si el lo que necesita saber es que yo lo que voy a enviar no puede excederse o mas bien TENDRA UN TAMAÑO DE de 1 MB..
Saludos y gracias
Mostrar Mensajes
