Code :
- Imports Microsoft.Win32
- Imports System.IO
- Imports System.Net
- Imports System.Web
- Imports System.Threading
- Imports System.Reflection
- Public Class UploadForm
- Private _userAgent As String = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)"
- Private _accept As String = "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*"
- Private _accept_encoding As String = "gzip, deflate"
- Private _accept_charset As String = "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
- Private _referer As String
- Private _boundary As String = "---------------------------" & DateTime.Now.Ticks.ToString("x" )
- Private _contentType As String
- Private _contentLength As Integer
- Private _querystring As New Specialized.NameValueCollection()
- Private _isBusy As Boolean
- Private _cancel As Boolean
- Const BufferSize As Integer = &H2000 '2048
- Private _waitHandle As RegisteredWaitHandle
- Public Delegate Sub UploadCompletedHandler(ByVal e As UploadCompletedArgs)
- Public Delegate Sub UploadProgressHandler(ByVal bytesRead As Integer, ByVal totalBytes As Integer)
- Public Event UploadProgress(ByVal bytesRead As Integer, ByVal totalBytes As Integer)
- Public Event UploadCompleted(ByVal e As UploadCompletedArgs)
- Private Class DatasToSend
- Public HeaderBytes() As Byte
- Public FileStream As FileStream
- Public FooterBytes() As Byte
- ReadOnly Property Length() As Integer
- Get
- Return HeaderBytes.Length + FooterBytes.Length + FileStream.Length
- End Get
- End Property
- End Class
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property Boundary() As String
- Get
- Return _boundary
- End Get
- End Property
- Public Property QueryString() As Specialized.NameValueCollection
- Get
- Return _querystring
- End Get
- Set(ByVal value As Specialized.NameValueCollection)
- _querystring = value
- End Set
- End Property
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property ContentLength() As Integer
- Get
- Return _contentLength
- End Get
- End Property
- Public Property Referer() As String
- Get
- Return _referer
- End Get
- Set(ByVal value As String)
- _referer = value
- End Set
- End Property
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property AcceptEncoding() As String
- Get
- Return _accept_encoding
- End Get
- End Property
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property Accept() As String
- Get
- Return _accept
- End Get
- End Property
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property UserAgent() As String
- Get
- Return _userAgent
- End Get
- End Property
- ''' <summary>
- ''' DEFAULT
- ''' </summary>
- ''' <value></value>
- ''' <returns></returns>
- ''' <remarks></remarks>
- Public ReadOnly Property AcceptCharset() As String
- Get
- Return _accept_charset
- End Get
- 'Set(ByVal value As String)
- ' _accept_charset = value
- 'End Set
- End Property
- Public ReadOnly Property IsBusy() As Boolean
- Get
- Return _isBusy
- End Get
- End Property
- Private ReadOnly Property WaitHandle() As RegisteredWaitHandle
- Get
- Return _waitHandle
- End Get
- End Property
- Private Sub SetCompleted()
- SyncLock Me
- _cancel = False
- _isBusy = False
- End SyncLock
- End Sub
- Private Sub CheckBusy()
- If _isBusy Then
- Throw New NotSupportedException("1 seule opération asynchrone à la fois!" )
- End If
- End Sub
- Private Sub SetBusy()
- SyncLock Me
- CheckBusy()
- _isBusy = True
- End SyncLock
- End Sub
- Private Sub SetCancel()
- SyncLock Me
- _cancel = True
- End SyncLock
- End Sub
- ''' <summary>
- ''' Annule Lopération asynchrone en cour
- ''' </summary>
- ''' <remarks></remarks>
- Public Sub CancelAsync()
- If _isBusy Then
- SetCancel()
- End If
- End Sub
- ''' <summary>
- ''' Récupère le type MIME d'un fichier
- ''' </summary>
- ''' <param name="szFileName">
- ''' Nom du fichier dont on veut le type MIME
- ''' </param>
- ''' <param name="forceDatabase">
- ''' true pour rechercher dans HKEY_CLASSES_ROOT\MIME\DataBase\Content Type (MIME -> extension),
- ''' false pour rechercher
- ''' dans HKEY_CLASSES_ROOT (extension -> MIME)
- ''' </param>
- ''' <returns>le type MIME ou null</returns>
- Public Shared Function GetMIMEType(ByVal szFileName As String, ByVal forceDatabase As Boolean) As String
- 'type MIME renvoyé
- Dim ret As String = Nothing
- 'extension du fichier avec "."
- Dim szExt As String = Path.GetExtension(szFileName)
- 'valeur d'une valeur d'une clé de registre
- Dim val As Object = Nothing
- 'si on veut lire dans HKEY_CLASSES_ROOT directement
- If Not forceDatabase Then
- 'on essaie d'ouvrir la clé
- Dim extKey As RegistryKey = Registry.ClassesRoot.OpenSubKey(szExt)
- If extKey IsNot Nothing Then
- 'il peut y avoir une valeur "Content Type" contenant le type MIME mais ce n'est pas obligatoire
- val = extKey.GetValue("Content Type" )
- extKey.Close()
- End If
- End If
- 'si on a déjà trouvé un type MIME et que l'on ne force pas la recherche dans HKEY_CLASSES_ROOT\MIME\DataBase\Content Type
- If Not forceDatabase AndAlso val IsNot Nothing Then
- Return val.ToString()
- Else
- 'ouvre HKEY_CLASSES_ROOT\MIME\DataBase\Content Type
- Dim contentTypeKey As RegistryKey = Registry.ClassesRoot.OpenSubKey("MIME\Database\Content Type" )
- 'parcourt toutes les sous clés (types MIME connus)
- For Each subkey As String In contentTypeKey.GetSubKeyNames()
- 'ouvre HKEY_CLASSES_ROOT\MIME\DataBase\Content Type\<type MIME>
- Dim contentTypeSubKey As RegistryKey = contentTypeKey.OpenSubKey(subkey)
- 'récupère l'extension associée
- Dim ext As Object = contentTypeSubKey.GetValue("Extension" )
- 'si ca correspond on a trouvé
- If ext IsNot Nothing AndAlso ext.ToString() = szExt Then
- ret = subkey
- Exit For
- End If
- contentTypeSubKey.Close()
- Next
- contentTypeKey.Close()
- End If
- Return ret
- End Function
- ''' <summary>
- ''' Ajoute les entetes et les paires noms/Valeurs au fichier
- ''' </summary>
- ''' <param name="filepath">Chemin du fichier</param>
- ''' <param name="fileFormName">Nom de champ fichier dans la webform</param>
- ''' <param name="contenttype">Content type</param>
- ''' <param name="querystring">Paires Nom/Valeur</param>
- ''' <param name="boundary">Boundary</param>
- ''' <param name="DATAS">structures des données à envoyer</param>
- ''' <remarks></remarks>
- Private Sub PrepareDatas3(ByVal filepath As String, ByVal fileFormName As String, ByVal contenttype As String, ByVal querystring As Specialized.NameValueCollection, ByVal boundary As String, ByRef DATAS As DatasToSend)
- If (fileFormName Is Nothing) OrElse (fileFormName.Length = 0) Then
- fileFormName = "file"
- End If
- If (contenttype Is Nothing) OrElse (contenttype.Length = 0) Then
- contenttype = "application/octet-stream"
- End If
- Dim Startboundary As New System.Text.StringBuilder()
- Startboundary.Append("--" )
- Startboundary.Append(boundary)
- Startboundary.Append(vbCrLf)
- Startboundary.Append("Content-Disposition: form-data; name=""" )
- Startboundary.Append(fileFormName)
- Startboundary.Append("""; filename=""" )
- Startboundary.Append(filepath)
- Startboundary.Append("""" )
- Startboundary.Append(vbCrLf)
- Startboundary.Append("Content-Type: " )
- Startboundary.Append(contenttype)
- Startboundary.Append(vbCrLf)
- Startboundary.Append(vbCrLf)
- 'ajoute les paires nom/valeurs
- Dim Endboundary As New System.Text.StringBuilder()
- If querystring IsNot Nothing Then
- Endboundary.Append(vbCrLf)
- For Each key As String In querystring.Keys
- Endboundary.Append("--" & boundary)
- Endboundary.Append(vbCrLf)
- Endboundary.Append("Content-Disposition: form-data; name=" & Chr(34) & key & Chr(34))
- Endboundary.Append(vbCrLf)
- Endboundary.Append(vbCrLf)
- Endboundary.Append(querystring.[Get](key))
- Endboundary.Append(vbCrLf)
- Next
- End If
- Endboundary.Append("--" & boundary & "--" )
- Endboundary.Append(vbCrLf)
- Dim postHeader As String = Startboundary.ToString()
- Dim postFooter As String = Endboundary.ToString
- Dim postHeaderBytes As Byte() = System.Text.Encoding.UTF8.GetBytes(postHeader)
- Dim postFooterBytes As Byte() = System.Text.Encoding.UTF8.GetBytes(postFooter)
- ''''OUVERTURE DU FICHIER'''''
- Dim fsRead As New FileStream(filepath, FileMode.Open, FileAccess.Read)
- DATAS.FileStream = fsRead
- DATAS.HeaderBytes = postHeaderBytes
- DATAS.FooterBytes = postFooterBytes
- End Sub
- Public Sub UploadFileAsync(ByVal uri As Uri, ByVal inputfile As String, ByVal cookieCol As CookieCollection, Optional ByVal userToken As Object = Nothing)
- SyncLock Me
- CheckBusy()
- Dim cbArgs() As Object = New Object() {uri, inputfile, cookieCol, userToken}
- Dim cb As New WaitCallback(AddressOf cbMethod)
- ThreadPool.QueueUserWorkItem(cb, cbArgs)
- End SyncLock
- End Sub
- Private Sub cbMethod(ByVal innerState As Object)
- Dim args() As Object = CType(innerState, Object())
- Dim datas() As Byte
- Dim url As Uri = CType(args(0), Uri)
- Dim inputfile As String = CType(args(1), String)
- Dim cookiecol As CookieCollection = CType(args(2), CookieCollection)
- Dim usertoken As Object = args(3)
- Try
- datas = UploadFile(url, inputfile, cookiecol)
- If _cancel Then
- '''CANCELLED'''
- SetCompleted()
- RaiseEvent UploadCompleted(New UploadCompletedArgs(Nothing, usertoken, Nothing, True))
- Else
- '''NORMAL'''
- SetCompleted()
- RaiseEvent UploadCompleted(New UploadCompletedArgs(datas, usertoken, Nothing, False))
- End If
- Catch ex As Exception
- '''ERROR'''
- SetCompleted()
- RaiseEvent UploadCompleted(New UploadCompletedArgs(Nothing, usertoken, ex, False))
- End Try
- End Sub
- Public Function UploadFile(ByVal url As Uri, ByVal inputfile As String, ByVal cookieCol As CookieCollection) As Byte()
- SetBusy()
- Return UploadFileCore(url, inputfile, cookieCol)
- End Function
- Private Function UploadFileCore(ByVal url As Uri, ByVal inputfile As String, ByVal cookieCol As CookieCollection) As Byte()
- _contentType = GetMIMEType(inputfile, False)
- Dim DATAS As New DatasToSend
- PrepareDatas3(inputfile, "", _contentType, _querystring, _boundary, DATAS)
- Dim w As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
- '''''HEADERZ'''''
- w.Headers.Add(HttpRequestHeader.AcceptEncoding, _accept_encoding)
- w.Headers.Add(HttpRequestHeader.AcceptLanguage, "fr" )
- w.Headers.Add(HttpRequestHeader.AcceptCharset, _accept_charset)
- w.Headers.Add(HttpRequestHeader.CacheControl, "no-cache" )
- 'w.Headers.Add(HttpRequestHeader.KeepAlive, "true" )
- w.Headers.Add(HttpRequestHeader.KeepAlive, "300" )
- w.ContentType = "multipart/form-data; boundary=" & _boundary
- w.ProtocolVersion = HttpVersion.Version11
- w.ServicePoint.Expect100Continue = False
- w.ServicePoint.ConnectionLeaseTimeout = System.Threading.Timeout.Infinite
- w.Timeout = System.Threading.Timeout.Infinite
- w.Referer = _referer
- w.UserAgent = _userAgent
- w.Accept = _accept
- '''''COOKIES'''''
- ' w.CookieContainer = New CookieContainer()
- ' w.CookieContainer.Add(cookieCol)
- w.Headers.Add(HttpRequestHeader.Cookie, "age_check=1" )
- ''''''METHODE''''''
- w.Method = "POST"
- '''''OPTIONS'''''
- ' w.AutomaticDecompression = DecompressionMethods.GZip
- w.AllowAutoRedirect = True
- ' w.SendChunked = True
- 'Set content lenght
- w.ContentLength = DATAS.Length
- _contentLength = DATAS.Length
- Dim totalDataRead As Integer
- Try
- 'Ouvre la requete
- Dim rsSender As Stream = w.GetRequestStream
- Dim dataRead(BufferSize - 1) As Byte
- Dim nbRead As Integer
- 'ENVOI DE L'HEARDER
- rsSender.Write(DATAS.HeaderBytes, 0, DATAS.HeaderBytes.Length)
- 'ENVOI DU FICHIER
- Do
- nbRead = DATAS.FileStream.Read(dataRead, 0, BufferSize)
- totalDataRead += nbRead
- rsSender.Write(dataRead, 0, nbRead)
- RaiseEvent UploadProgress(totalDataRead, _contentLength)
- Loop Until nbRead < BufferSize Or _cancel = True
- 'Close FILE, WEBREQUEST
- DATAS.FileStream.Close()
- If _cancel Then
- w.Abort()
- Exit Function
- End If
- 'ENVOI DU FOOTER
- rsSender.Write(DATAS.FooterBytes, 0, DATAS.FooterBytes.Length)
- rsSender.Close()
- ''''Get RESPONSE''''
- If Not _cancel Then
- Dim wResponse As WebResponse = w.GetResponse
- Dim rsResponce As Stream = (wResponse.GetResponseStream)
- Dim datasResp As New List(Of Byte)
- totalDataRead = 0
- nbRead = rsResponce.Read(dataRead, 0, BufferSize)
- While nbRead <> 0
- totalDataRead += nbRead
- ReDim Preserve dataRead(nbRead - 1)
- datasResp.AddRange(dataRead)
- ReDim Preserve dataRead(BufferSize - 1)
- nbRead = rsResponce.Read(dataRead, 0, BufferSize)
- End While
- 'Close RESPONSE
- rsResponce.Close()
- Dim tabResp(datasResp.Count - 1) As Byte
- datasResp.CopyTo(tabResp)
- Return tabResp
- End If
- Return Nothing
- Catch ex As Exception
- DATAS.FileStream.Close()
- Throw ex
- End Try
- End Function
- End Class
- Public Class UploadCompletedArgs
- Private _rez() As Byte
- Private _error As System.Exception
- Private _cancelled As Boolean
- Private _userstate As Object
- Sub New(ByVal rez() As Byte, ByVal userstate As Object, ByVal err As Exception, ByVal cancelled As Boolean)
- _userstate = userstate
- _error = err
- _cancelled = cancelled
- _rez = rez
- End Sub
- Public ReadOnly Property Cancelled() As Boolean
- Get
- Return _cancelled
- End Get
- End Property
- Public ReadOnly Property Result() As Byte()
- Get
- Return _rez
- End Get
- End Property
- Public ReadOnly Property Errors() As Exception
- Get
- Return _error
- End Get
- End Property
- Public ReadOnly Property UserState() As Object
- Get
- Return _userstate
- End Get
- End Property
- End Class
|