Cache实现HTTP服务二

在之前雏形上增加支出调用M类方法。小伙子们还是可以的嘛，开个头上路子了，哈哈

主mac文件

/// d StartHttpServer^WYH.WS.Socket.StartHttpServer
/// 开启HTTP服务
StartHttpServer
	//换行符
	s rowsp=$c(13,10)
	s Port=$g(Port)
	s Port=50008
	zw Port
	s IP=$p($zu(54,13,$zu(54,0)),",")
	s Device="|TCP|1"
	s msg="发布在:"_IP_":"_Port_"上,用浏览器访问该地址"
	//启动tcp
	o Device:(:Port:/IOTABLE="UTF8"):200
	//测试是否成功
	i $TEST=0 
	{
     
      THROW ##class(%Exception.SystemException).%New("异常","D",,"作为服务端在端口:"_Port_"启动TCP连接失败，请检查端口")
      QUIT 
    }
    else 
    {
      
      zw msg 
    }
    //启动主侦听
    d ListenMian
    c Device
    q ""
    
///主侦听函数，有线程处理客户端请求
ListenMian  
     u Device READ x   
     u 0
     u Device 
     //用子线程处理客户端请求
     j DealClient:(:17::) 
     //GOTO做成循环 
     GOTO ListenMian
   
///处理客户端请求  
DealClient 
    s Device=##class(%SYSTEM.INetInfo).TCPName()
    //客户端输入的数据
    s input=$PRINCIPAL
    s output=$IO
    s record=""
    u Device:(::/IOTABLE="UTF8")  
    //读取数据
    s dataLen=0
    s isb=0
    s timeout=10
    f  r *x:timeout q:$c(x)=""  d
    .s record=record_$c(x)
    .s dataLen=dataLen+1
    .i $c(x)=$c(10),$e(record,dataLen-3,dataLen)=$c(13,10,13,10) s timeout=0 break
    s rows=$l(record,rowsp)
	s QType=""
	s QPath=""
	s HttpVertion=""
	//解析请求头
	f ri=1:1:rows d
	.s oneRow=$p(record,rowsp,ri)
	.i ri=1 d
	..s QType=$p(oneRow," ",1)
	..s QPath=$p(oneRow," ",2)
	..s HttpVertion=$p(oneRow," ",2)
	//返回默认页面
	s DyParamList=##Class(%DynamicObject).%New()
	i QType="GET",((QPath="/")||(QPath="")) d
	.s retHtml=$$GetDemoHtml()
	.s retHead=$$GetRetHtmlHead($l(retHtml))
	.w retHead,*-3
	.w retHtml,*-3
	e  i QType="GET" d
	.s ClassName=$replace($tr($p(QPath,"?",1),"/"),".cls","")
	.s QryParam=$p(QPath,"?",2)
	.s Method=""
	.i '$l(ClassName)!'$l(QryParam) Throw ##Class(%Exception.SystemException).%New("异常","D",,"请求资源路径错误！请求要求示例：127.0.0.1:80/ClassName.cls?ClassMethod=Method&Param1=Value1&Param2=Value2...") quit
	.i QryParam["ClassMethod" d
	..f index=1:1:$l(QryParam,"&") d
	...s param=$p(QryParam,"&",index)
	...i param["ClassMethod" d
	....s Method=$tr($p(param,"=",2)," ")
	...e  d
	....d DyParamList.%DispatchSetProperty($p(param,"=",1),$$Decode($p(param,"=",2)))
	.e  THROW ##Class(%Exception.SystemException).%New("异常","D",,"请求查询参数异常，需要包含ClassMethod参数！") quit
    .i '$l(Method) THROW ##Class(%Exception.SystemException).%New("异常","D",,"请求查询参数异常，需要包含ClassMethod参数！") quit
    .d DealQryParam
    q

        
        
 /// 得到返回信息头
GetRetHtmlHead(ContentLength)
	s head="HTTP/1.0 200 OK"_$c(13,10)
	//s head=head_"Content-Length:"_ContentLength_$c(13,10)
	s head=head_"Server:zlzhttpd/0.0.1"_$c(13,10)
	s head=head_"Content-Type:text/html"_$c(13,10)
	s head=head_""_$c(13,10)
	q head

/// 得到默认的页面 
GetDemoHtml()
	s retHtml=""
	s retHtml=retHtml_""
	s retHtml=retHtml_""
	s retHtml=retHtml_"
Welcome to zlz's webserver.this is make by cache tcp
"
	s retHtml=retHtml_""
	s retHtml=retHtml_""
	q retHtml

///处理查询参数
DealQryParam
	s ClassName=$$DealNotSeeChar(ClassName)
	s Method=$$DealNotSeeChar(Method)
	s retJson=""
	i $l(ClassName),$l(Method) d
	.s ret=$CLASSMETHOD(ClassName,Method,DyParamList)
	.i ret["-1^" s retJson="{""IsOk"":false,""Message"":"""_ret_"""}"
	.e  s retJson="{""IsOk"":true,""Message"":"""_ret_"""}"
	e  d
	.s retJson="{""IsOk"":false,""Message"":""请求资源URL异常！""}"
	
	s retHead=$$GetRetHtmlHeadTest($$GetContentLength(retJson))
	w retHead, *-3
	w retJson, *-3
	q

///处理不可见字符
DealNotSeeChar(str)
	s str=$g(str)
    s str=$tr(str,$c(127))
    f z=0:1:31 s str=$tr(str,$c(z))
    q str

/// 得到返回信息头
GetRetHtmlHeadTest(ContentLength)
	s head="HTTP/1.0 200 OK"_$c(13,10)
	s head=head_"Content-Length:"_ContentLength_$c(13,10)
	s head=head_"Server:zlzhttpd/0.0.1"_$c(13,10)
	s head=head_"Content-Type:application/json;charset=UTF-8"_$c(13,10)
	s head=head_""_$c(13,10)
	q head


/// 得到内容长度
/// d GetContentLength^WYH.WS.Socket.StartHttpServer("{""IsOk"":true,""Message"":""张三正在写代码""}")
GetContentLength(str)
	s str=$g(str)
	i '$l(str) q 0
	s retNum=0
	f ci=1:1:$l(str) d
	.s onec=$e(str,ci,ci)
	.s num=1
    .i $ASCII(onec)>127 d
    ..s num = 3
	.s retNum=retNum+num
	q retNum
    
///解密url 
Decode(str)
  SET urli = $ZCONVERT(str,"I","URL")
  SET utfi = $ZCONVERT(urli,"I","UTF8")
  q utfi
	

测试cls

/// http客户端请求处理示例类
Class WYH.WS.Socket.DealClientRequestDemo Extends %RegisteredObject
{
     

/// 请求处理方法
ClassMethod DealClient(Param As %DynamicObject) As %String
{
     
	
	s Param=$g(Param)
	s Name=Param.Name
	s Doing=Param.Doing
	q Name_"正在"_Doing
}

}

请求url
http://172.16.0.104:50008/WYH.WS.Socket.DealClientRequestDemo?ClassMethod=DealClient&Name=张三&Doing=写代码和看电视玩游戏

测试效果