Imports System.IO
Imports System.Net
Imports System.Net.Security
Imports System
Imports System.Web
Imports System.Security.Cryptography.X509Certificates
Imports System.Text
Module utiles
Public Enum typeParam
param_string = 0
param_file = 1
End Enum
Public Structure tParam
Dim name As String
Dim value As String
Dim type As typeParam
End Structure
Public Function requestHTTP(ByVal strURL As String, ByVal params() As tParam, Optional ByVal USERNAME As String = "", _
Optional ByVal PSSWD As String = "", _
Optional ByVal Domain As String = "") As HttpWebResponse
'****************************************************************
'Genarar datos del POST en el stream tmpStream
'****************************************************************
'Generar limite
Dim limite As String = "----------" & DateTime.Now.Ticks.ToString("x")
'Generar contenido del post
Dim sb As StringBuilder = New StringBuilder()
Dim paramHeader As String
Dim paramHeaderBytes As Byte()
Dim tmpStream As Stream = New MemoryStream()
Dim buffer As Byte() = {}
Dim bytesRead As Integer = 0
Dim i As Integer
'Recorre cada parametro generando el arreglo de bytes y esribiendolos en el buffer de salida
For i = 0 To UBound(params)
sb = New StringBuilder()
If params(i).type = typeParam.param_string Then
'Si es una cadena
sb.Append("--")
sb.Append(limite)
sb.Append(vbNewLine)
sb.Append("Content-Disposition: form-data; name=""")
sb.Append(params(i).name) 'Nombre del parametro
sb.Append("""")
sb.Append(vbNewLine)
sb.Append(vbNewLine)
sb.Append(params(i).value) 'Valor del parametro
sb.Append(vbNewLine)
'Escribir la cabecera del parametro en el tmpStream
paramHeader = sb.ToString()
paramHeaderBytes = Encoding.UTF8.GetBytes(paramHeader)
tmpStream.Write(paramHeaderBytes, 0, paramHeaderBytes.Length)
Else
'Si es un archivo
sb.Append("--")
sb.Append(limite)
sb.Append(vbNewLine)
sb.Append("Content-Disposition: form-data; name=""")
sb.Append(params(i).name) 'Nombre del parametro
sb.Append("""; filename=""")
sb.Append(Path.GetFileName(params(i).value)) 'Nombre del archivo
sb.Append("""")
sb.Append(vbNewLine)
sb.Append("Content-Type: ")
sb.Append("application/octet-stream")
sb.Append(vbNewLine)
sb.Append(vbNewLine)
'Escribir la cabecera del parametro en el tmpStream
paramHeader = sb.ToString()
paramHeaderBytes = Encoding.UTF8.GetBytes(paramHeader)
tmpStream.Write(paramHeaderBytes, 0, paramHeaderBytes.Length)
Dim fileStream As FileStream = New FileStream(params(i).value, FileMode.Open, FileAccess.Read)
'Escribir el contenido del archivo
ReDim buffer(fileStream.Length - 1)
bytesRead = fileStream.Read(buffer, 0, buffer.Length)
While bytesRead <> 0
tmpStream.Write(buffer, 0, bytesRead)
bytesRead = fileStream.Read(buffer, 0, buffer.Length)
End While
End If
Next
'Crear el string de límite final como matriz de bytes
Dim limiteBytes As Byte() = Encoding.UTF8.GetBytes(vbNewLine & "--" + limite + vbNewLine)
'Escriba el límite final
tmpStream.Write(limiteBytes, 0, limiteBytes.Length)
'********************************************************************
'Enviar el request
'********************************************************************
'Cuando utiliza protocolo HTTPS necesita una función de validación de certificado
'Para este caso la función devuelve siempre true
'Si no es HTTPS no utiliza esta funcion
ServicePointManager.ServerCertificateValidationCallback = New RemoteCertificateValidationCallback(AddressOf ValidateCertificate)
'Crear el objeto HttpWebRequest con la url de la pagina destino
Dim HttpWRequest As HttpWebRequest = HttpWebRequest.Create(strURL)
'Si se le pasaron credenciales las asigna, sino utilizar las credenciales actuales
If (USERNAME <> "") Then
Dim creds As New Net.NetworkCredential(USERNAME, PSSWD, Domain)
HttpWRequest.Credentials = creds
Else
HttpWRequest.Credentials = CredentialCache.DefaultCredentials
End If
'Habilitar el buffer, no se envían los datos hasta la sentencia GetResponse()
HttpWRequest.AllowWriteStreamBuffering = True
HttpWRequest.Method = "POST"
'Asignar el contentType con el limite
HttpWRequest.ContentType = "multipart/form-data; boundary=" & limite
tmpStream.Seek(0, SeekOrigin.Begin)
'asignar el largo del stream
HttpWRequest.ContentLength = tmpStream.Length
Dim stream As Stream = HttpWRequest.GetRequestStream()
ReDim buffer(tmpStream.Length - 1)
bytesRead = tmpStream.Read(buffer, 0, buffer.Length)
While bytesRead <> 0
stream.Write(buffer, 0, bytesRead)
bytesRead = tmpStream.Read(buffer, 0, buffer.Length)
End While
Dim Response As HttpWebResponse = Nothing
Try
Response = HttpWRequest.GetResponse()
Catch ex As Exception
Debug.Print(ex.Message)
End Try
Return Response
End Function
Private Function ValidateCertificate(ByVal sender As Object, ByVal certificate As X509Certificate, ByVal chain As X509Chain, ByVal sslPolicyErrors As SslPolicyErrors) As Boolean
Dim validationResult As Boolean
validationResult = True
'
' policy code here ...
'
Return validationResult
End Function
Function readFileHTTP(ByVal strURL As String) As Byte()
Dim res() As Byte = {}
Try
Dim fr As System.Net.HttpWebRequest
Dim targetURI As New Uri(strURL)
fr = DirectCast(System.Net.HttpWebRequest.Create(targetURI), System.Net.HttpWebRequest)
If (fr.GetResponse().ContentLength > 0) Then
Dim str As New System.IO.StreamReader(fr.GetResponse().GetResponseStream())
res = System.Text.ASCIIEncoding.ASCII.GetBytes(str.ReadToEnd())
str.Close()
End If
Catch ex As System.Net.WebException
End Try
Return res
End Function
End Module