how can we post a multipart request using winhttp.
rgds
kamal
1) Create the request and add the 'Content-type: multipart/byteranges
boundary=--ETC---' header as appropriate. WinHttp will not generate the
content-type for you. (FYI, I copied that header out of a book it may be
incorrect)
2) Generate the request body which will contain the multipart segments.
WinHttp will not take the multiple parts and build a single request body for
you.
3) Send the request with WinHttpSendRequest(), writing the body with
WinHttpWriteData(). Indicate to WinHttpSendRequest the size of the request
body you've produced.
I guess the point is you have to handle the multipart processing on your
own. WinHttp will not build a multipart request for you. Since WinHttp
will want to send a content-length, you need to determine the request body
size (probably by generating the request body) before calling
WinHttpSendRequest().
--
Regards,
Frank Schwieterman
Microsoft Corporation
This posting is provided "AS IS" with no warranties, and confers no rights.
"kamal" <kam...@rediffmail.com> wrote in message
news:07b401c31c45$6f2cbd30$a101...@phx.gbl...
how can i use this in visual basic.
i tried to search msdn but found nothing but am still
searching.
i am using vb 6.0
using winhttp5.0
Dim http As New WinHttp.WinHttpRequest
Set http = New WinHttp.WinHttpRequest
'Open URL As POST request
MsgBox URL
MsgBox FormData
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
Debug.Print WinHTTPPostRequest
MsgBox WinHTTPPostRequest
rgds
kamal
rgds
kamal
>.
>
Hi kamal,
could you post a code sample please
tia
cu ogün
Function WinHTTPPostRequest(URL, FormData, Boundary)
'Dim http As New MSXML2.XMLHTTP
Dim http As New WinHttp.WinHttpRequest
'Create XMLHTTP/ServerXMLHTTP/WinHttprequest object
'You can use any of these three objects.
' Set http = New MSXML2.XMLHTTP
Set http = New WinHttp.WinHttpRequest
'Set http = CreateObject("MSXML2.XMLHTTP")
'Set http = CreateObject("MSXML2.ServerXMLHTTP")
'Open URL As POST request
MsgBox URL
MsgBox FormData
http.Open "POST", URL, False
'Set Content-Type header
http.setRequestHeader "Content-Type", "multipart/form-
data; boundary=" + Boundary
http.setRequestHeader "Content-length", Len(FormData)
'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
Debug.Print WinHTTPPostRequest
MsgBox WinHTTPPostRequest
End Function
Function WinHTTPPostRequest1(URL, FormData, Boundary) As
String
v_content_len = Len(FormData)
Dim inet As WinHttpRequest
Set inet = New WinHttpRequest
inet.Open "POST", URL, False
'inet.setRequestHeader "Host", "www.securesite.com"
inet.setRequestHeader "Content-type", "multipart/form-
data; boundary=" + Boundary
inet.setRequestHeader "Content-length", v_content_len
inet.send (FormData)
inet.waitForResponse
Debug.Print inet.getAllResponseHeaders
WinHTTPPostRequest1 = inet.responseText
Debug.Print WinHTTPPostRequest1
MsgBox WinHTTPPostRequest1
End Function
Function do_vbsUpload(ByVal file As String, ByVal URL As
String)
'We need at least two arguments (File + URL)
'If WScript.Arguments.Count < 2 Then InfoEcho
'Are some required objects missing?
If InStr(CheckRequirements, "Error") > 0 Then InfoEcho
Dim FileName, DestURL, FieldName
FileName = file
DestURL = URL
FieldName = "FileField" 'Default field name
Dim aCounter, Arg
aCounter = 1 'Argument counter
'For Each Arg In WScript.Arguments
' Select Case aCounter
' Case 1: FileName = Arg
' Case 2: DestURL = Arg
' Case 3: FieldName = Arg
' End Select
' aCounter = aCounter + 1
'Next
UploadFile DestURL, FileName, FieldName
End Function
'******************* upload - begin
'Upload file using input type=file
Sub UploadFile(DestURL, FileName, FieldName)
'Boundary of fields.
'Be sure this string is Not In the source file
Const Boundary = "---------------------------
0123456789012"
Dim FileContents, FormData
'Get source file As a binary data.
FileContents = GetFile(FileName)
'Build multipart/form-data document
FormData = BuildFormData(FileContents, Boundary,
FileName, FieldName)
'Post the data To the destination URL
'IEPostBinaryRequest DestURL, FormData, Boundary
WinHTTPPostRequest1 DestURL, FormData, Boundary
End Sub
'Build multipart/form-data document with file contents And
header info
Function BuildFormData(FileContents, Boundary, FileName,
FieldName)
Dim FormData, Pre, Po
Const ContentType = "text/plain"
'The two parts around file contents In the multipart-
form data.
Pre = "--" + Boundary + vbCrLf + mpFields(FieldName,
FileName, ContentType)
Po = vbCrLf + "--" + Boundary + "--" + vbCrLf
BuildFormData = Pre & FileContents & Po
'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
'BuildFormData = FormData
'BuildFormData = Pre & FileContents & Po
End Function
'sends multipart/form-data To the URL using IE
Function IEPostBinaryRequest(URL, FormData, Boundary)
'Create InternetExplorer
Dim IE: Set IE = CreateObject
("InternetExplorer.Application")
'You can uncoment Next line To see form results
IE.Visible = True
'Send the form data To URL As POST multipart/form-data
request
IE.Navigate URL, , , FormData, _
"Content-Type: multipart/form-data; boundary=" +
Boundary + vbCrLf
Do While IE.Busy
Wait 1, "Upload To " & URL
Loop
'Get a result of the script which has received upload
On Error Resume Next
IEPostBinaryRequest = IE.Document.body.innerHTML
MsgBox IEPostBinaryRequest
IE.Quit
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}", "filename")
Out = Replace(Out, "{file}", FileName)
mpFields = Replace(Out, "{ct}", ContentType)
End Function
Sub Wait(Seconds, Message)
On Error Resume Next
CreateObject("wscript.shell").Popup Message,
Seconds, "", 64
End Sub
'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
MsgBox CStr(GetFile)
Stream.Close
Set fsotemplate = New FileSystemObject
Set fil1 = fsotemplate.GetFile(FileName)
Set ts = fil1.OpenAsTextStream(ForReading)
GetFile = ts.ReadAll
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
'******************* upload - end
'******************* Support
'Basic script info
Sub InfoEcho()
Dim Msg
Msg = Msg + "Upload file using http And multipart/form-
data" & vbCrLf
Msg = Msg + "Copyright (C) 2001 Antonin Foller, PSTRUH
Software" & vbCrLf
Msg = Msg + "use" & vbCrLf
Msg = Msg + "[cscript|wscript] fupload.vbs file url
[fieldname]" & vbCrLf
Msg = Msg + " file ... Local file To upload" & vbCrLf
Msg = Msg + " url ... URL which can accept uploaded
data" & vbCrLf
Msg = Msg + " fieldname ... Name of the source form
field." & vbCrLf
Msg = Msg + vbCrLf + CheckRequirements
WScript.Echo Msg
WScript.Quit
End Sub
'Checks If all of required objects are installed
Function CheckRequirements()
Dim Msg
Msg = "This script requires some objects installed To
run properly." & vbCrLf
Msg = Msg & CheckOneObject("ADODB.Recordset")
Msg = Msg & CheckOneObject("ADODB.Stream")
Msg = Msg & CheckOneObject
("InternetExplorer.Application")
CheckRequirements = Msg
' MsgBox Msg
End Function
'Checks If the one object is installed.
Function CheckOneObject(oClass)
Dim Msg
On Error Resume Next
CreateObject oClass
If Err = 0 Then Msg = "OK" Else Msg = "Error:" &
Err.Description
CheckOneObject = oClass & " - " & Msg & vbCrLf
End Function
'******************* Support - end