TRtcHttpServer

标签：begin end TRtcHttpServer res req var Ctxt

TRtcHttpServer

rtc支持delphi和lazarus。

unit sock.rtc;
//cxg 2023-2-12

interface

uses  system.JSON, Json.help, keyValue.serialize, api.router, rtcInfo,
  global, System.IniFiles, Classes, SysUtils, rtcDataSrv, rtcHttpSrv, rtcConn;

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
  TrtcServer = class
  private
    HttpServer: TRtcHttpServer;
    Provider: TRtcDataProvider;
    procedure dataRecv(Sender: TRtcConnection);
    procedure CheckRequest(Sender: TRtcConnection);
  public
    constructor Create;
    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: TRtcConnection; const ContentType: string);
begin
  Ctxt.Response['Access-Control-Allow-Origin'] := '*';
  Ctxt.Response['Access-Control-Allow-Methods'] := '*';
  Ctxt.Response['Access-Control-Allow-Headers'] := '*';
  Ctxt.Response['Content-Type'] := ContentType;
end;

procedure router(const Ctxt: TRtcConnection); overload; //rtc router
begin
  if Pos('/bin', Ctxt.Request.FileName) > 0 then      //二进制 API
  begin
    setHeader(Ctxt, cBin);
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    var body: TBytes := tbytes(Ctxt.ReadEx);
    if Ctxt.ReadCount > 0 then
      req.unMarshal(body);
    var url: string := Ctxt.Request.FileName;
    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;
    Ctxt.WriteEx(RtcByteArray(res.marshal3));
    req.Free;
    res.Free;
  end
  else if Pos('/rest', Ctxt.Request.FileName) > 0 then    //JSON API
  begin
    setHeader(Ctxt, cJson);
    var url: string := Ctxt.Request.FileName;
    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.ReadCount > 0 then
      req.asStr['body'] := Ctxt.Read;
    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.Request.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.WriteEx(RtcByteArray(TEncoding.UTF8.GetBytes(res.asStr['res'])));
    req.Free;
    res.Free;
  end
  else if Pos('/protobuf', Ctxt.Request.FileName) > 0 then   //PROTOBUF API
  begin
    setHeader(Ctxt, cProtobuf);
    var url: string := Ctxt.Request.FileName;
    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;
    var body: TBytes := tbytes(Ctxt.ReadEx);
    if Ctxt.ReadCount > 0 then
      req.asBytes['body'] := body;
    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.Request.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.WriteEx(RtcByteArray(res.asBytes['res']));
    req.Free;
    res.Free;
  end;
end;

{ TrtcServer }

procedure TrtcServer.CheckRequest(Sender: TRtcConnection);
begin
  Sender.Accept;
end;

constructor TrtcServer.Create;
var
  ini: tinifile;
  httpport: string;
begin
  HttpServer := TRtcHttpServer.Create(nil);
  HttpServer.MultiThreaded := True;    //thread pool
  ini := tinifile.create(extractfilepath(paramstr(0)) + 'server.conf');
  httpport := ini.readstring('config', 'httpport', '1122');
  HttpServer.ServerPort := httpport;
  ini.Free;
  HttpServer.Listen;
  Provider := TRtcDataProvider.Create(nil);
  Provider.Server := HttpServer;
  Provider.OnDataReceived := dataRecv;
  Provider.OnCheckRequest := CheckRequest;
  {$IFDEF console}
  Writeln('New rtc server');
  Writeln('Http port: ', httpport);
  {$ENDIF}
end;

procedure TrtcServer.dataRecv(Sender: TRtcConnection);
begin
  router(Sender);
end;

destructor TrtcServer.Destroy;
begin
  HttpServer.StopListen;
  FreeAndNil(HttpServer);
  FreeAndNil(Provider);
  inherited;
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,TRtcHttpServer,res,req,var,Ctxt
From： https://www.cnblogs.com/hnxxcxg/p/17483295.html