It enables the inclusion of file, data and text fields in a request. It also handles forming the URL with additional parameters. (URL parameters should be handled at the other end as GET variables, whereas text fields should be handled as POST variables.)
MultipartFormDataRequests.pbi:
Code: Select all
Global c34.s{1} = Chr(34)
CompilerIf Defined(RandomCharacters,#PB_Procedure)=0
Macro RandomLetter()
Chr(65+Random(25))
EndMacro
Procedure.s RandomCharacters(l.i)
t.s
If l>0
For a = 1 To l
Select Random(2)
Case 0
t + Str(Random(9))
Case 1
t + RandomLetter()
Case 2
t + LCase(RandomLetter())
EndSelect
Next a
EndIf
ProcedureReturn t
EndProcedure
Procedure.s FormatURLParameter(t.s)
t = ReplaceString(t,"?","%3F")
t = ReplaceString(t,"/","%2F")
t = URLEncoder(t)
ProcedureReturn t
EndProcedure
CompilerEndIf
Procedure.s MimeType(ext.s)
ext = RemoveString(LCase(ext),".")
Select ext
Case "txt"
ProcedureReturn "text/plain"
Case "json"
ProcedureReturn "application/json"
Case "xml"
ProcedureReturn "application/xml"
Case "mp3", "ogg", "m4a"
ProcedureReturn "audio/"+ext
Case "jpg", "jpeg"
ProcedureReturn "image/jpeg"
Case "png", "gif", "webp"
ProcedureReturn "image/"+ext
Case "mp4", "webm"
ProcedureReturn "video/"+ext
EndSelect
EndProcedure
Enumeration 1
#MPFR_FieldType_File
#MPFR_FieldType_Data
#MPFR_FieldType_Text
EndEnumeration
Structure MPFR_Field_Structure
field_type.b
Map field_parameter.s()
Post.s
PostLen.i
ContentLen.i
text.s
fn.s
*buffer
DataLen.i
mime.s
EndStructure
Structure MPFR_URLParameter_Structure
name.s
value.s
EndStructure
Structure MPFRequestStructure
active.b
List url_parameter.MPFR_URLParameter_Structure()
List field.MPFR_Field_Structure()
response_message.s
status_code.i
error_message.s
EndStructure
Global Dim MPFRequest.MPFRequestStructure(1)
Procedure.i MPFR_Create()
reqs = ArraySize(MPFRequest())
For q = 1 To reqs
If Not MPFRequest(q)\active
MPFRequest(q)\active = #True
ProcedureReturn q
EndIf
Next q
reqs+1 : ReDim MPFRequest(reqs)
MPFRequest(reqs)\active = #True
ProcedureReturn reqs
EndProcedure
Procedure.b MPFR_AddData(q.i,field_name.s,*SourceBuffer,datalen.i,mime.s)
AddElement(MPFRequest(q)\field())
With MPFRequest(q)\field()
\field_type = #MPFR_FieldType_Data
\field_parameter("name") = field_name
\buffer = AllocateMemory(datalen+2)
CopyMemory(*SourceBuffer,\buffer,datalen)
\DataLen = datalen
\mime = mime
EndWith
EndProcedure
Procedure.b MPFR_AddFile(q.i,field_name.s,fn.s)
AddElement(MPFRequest(q)\field())
With MPFRequest(q)\field()
\field_type = #MPFR_FieldType_File
\field_parameter("name") = field_name
\fn = fn
;\mime = MimeTypeForFile(fn)
EndWith
EndProcedure
Procedure.b MPFR_AddTextField(q.i,field_name.s,txt.s)
AddElement(MPFRequest(q)\field())
With MPFRequest(q)\field()
\field_type = #MPFR_FieldType_Text
\field_parameter("name") = field_name
\text = txt
;R("TEXT: *"+txt+"*")
EndWith
EndProcedure
Procedure.b MPFR_AddJSON(q.i,field_name.s,js.i)
AddElement(MPFRequest(q)\field())
With MPFRequest(q)\field()
\field_type = #MPFR_FieldType_Data
\mime = MimeType("json")
\field_parameter("name") = field_name
t.s = ComposeJSON(js)
\DataLen = StringByteLength(t,#PB_UTF8)
\buffer = AllocateMemory(\DataLen+2)
PokeS(\buffer,t,-1,#PB_UTF8)
EndWith
EndProcedure
Procedure.b MPFR_AddXML(q.i,field_name.s,xm.i)
AddElement(MPFRequest(q)\field())
With MPFRequest(q)\field()
\field_type = #MPFR_FieldType_Data
\mime = MimeType("xml")
\field_parameter("name") = field_name
\DataLen = ExportXMLSize(xm)
\buffer = AllocateMemory(\DataLen+2)
ExportXML(xm,\buffer,\DataLen)
EndWith
EndProcedure
Procedure.b MPFR_AddFieldParameter(q.i,attrname.s,attrvalue.s)
MPFRequest(q)\field()\field_parameter(attrname) = attrvalue
EndProcedure
Procedure.b MPFR_AddURLParameter(q.i,param_name.s,param_value.s)
AddElement(MPFRequest(q)\url_parameter())
With MPFRequest(q)\url_parameter()
\name = param_name
\value = param_value
EndWith
EndProcedure
Procedure.b MPFR_Send(q.i,raw_u.s)
With MPFRequest(q)
Repeat
boundary.s = RandomCharacters(50)
BoundaryLen.i = StringByteLength(boundary, #PB_UTF8)
;R(boundary+c13+"LEN: "+Str(BoundaryLen))
If BoundaryLen>70 : Continue : EndIf
violation.b = #False
ForEach \field()
If \field()\field_type=#MPFR_FieldType_Text And FindString(\field()\text,boundary,0,#PB_String_NoCase)
violation = #True
Break
EndIf
Next
Until Not violation
TotalBufferSize.i = 0
ForEach \field()
\field()\Post = #CRLF$ + "--" + boundary + #CRLF$
;\field()\Post + "Content-Disposition: form-data; name="+c34+\field()\field_name+c34 + #CRLF$
;\field()\Post + "Content-Disposition: form-data; name="+c34+\field()\field_name+c34+"; filename="+c34+"give_filename.jpg"+c34+"; " + #CRLF$
cdfldarr.s = ""
ForEach \field()\field_parameter()
cdfldarr + MapKey(\field()\field_parameter())+"="+c34+\field()\field_parameter()+c34+"; "
Next
\field()\Post + "Content-Disposition: form-data; " + cdfldarr + #CRLF$
Select \field()\field_type
Case #MPFR_FieldType_File
\field()\Post + "Content-Type: "+MimeType(GetExtensionPart(\field()\fn)) + #CRLF$
\field()\ContentLen = FileSize(\field()\fn)
Case #MPFR_FieldType_Data
\field()\Post + "Content-Type: "+\field()\mime + #CRLF$
\field()\ContentLen = \field()\DataLen
Case #MPFR_FieldType_Text
\field()\Post + "Content-Type: "+MimeType("txt") + #CRLF$
\field()\ContentLen = StringByteLength(\field()\text,#PB_UTF8)
Default
MessageRequester("Error","Don't know what to do with field type "+Str(\field()\field_type))
EndSelect
\field()\Post + #CRLF$
\field()\PostLen = StringByteLength(\field()\Post, #PB_UTF8)
TotalBufferSize + \field()\PostLen + \field()\ContentLen
Next
TotalBufferSize + 2+2+BoundaryLen+2+2
;R("TOTAL SIZE FOR BUFFER: "+StrD( TotalBufferSize /1000/1000) )
*Buffer = AllocateMemory(TotalBufferSize, #PB_Memory_NoClear)
If Not *Buffer
Debug "failure to allocate memory"
ProcedureReturn #False
EndIf
*BufferPosition = *Buffer
ForEach \field()
PokeS(*BufferPosition, \field()\Post, -1, #PB_UTF8|#PB_String_NoZero)
*BufferPosition + \field()\PostLen
Select \field()\field_type
Case #MPFR_FieldType_File
fs = FileSize(\field()\fn)
f = ReadFile(#PB_Any,\field()\fn,#PB_File_SharedRead)
;R(\field()\fn+c13+"SIZE: "+Str(fs)+c13+"F: "+Str(f))
ReadData(f,*BufferPosition,\field()\ContentLen)
CloseFile(f)
Case #MPFR_FieldType_Data
CopyMemory(\field()\buffer, *BufferPosition, \field()\ContentLen)
Case #MPFR_FieldType_Text
PokeS(*BufferPosition, \field()\text, -1, #PB_UTF8|#PB_String_NoZero)
EndSelect
*BufferPosition + \field()\ContentLen
Next
PokeS(*BufferPosition, #CRLF$ + "--" + boundary + "--" + #CRLF$, -1, #PB_UTF8|#PB_String_NoZero)
*BufferPosition + (2+2+BoundaryLen+2+2)
u.s = raw_u
If ListSize(\url_parameter())
u + "?"
FirstElement(\url_parameter())
u + \url_parameter()\name+"=" + FormatURLParameter(\url_parameter()\value)
While NextElement(\url_parameter())
u + "&"+\url_parameter()\name+"=" + FormatURLParameter(\url_parameter()\value)
Wend
EndIf
NewMap Header.s()
Header("Content-Type") = "multipart/form-data; boundary=" + boundary
Header("Content-Length") = Str(TotalBufferSize)
HttpRequest.i = HTTPRequestMemory(#PB_HTTP_Post, u, *Buffer, TotalBufferSize, 0, Header())
;FreeMemory(*Buffer)
If HttpRequest
\response_message = HTTPInfo(HTTPRequest, #PB_HTTP_Response)
\status_code = Val(HTTPInfo(HTTPRequest,#PB_HTTP_StatusCode))
\error_message = HTTPInfo(HTTPRequest,#PB_HTTP_ErrorMessage)
If \status_code=200
;Debug "RT: *"+\response_message+"*"
status.b = #True
Else
Debug "ERROR: *"+\response_message+"*"
Debug "ERROR: *"+\error_message+"*"
EndIf
FinishHTTP(HttpRequest)
EndIf
FreeMemory(*Buffer)
ProcedureReturn status
EndWith
EndProcedure
Procedure.b MPFR_Free(q.i)
With MPFRequest(q)
ForEach \field()
If \field()\buffer<>0
FreeMemory(\field()\buffer)
EndIf
Next
ClearList(\field())
\active = #False
EndWith
EndProcedure