mormot1.18 THttpApiServer

官方已经推荐使用mormot2，mormot1.18已经进入只修正bug的阶段。

THttpApiServer是对windows http.sys通信的封装，因此只适用于windows。

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

//cxg 2023-2-12
//mormot1.18 http.sys 适用于WINDOWS2003,XP SP2及以后版本
 
unit sock.httpsys;
 
interface
 
uses
  System.JSON, Json.help, keyValue.serialize, api.router,
  inifiles, SynCrtSock, Classes, 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
  THttpsys = class
  private
    fServer: THttpApiServer;
    function Process(Ctxt: THttpServerRequest): Cardinal;
  public
    constructor Create;
    destructor Destroy; override;
  end;
 
implementation
 
function strof(const aBytes: TBytes): RawByteString; overload;
begin
  SetLength(Result, Length(aBytes));
  Move(aBytes[0], Result[1], Length(aBytes));
end;
 
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: THttpServerRequest; const ContentType: string);
begin
  Ctxt.OutContentType := ContentType;
  Ctxt.OutCustomHeaders := 'Access-Control-Allow-Origin:*' + #13#10 + 'Access-Control-Allow-Methods:*' + #13#10 + 'Access-Control-Allow-Headers:*';
end;
 
procedure router(const Ctxt: THttpServerRequest);
begin
  if Pos('/bin', Ctxt.URL) > 0 then      //二进制 API
  begin
    setHeader(Ctxt, cBin);
    var req: TSerialize := tserialize.Create;
    var res: TSerialize := tserialize.Create;
    if Ctxt.InContent > '' then
      req.unMarshal(Ctxt.InContent);
    var url: string := Ctxt.URL;
    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.OutContent := res.marshal3;
    req.Free;
    res.Free;
  end
  else if Pos('/rest', Ctxt.URL) > 0 then    //JSON API
  begin
    setHeader(Ctxt, cJson);
    var url: string := Ctxt.URL;
    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.InContent > '' then
      req.asStr['body'] := Ctxt.InContent;
    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.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.OutContent := UTF8Encode(res.asStr['res']);
    req.Free;
    res.Free;
  end
  else if Pos('/protobuf', Ctxt.URL) > 0 then   //PROTOBUF API
  begin
    setHeader(Ctxt, cProtobuf);
    var url: string := Ctxt.URL;
    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.InContent > '' then
      req.asBytes['body'] := BytesOf(Ctxt.InContent);
    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.Method then
      begin
        RouterAPI(o.S['classname'], o.S['funcname'], [req, res]);
        Break;
      end;
    end;
    Ctxt.OutContent := strof(res.asBytes['res']);
    req.Free;
    res.Free;
  end;
end;
 
{ THttpsys }
 
function THttpsys.Process(Ctxt: THttpServerRequest): Cardinal;
begin
  router(Ctxt);
  Result := 200;
end;
 
constructor THttpsys.Create;
var
  ini: tinifile;
  httpport: string;
  threadnum: integer;
  ssl: Boolean;
begin
  ini := tinifile.create(extractfilepath(paramstr(0)) + 'server.conf');
  httpport := ini.readstring('config', 'httpport', '1122');
  threadnum := ini.readinteger('config', 'threadnum', 32);
  if threadnum > 256 then
    threadnum := 256;
  ssl := ini.ReadBool('config', 'ssl', False);
  fServer := THttpApiServer.Create(False);
  if not ssl then
    fServer.AddUrl('', httpport, False, '+', True)
  else
    fServer.AddUrl('', httpport, True, '+', True);
  fServer.OnRequest := Process;
  fServer.Clone(threadnum);
  ini.free;
  {$IFDEF console}
  Writeln('New http.sys server');
  Writeln('Http port: ', httpport);
  Writeln('Thread num: ', threadnum);
  {$ENDIF}
end;
 
destructor THttpsys.Destroy;
begin
  inherited Destroy;
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.