TDiocpHttpServer

标签：begin end res req var TDiocpHttpServer Ctxt

TDiocpHttpServer

DIOCP只支持windows。

unit sock.DiocpHttpServer;
/// <author>cxg 2023-2-12</author>

interface

uses classes,
  system.JSON, json.help, keyValue.serialize, api.router,
  IniFiles, global, diocp_ex_httpServer, SysUtils;

var
  BinApis: TJSONObject;    //二进制API
  RestApis: TJSONObject;   //REST API，包括json,protobuf

const  //content-type
  cBin = 'application/octet-stream; charset=utf-8';
  cJson = 'application/json; charset=utf-8';
  cProtobuf = 'application/protobuf; charset=utf-8';

type
  TiocpHttpServer = class
  private
    FServer: TDiocpHttpServer;
    procedure OnHttpSvrRequest(pvRequest: TDiocpHttpRequest);
  public
    constructor Create; overload;
    destructor Destroy; override;
  end;

implementation

function ReadJsonFile(const FileName: string): string;
begin
  var f: TStringList := TStringList.Create;
  f.LoadFromFile(FileName, TEncoding.UTF8);
  Result := f.Text;
  f.Free;
end;

procedure setHeader(const Ctxt: TDiocpHttpRequest; const ContentType: string);
begin
  Ctxt.Response.ContentType := ContentType;
  Ctxt.Response.Header.ForceByName('Access-Control-Allow-Origin').AsString := '*';
  Ctxt.Response.Header.ForceByName('Access-Control-Allow-Methods').AsString := '*';
  Ctxt.Response.Header.ForceByName('Access-Control-Allow-Headers').AsString := '*';
end;

procedure router(const Ctxt: TDiocpHttpRequest);   //diocp router
begin
  if Pos('/bin', Ctxt.RequestURL) > 0 then      //二进制 API
  begin
    setHeader(Ctxt, cBin);
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    if Ctxt.ContentBody.Length > 0 then
      req.unMarshal(Ctxt.ContentBody.ToBytes);
    var url: string := Ctxt.RequestURL;
    var arr: TArray<string> := url.Split(['/']);
    var funcName: string := arr[2];
    var ja: TJSONArray := BinApis.A['bin'];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['funcname'] = funcName then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    var bs: TBytes := res.marshal2;
    Ctxt.Response.WriteBuf(PByte(bs), Length(bs));
    Ctxt.SendResponse();
    req.Free;
    res.Free;
  end
  else if Pos('/rest', Ctxt.RequestURL) > 0 then    //JSON API
  begin
    setHeader(Ctxt, cJson);
    var url: string := Ctxt.RequestURL;
    var arr: TArray<string> := url.Split(['/']);
    var resource: string := arr[2];
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    req.asStr['url'] := url;
    if Ctxt.ContentBody.Length > 0 then
      req.asStr['body'] := Ctxt.ContentBody.ToString;
    req.asStr['type'] := 'json';
    var ja: TJSONArray := RestApis.A[resource];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['method'] = Ctxt.RequestMethod then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.Response.WriteString(UTF8Encode(res.asStr['res']));
    Ctxt.SendResponse();
    req.Free;
    res.Free;
  end
  else if Pos('/protobuf', Ctxt.RequestURL) > 0 then   //PROTOBUF API
  begin
    setHeader(Ctxt, cProtobuf);
    var url: string := Ctxt.RequestURL;
    var arr: TArray<string> := url.Split(['/']);
    var resource: string := arr[2];
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    req.asStr['url'] := url;
    if Ctxt.ContentBody.Length > 0 then
      req.asBytes['body'] := Ctxt.ContentBody.ToBytes;
    req.asStr['type'] := 'protobuf';
    var ja: TJSONArray := RestApis.A[resource];
    for var i: Integer := 0 to ja.Count - 1 do
    begin
      var o: TJSONObject := ja.Items[i] as TJSONObject;
      if o.S['method'] = Ctxt.RequestMethod then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    var bs: TBytes := res.asBytes['res'];
    Ctxt.Response.WriteBuf(PByte(bs), Length(bs));
    Ctxt.SendResponse();
    req.Free;
    res.Free;
  end;
end;

constructor TiocpHttpServer.Create;
var
  ini: tinifile;
begin
  FServer := TDiocpHttpServer.Create(nil);
  FServer.UseObjectPool := True;
  FServer.SetMaxSendingQueueSize(100000);
  FServer.OnDiocpHttpRequest := OnHttpSvrRequest;
  ini := TIniFile.Create(SvrCfg);
  var threadnum: Integer := ini.readinteger('config', 'threadnum', 32);
  if threadnum > 256 then
    threadnum := 256;
  FServer.WorkerCount := threadnum;
  FServer.Port := ini.ReadInteger('config', 'httpport', 1234);
  ini.free;
  fserver.Active := True;
  {$IFDEF console}
  Writeln('New IOCP http server');
  Writeln('Thread num: ', FServer.WorkerCount);
  Writeln('Http port: ', FServer.Port);
  {$ENDIF}
end;

destructor TiocpHttpServer.Destroy;
begin
  FServer.DisConnectAll();
  FServer.SafeStop;
  FServer.Free;
  inherited;
end;

procedure TiocpHttpServer.OnHttpSvrRequest(pvRequest: TDiocpHttpRequest);
begin
  router(pvRequest);
end;

initialization
  binapis := TJSONObject.Create;
  restapis := TJSONObject.Create;
  binapis.Parse(ReadJsonFile(ExtractFilePath(ParamStr(0)) + 'binrouter.json'));
  restapis.Parse(ReadJsonFile(ExtractFilePath(ParamStr(0)) + 'restrouter.json'));

finalization
  FreeAndNil(binapis);
  FreeAndNil(restapis);

end.

　　

标签：begin,end,res,req,var,TDiocpHttpServer,Ctxt
From： https://www.cnblogs.com/hnxxcxg/p/17483268.html