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.