184 lines
6.3 KiB
Text
184 lines
6.3 KiB
Text
|
DeclareModule lhs_web_helper
|
||
|
|
Declare.s MapToJSONString(Map ConvertMap.s())
|
||
|
|
Declare.s Work_Header_to_JSONMap(String.s)
|
||
|
|
Declare.s mimetype(file.s)
|
||
|
|
#cha_R_ResponseType = "ResponseType" ;Element ResponseType :Mimetype
|
||
|
|
#cha_R_ResponseContentType = "ResponseContentType" ;Element ResponseContentType :#response_string , #response_Memory
|
||
|
|
#cha_R_MemoryAdress = "MemoryAdress" ;Element MemoryAdress :Converted to String
|
||
|
|
#cha_R_MemorySize = "MemorySize" ;Element MemorySize :Converted to String
|
||
|
|
#cha_R_StringBase64 = "StringBase64" ;Element StringBase64 :Base64 Encoded String
|
||
|
|
#cha_R_http_head_status = "HeaderStatus" ;200 OK 300 Error 500 Server Error usw.
|
||
|
|
#response_string = "response_string"
|
||
|
|
#response_Memory = "response_memory"
|
||
|
|
#error_string = "error"
|
||
|
|
#http_head_method = "method:"
|
||
|
|
#http_head_request = "request:"
|
||
|
|
#http_head_protocol = "protocol:"
|
||
|
|
#http_head_query = "query:"
|
||
|
|
#http_head_status = "status:"
|
||
|
|
#http_head_date = "date:"
|
||
|
|
#http_head_server = "server:"
|
||
|
|
#http_head_content_length = "content-length:"
|
||
|
|
#http_head_content_type = "content-type:"
|
||
|
|
#http_head_connection = "connection:"
|
||
|
|
#http_head_keep_alive = "keep-alive:"
|
||
|
|
#http_head_cookie = "cookie:"
|
||
|
|
#http_head_set_cookie = "set-cookie:"
|
||
|
|
#http_head_redirect = "location:"
|
||
|
|
EndDeclareModule
|
||
|
|
|
||
|
|
Module lhs_web_helper
|
||
|
|
|
||
|
|
Procedure.s MapToJSONString(Map ConvertMap.s())
|
||
|
|
Protected MyJSON
|
||
|
|
Protected.s Response
|
||
|
|
MyJSON = CreateJSON(#PB_Any)
|
||
|
|
If MyJSON
|
||
|
|
InsertJSONMap(JSONValue(MyJSON), ConvertMap())
|
||
|
|
Response = ComposeJSON(MyJSON)
|
||
|
|
FreeJSON(MyJSON)
|
||
|
|
ProcedureReturn Response
|
||
|
|
EndIf
|
||
|
|
ProcedureReturn #error_string
|
||
|
|
EndProcedure
|
||
|
|
|
||
|
|
Procedure.s mimetype(file.s)
|
||
|
|
Select LCase(file)
|
||
|
|
Case "pdf"
|
||
|
|
ProcedureReturn "application/pdf"
|
||
|
|
Case "zip"
|
||
|
|
ProcedureReturn "application/zip"
|
||
|
|
Case "gz"
|
||
|
|
ProcedureReturn "application/gzip"
|
||
|
|
Case "doc"
|
||
|
|
ProcedureReturn "application/msword"
|
||
|
|
Case "xls"
|
||
|
|
ProcedureReturn "application/vnd.ms-excel"
|
||
|
|
Case "ppt"
|
||
|
|
ProcedureReturn "application/vnd.ms-powerpoint"
|
||
|
|
Case "png"
|
||
|
|
ProcedureReturn "image/png"
|
||
|
|
Case "gif"
|
||
|
|
ProcedureReturn "image/gif"
|
||
|
|
Case "jpg"
|
||
|
|
ProcedureReturn "image/jpeg"
|
||
|
|
Case "jpeg"
|
||
|
|
ProcedureReturn "image/jpeg"
|
||
|
|
Case "txt"
|
||
|
|
ProcedureReturn "text/plain"
|
||
|
|
Case "html"
|
||
|
|
ProcedureReturn "text/html"
|
||
|
|
Case "htm"
|
||
|
|
ProcedureReturn "text/html"
|
||
|
|
Case "mss"
|
||
|
|
ProcedureReturn "text/html"
|
||
|
|
Case "php"
|
||
|
|
ProcedureReturn "text/html"
|
||
|
|
Case "css"
|
||
|
|
ProcedureReturn "text/css"
|
||
|
|
Case "js"
|
||
|
|
ProcedureReturn "text/javascript"
|
||
|
|
Default
|
||
|
|
ProcedureReturn "application/octet-stream"
|
||
|
|
EndSelect
|
||
|
|
EndProcedure
|
||
|
|
|
||
|
|
Procedure.s Work_Header_to_JSONMap(String.s)
|
||
|
|
Protected NewMap Header.s()
|
||
|
|
Define.s JSONString, Working, Working_Line
|
||
|
|
Define CountLines, Lines, JSON
|
||
|
|
If CountString(String,#CRLF$+#CRLF$)
|
||
|
|
Working = StringField(String,1,#CRLF$+#CRLF$)
|
||
|
|
Working = Working + #CRLF$
|
||
|
|
Else
|
||
|
|
ProcedureReturn #error_string
|
||
|
|
EndIf
|
||
|
|
Lines = CountString(Working,#CRLF$)
|
||
|
|
If Lines
|
||
|
|
Working_Line = StringField(Working,1,#CRLF$)
|
||
|
|
If CountString(Working_Line," ")
|
||
|
|
Header(#http_head_method) = UCase(StringField(Working_Line,1," "))
|
||
|
|
Header(#http_head_request) = StringField(Working_Line,2," ")
|
||
|
|
Header(#http_head_protocol) = UCase(StringField(Working_Line,3," "))
|
||
|
|
If CountString(Header(#http_head_request), "?")
|
||
|
|
Header(#http_head_query) = StringField(Header(#http_head_request),2,"?")
|
||
|
|
Header(#http_head_request) = StringField(Header(#http_head_request),1,"?")
|
||
|
|
Else
|
||
|
|
Header(#http_head_query) = ""
|
||
|
|
EndIf
|
||
|
|
For CountLines = 2 To Lines
|
||
|
|
Working_Line = StringField(Working,CountLines,#CRLF$)
|
||
|
|
Header(LCase(Trim(StringField(Working_Line,1,":")))+":") = Trim(Mid(Working_Line, FindString(Working_Line, ":") + 1))
|
||
|
|
Next
|
||
|
|
Else
|
||
|
|
FreeMap(Header())
|
||
|
|
ProcedureReturn #error_string
|
||
|
|
EndIf
|
||
|
|
Else
|
||
|
|
FreeMap(Header())
|
||
|
|
ProcedureReturn #error_string
|
||
|
|
EndIf
|
||
|
|
JSON = CreateJSON(#PB_Any)
|
||
|
|
|
||
|
|
If JSON
|
||
|
|
InsertJSONMap(JSONValue(JSON), Header())
|
||
|
|
JSONString = ComposeJSON(JSON)
|
||
|
|
FreeMap(Header())
|
||
|
|
FreeJSON(JSON)
|
||
|
|
ProcedureReturn JSONString.s
|
||
|
|
Else
|
||
|
|
ProcedureReturn #error_string
|
||
|
|
EndIf
|
||
|
|
|
||
|
|
EndProcedure
|
||
|
|
EndModule
|
||
|
|
|
||
|
|
Global.s ZumSenden
|
||
|
|
|
||
|
|
ProcedureCDLL post_test(handler_Map_JSON.s, ContentData.s)
|
||
|
|
Define *Text
|
||
|
|
Define.s Encoded, TBD, Text, JSONStringToMap
|
||
|
|
Define MyThreadJSON, File
|
||
|
|
NewMap Header.s()
|
||
|
|
File = CreateFile(#PB_Any, "test.log")
|
||
|
|
WriteStringN(File, "handler_Map_JSON:")
|
||
|
|
WriteStringN(File, handler_Map_JSON)
|
||
|
|
WriteStringN(File, "Content Data:")
|
||
|
|
WriteStringN(File, ContentData)
|
||
|
|
|
||
|
|
JSONStringToMap = handler_Map_JSON
|
||
|
|
If JSONStringToMap <> lhs_web_helper::#error_string
|
||
|
|
MyThreadJSON = ParseJSON(#PB_Any, JSONStringToMap)
|
||
|
|
If MyThreadJSON
|
||
|
|
ClearMap(Header())
|
||
|
|
ExtractJSONMap(JSONValue(MyThreadJSON), Header())
|
||
|
|
FreeJSON(MyThreadJSON)
|
||
|
|
EndIf
|
||
|
|
EndIf
|
||
|
|
|
||
|
|
NewMap Response.s()
|
||
|
|
TBD="<div><div><h1>FormularPost</h1></div><br/>"+#CRLF$
|
||
|
|
ResetMap(Header())
|
||
|
|
While NextMapElement(Header())
|
||
|
|
TBD = TBD+"<div>"+MapKey(Header())+" : "+Header()+" </div><br/>"+#CRLF$
|
||
|
|
Wend
|
||
|
|
ContentData = URLDecoder(ContentData, #PB_UTF8)
|
||
|
|
Text = ~"<html lang=\"de\">" +
|
||
|
|
"<head>" +
|
||
|
|
~"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\"/>" +
|
||
|
|
"<title>Alle Client Headers</title></header><body>"+TBD+"<hr/><br/><h1>ConentJSON</h1><br/>"+ContentData+"</body></html>"
|
||
|
|
*Text = AllocateMemory(StringByteLength(Text, #PB_UTF8))
|
||
|
|
PokeS(*Text, Text, -1, #PB_UTF8)
|
||
|
|
Encoded = Base64Encoder(*Text, MemorySize(*Text))
|
||
|
|
Response(lhs_web_helper::#cha_R_ResponseContentType) = lhs_web_helper::#response_string
|
||
|
|
Response(lhs_web_helper::#cha_R_StringBase64) = Encoded
|
||
|
|
Response(lhs_web_helper::#cha_R_ResponseType) = lhs_web_helper::mimetype("html")
|
||
|
|
Response(lhs_web_helper::#cha_R_http_head_status) = "200 Ok"
|
||
|
|
|
||
|
|
ZumSenden = lhs_web_helper::MapToJSONString(Response())
|
||
|
|
WriteStringN(File, "ZumSenden:")
|
||
|
|
WriteStringN(File, ZumSenden)
|
||
|
|
CloseFile(File)
|
||
|
|
ProcedureReturn @ZumSenden
|
||
|
|
|
||
|
|
EndProcedure
|