Code : Tout sélectionner
' http://www.nowsms.com/download/sendmms.vbs.txt
Const DEST_URL = "http://www.ptp-images.com/image-uploade.html"
Const REPERTOIRE_FICHIER = "D:\"
Const NOM_FICHIER = "IMG.png"
envoieFichier()
Sub envoieFichier()
Dim FileContents
Dim FileName, FieldName
Dim FormData
Dim aCounter, Arg
Dim fso
FormData = ""
FieldName = "fichier" 'Variable name for file upload
'Define MIME Boundary
Const Boundary = "---------------------------NowSMS---VBScript---Boundary----"
Arg=REPERTOIRE_FICHIER + NOM_FICHIER
'Get source file As a binary data.
FileContents = GetFile(Arg)
'Build multipart/form-data document
FormData = AppendBinary (FormData, AddFileToFormData(FileContents, Boundary, NOM_FICHIER, FieldName))
'close the multipart MIME
FormData = AppendBinary (FormData, CloseFormData (Boundary))
'Post the data To the destination URL
Set objHTML = CreateObject("InternetExplorer.Application")
objHTML.Navigate ("about:blank")
objHTML.document.Write(WinHttpPostRequest (DEST_URL, FormData, Boundary))
objHTML.document.close()
objHTML.Visible=true
End Sub
'Combine 2 binary strings into 1
Function AppendBinary(binary1, binary2)
Dim BinaryData
'Build form data using recordset binary field
Const adLongVarBinary = 205
Dim RS: Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "b", adLongVarBinary, LenB(binary1) + LenB(binary2)
RS.Open
RS.AddNew
Dim LenData
RS("b").AppendChunk (binary1)
RS("b").AppendChunk (binary2)
RS.Update
BinaryData = RS("b")
RS.Close
AppendBinary = BinaryData
End Function
'Add a file to a multipart/form-data document
Function AddFileToFormData(FileContents, Boundary, FileName, FieldName)
Dim FormData, Pre, Po
Const ContentType = "image/png"
'The two parts around file contents In the multipart-form data.
Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, FileName, ContentType)
Po = vbCrLf
'Build form data using recordset binary field
Const adLongVarBinary = 205
Dim RS: Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "b", adLongVarBinary, Len(Pre) + LenB(FileContents) + Len(Po)
RS.Open
RS.AddNew
Dim LenData
'Convert Pre string value To a binary data
LenData = Len(Pre)
RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
Pre = RS("b").GetChunk(LenData)
RS("b") = ""
'Convert Po string value To a binary data
LenData = Len(Po)
RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
Po = RS("b").GetChunk(LenData)
RS("b") = ""
'Join Pre + FileContents + Po binary data
RS("b").AppendChunk (Pre)
RS("b").AppendChunk (FileContents)
RS("b").AppendChunk (Po)
RS.Update
FormData = RS("b")
RS.Close
AddFileToFormData = FormData
End Function
'Add a variable to multipart/form-data document
Function AddVarToFormData(Boundary, varName, varValue)
Dim FormData, Pre, Po, binValue
'The two parts around file contents In the multipart-form data.
Pre = "--" + Boundary + vbCrLf + mpFields2(varName)
Po = vbCrLf
'Build form data using recordset binary field
Const adLongVarBinary = 205
Dim RS: Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "b", adLongVarBinary, Len(Pre) + Len(varValue) + Len(Po)
RS.Open
RS.AddNew
Dim LenData
'Convert Pre string value To a binary data
LenData = Len(Pre)
RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
Pre = RS("b").GetChunk(LenData)
RS("b") = ""
'Convert varValue string value To a binary data
LenData = Len(varValue)
RS("b").AppendChunk (StringToMB(varValue) & ChrB(0))
binValue = RS("b").GetChunk(LenData)
RS("b") = ""
'Convert Po string value To a binary data
LenData = Len(Po)
RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
Po = RS("b").GetChunk(LenData)
RS("b") = ""
'Join Pre + FileContents + Po binary data
RS("b").AppendChunk (Pre)
RS("b").AppendChunk (binValue)
RS("b").AppendChunk (Po)
RS.Update
FormData = RS("b")
RS.Close
AddVarToFormData = FormData
End Function
'Close multipart/form-data document with final boundary
Function CloseFormData(Boundary)
Dim FormData, Po
Po = "--" + Boundary + "--" + vbCrLf
'Build form data using recordset binary field
Const adLongVarBinary = 205
Dim RS: Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "b", adLongVarBinary, Len(Po)
RS.Open
RS.AddNew
Dim LenData
'Convert Po string value To a binary data
LenData = Len(Po)
RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
Po = RS("b").GetChunk(LenData)
RS("b") = ""
'Join Pre + FileContents + Po binary data
RS("b").AppendChunk (Po)
RS.Update
FormData = RS("b")
RS.Close
CloseFormData = FormData
End Function
'Infrormations In form field header.
Function mpFields(FieldName, FileName, ContentType)
Dim MPTemplate 'template For multipart header
MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _
" filename=""{file}""" + vbCrLf + _
"Content-Type: {ct}" + vbCrLf + vbCrLf
Dim Out
Out = Replace(MPTemplate, "{field}", FieldName)
Out = Replace(Out, "{file}", FileName)
mpFields = Replace(Out, "{ct}", ContentType)
End Function
'Infrormations In form field header.
Function mpFields2(FieldName)
Dim MPTemplate 'template For multipart header
MPTemplate = "Content-Disposition: form-data; name=""{field}""" + vbCrLf + vbCrLf
mpFields2 = Replace(MPTemplate, "{field}", FieldName)
End Function
'Returns file contents As a binary data
Function GetFile(FileName)
Dim Stream: Set Stream = CreateObject("ADODB.Stream")
Stream.Type = 1 'Binary
Stream.Open
Stream.LoadFromFile FileName
GetFile = Stream.Read
Stream.Close
End Function
'Converts OLE string To multibyte string
Function StringToMB(S)
Dim I, B
For I = 1 To Len(S)
B = B & ChrB(Asc(Mid(S, I, 1)))
Next
StringToMB = B
End Function
'sends multipart/form-data To the URL using WinHttprequest/XMLHTTP
'FormData - binary (VT_UI1 | VT_ARRAY) multipart form data
Function WinHTTPPostRequest(URL, FormData, Boundary)
Dim http
'Create XMLHTTP/ServerXMLHTTP/WinHttprequest object
'You can use any of these three objects.
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'Set http = CreateObject("Msxml2.XMLHTTP")
'Set http = CreateObject("MSXML2.ServerXMLHTTP")
'Open URL As POST request
http.Open "POST", URL, False
'Set Content-Type header
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + Boundary
'Send the form data To URL As POST binary request
http.send FormData
'Get a result of the script which has received upload
WinHTTPPostRequest = http.responseText
End Function
Edité : le problème est en partie résolu, j'envoie la requête avec TCPSend(), en "brute", et ça marche, mais j'aurais bien aimé pouvoir faire ça simplement avec un objet tel que WinHttpRequest par exemple.
(...bon d'accord, il y a une chance sur 1 000 000 000... pour que ça arrive).