Skip to content

Instantly share code, notes, and snippets.

@krlicmuhamed
Last active December 11, 2021 12:00
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
  • Save krlicmuhamed/173ed64e14f17e936f30806b61aa67b3 to your computer and use it in GitHub Desktop.
Save krlicmuhamed/173ed64e14f17e936f30806b61aa67b3 to your computer and use it in GitHub Desktop.
Build HTTP Request Messages using Visual FoxPro
*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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment