lweb/server_example_function_library.pb

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