PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Multipart Form-Data requests

https://www.purebasic.fr/english/viewtopic.php?t=77006

Page 1 of 1

Multipart Form-Data requests

Posted: Wed Mar 31, 2021 6:15 pm
by Seymour Clufley
Multipart form-data is an HTTP request type which is extremely useful for communicating with a server. Here is a small library that tidies up the fiddly task of making these requests. It should be cross-platform and doesn't have any external dependencies.

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
    Case "svg"
      ProcedureReturn "image/svg+xml"
    Case "srt"
      ProcedureReturn "application/x-subrip"
  EndSelect
  Debug "Don't know mime type for file extension:"+c13+ext
EndProcedure







Enumeration 1
  #MPFR_FieldType_File
  #MPFR_FieldType_Data
  #MPFR_FieldType_Text
  ;#MPFR_FieldType_JSON
  ;#MPFR_FieldType_XML
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
      ;InitializeStructure(@MPFRequest(q),MPFRequestStructure)
      MPFRequest(q)\active = #True
      ProcedureReturn q
    EndIf
  Next q
  
  reqs+1 : ReDim MPFRequest(reqs)
  ;InitializeStructure(@MPFRequest(reqs),MPFRequestStructure)
  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,MemorySize(*SourceBuffer))
    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)
  ;R("JSON")
  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_SendWithCustomHeaders(q.i,raw_u.s,Map custom_header.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)
    
;     f = CreateFile(#PB_Any,"P:\multipartformdata.txt")
;     WriteData(f,*Buffer,TotalBufferSize)
;     CloseFile(f)
    
    
    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)
    ForEach custom_header()
      key.s = MapKey(custom_header())
      Header(key) = custom_header()
    Next
    
    
    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_Send(q.i,raw_u.s)
  NewMap custom_header.s()
  MPFR_SendWithCustomHeaders(q,raw_u,custom_header())
EndProcedure



Procedure.b MPFR_Free(q.i)
  With MPFRequest(q)
    ForEach \field()
      If \field()\buffer<>0
        FreeMemory(\field()\buffer)
      EndIf
    Next
    ClearList(\field())
    
    ClearList(MPFRequest(q)\url_parameter())
    
    \status_code = 0
    \response_message = ""
    \error_message = ""
    
    \active = #False
  EndWith
EndProcedure

Re: Multipart Form-Data requests

Posted: Thu Apr 01, 2021 1:33 am
by Kwai chang caine
Works nice on my server :D
Thanks for sharing 8)

Re: Multipart Form-Data requests

Posted: Thu Apr 01, 2021 10:23 pm
by Seymour Clufley
I'm glad it works, Kwai. :)

Just for clarity, here is a demo of using the MPFR_AddData() function, in this case to send a PB image:

Code: Select all

XIncludeFile "MultipartFormDataRequests.pbi"

img = CreateImage(#PB_Any,400,400,32,#Blue)

UseJPEGImageEncoder()
*ImgBuffer = EncodeImage(img,#PB_ImagePlugin_JPEG)
ImageLen.i = MemorySize(*ImgBuffer)

m.i = MPFR_Create()
MPFR_AddData(m,"filedata",*ImgBuffer,ImageLen,MimeTypeForFile("1.jpg"))
MPFR_AddTextField(m,"onlinefn","my_online_file.jpg")
If MPFR_Send(m,"https://www.mywebsite.com/MPF_File_Receiver.php")
  wb.i = Val(StringField(MPFRequest(m)\response_message,2,c32))
  If wb = ImageLen
    Debug "success"
  EndIf
EndIf
MPFR_Free(m)

FreeMemory(*ImgBuffer)
Note that I've changed CreateMultipartFormRequest() to MPFR_Create().

Re: Multipart Form-Data requests

Posted: Sun Apr 04, 2021 9:43 am
by Seymour Clufley
I realised that a field sometimes has more parameters than just the "name" parameter, so I have added a function to set custom parameters: MPFR_AddFieldParameter(). This should be used before adding any other fields, since it will operate only on the most recent field.

For clarity, the MPFR_AddParameter() function has been renamed MPFR_AddURLParameter().

Two convenience functions have been added: MPFR_AddJSON() and MPFR_AddXML(). The former accepts a PB JSON object, the latter a PB XML object, and the conversion is taken care of.

I think that'll be it for this code. If anyone finds any bugs in it, please let me know.

Re: Multipart Form-Data requests

Posted: Sat Jan 07, 2023 8:22 am
by Seymour Clufley
Update: the code has been improved slightly, possibly fixing a bug.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited