Build HTTP Request Messages using Visual FoxPro

httpmessagebuilder.prg

*Example Usage:
CLEAR
Builder = CREATEOBJECT('HttpMessageBuilder')
*Builder.UserAgent = 'BK5'
Builder.AddHeader('TestHeader', 'test123 456')
Builder.AddHeader('TestHeader', 'test123 456')
Builder.AddParameter('TestParameter', 'Thisisat  estparameter')
Builder.AddParameter('TestParameter', 'Thisisatestparam eter')
* You also get a free URLEncode function :)
Builder.URLEncode('str in g <3')
?Builder.BuildRequest('GET', 'requestb.in', '/')
********************************************************************************************
DEFINE CLASS HttpMessageBuilder AS Custom
	PROTECTED RawMessage, CarriageReturn, HttpHeaders, HttpParameters
	RawMessage = ''
	HttpVersion = '1.1'
	UserAgent = 'FoxPro/9.0'
	ContentType = 'application/x-www-form-urlencoded'
	CarriageReturn = CHR(10) + CHR(13)

	PROCEDURE Init
		this.HttpHeaders = CREATEOBJECT('Collection')
		this.HttpParameters = CREATEOBJECT('Collection')
	ENDPROC

	FUNCTION URLEncode
		LPARAMETER tcValue
		LOCAL lcResult, lcChar, lnSize, lnX

		lcResult=""

		FOR lnX=1 to len(tcValue)
			 lcChar = SUBSTR(tcValue,lnX,1)
			 DO CASE
			 CASE ATC(lcChar,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-._~") > 0
					lcResult=lcResult + lcChar
			 CASE lcChar=" "
					lcResult = lcResult + "%20"
			 OTHERWISE
					 *** Convert others to Hex equivalents
					 lcResult = lcResult + "%" + RIGHT(transform(ASC(lcChar),"@0"),2)
			 ENDCASE
		ENDFOR && lnX=1 to len(tcValue)

		RETURN lcResult
	ENDFUNC

	PROCEDURE AddHeader
		LPARAMETERS HeaderName, HeaderValue
		HttpHeader = CREATEOBJECT('Empty')
		ADDPROPERTY(HttpHeader, 'Key', HeaderName)
		ADDPROPERTY(HttpHeader, 'Value', HeaderValue)
		this.HttpHeaders.Add(HttpHeader)
	ENDPROC

	PROCEDURE AddParameter
		LPARAMETERS ParameterName, ParameterValue
		IF this.ContentType == 'application/x-www-form-urlencoded'
			HttpParameter = CREATEOBJECT('Empty')
			ADDPROPERTY(HttpParameter, 'Key', ParameterName)
			ADDPROPERTY(HttpParameter, 'Value', this.URLEncode(ParameterValue))
			this.HttpParameters.Add(HttpParameter)
		ELSE
			THROW 'Cannot add parameters for this content type.'
		ENDIF
	ENDPROC

	FUNCTION BuildRequest
		LPARAMETERS ReqMethod, Host, Route
		IF !(ReqMethod == 'GET' OR ;
			 ReqMethod == 'HEAD' OR ;
			 ReqMethod == 'POST' OR ;
			 ReqMethod == 'PUT' OR ;
			 ReqMethod == 'DELETE' OR ;
			 ReqMethod == 'CONNECT' OR ;
			 ReqMethod == 'OPTIONS' OR ;
			 ReqMethod == 'TRACE' OR ;
			 ReqMethod == 'PATCH')

			THROW "Invalid request method."
		ENDIF
		Route = ALLTRIM(Route)
		IF !SUBSTR(Route, 1, 1) == '/'
			Route = '/' + Route
		ENDIF
		this.RawMessage  = this.RawMessage  +  ReqMethod + ' ' + Route +  ' ' + 'HTTP/'+this.HttpVersion + this.CarriageReturn
		this.RawMessage  = this.RawMessage  + 'User-Agent: ' + this.UserAgent + this.CarriageReturn
		this.RawMessage  = this.RawMessage  + 'Host: '+ Host + this.CarriageReturn
		this.RawMessage  = this.RawMessage  + 'Content-Type: '+ this.ContentType + this.CarriageReturn
		FOR EACH HttpHeader IN this.HttpHeaders
			this.RawMessage  = this.RawMessage  + HttpHeader.Key +': '+ HttpHeader.Value + this.CarriageReturn
		ENDFOR
		Body = ''
		i = 0
		FOR EACH HttpParameter IN this.HttpParameters
			i = i + 1
			Body = Body + HttpParameter.Key +'='+ HttpParameter.Value + IIF(i == this.HttpParameters.Count, '', '&')
		ENDFOR
		this.RawMessage  = this.RawMessage  + 'Content-Length:'+ TRANSFORM(LEN(Body)) + this.CarriageReturn
		this.RawMessage  = this.RawMessage  + this.CarriageReturn
		this.RawMessage  = this.RawMessage  + Body
		RETURN this.RawMessage
		this.RawMessage  = ''
	ENDPROC
ENDDEFINE