mormot支持https

Posted hnxxcxg

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了mormot支持https相关的知识,希望对你有一定的参考价值。

mormot支持https

将ssl证书导入电脑系统,以Windows 10为例:

运行 mmc

技术分享图片

 

技术分享图片

技术分享图片

技术分享图片

技术分享图片

技术分享图片

技术分享图片

技术分享图片

技术分享图片

证书导入成功后,双击证书,查看证书指纹:

技术分享图片

 

第二项工作:将证书与https绑定:
以管理员身份启动cmd,输入下列命令:
netsh http add sslcert ipport=0.0.0.0:443 certhash=3a0a8fa7cbcab141e102eaab457b1299af8f82cc appid={FDC3C336-D4AF-4EA8-BAA2-15536FDE8799}

第三项工作:修改Delphi源程序:

program HttpApiServer;

{$APPTYPE CONSOLE}

{$I Synopse.inc}

//[‘{FDC3C336-D4AF-4EA8-BAA2-15536FDE8799}‘]
//netsh http add sslcert ipport=0.0.0.0:443 certhash=3a0a8fa7cbcab141e102eaab457b1299af8f82cc appid={FDC3C336-D4AF-4EA8-BAA2-15536FDE8799}
//netsh http delete sslcert ipport=0.0.0.0:443

uses
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
  SysUtils,
  SynCommons,
  SynZip,
  SynCrtSock;

type
  TTestServer = class
  protected
    fPath: TFileName;
    fPort, fRoot: string;
    fServer: THttpApiServer;
    fHttps: Boolean;
    function Process(Ctxt: THttpServerRequest): cardinal;
    function ShowDirectory(Ctxt: THttpServerRequest;
      const FileName: TFileName; FN: RawUTF8): cardinal;
  public
    constructor Create(const Path: TFileName);
    destructor Destroy; override;
  end;

  { TTestServer }

constructor TTestServer.Create(const Path: TFileName);
begin
  fPath := IncludeTrailingPathDelimiter(Path);
  fPort := ‘443‘;
  fRoot := ‘/test‘;
  fHttps := True;
  fServer := THttpApiServer.Create(false);
  fServer.AddUrl(fRoot, fPort, fHttps, ‘+‘, true);
  fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
  fServer.OnRequest := Process;
  fServer.Clone(31); // will use a thread pool of 32 threads in total
end;

destructor TTestServer.Destroy;
begin
  fServer.RemoveUrl(fRoot, fPort, fHttps, ‘+‘);
  fServer.Free;
  inherited;
end;

{$WARN SYMBOL_PLATFORM OFF}

function TTestServer.Process(Ctxt: THttpServerRequest): cardinal;
var
  FileName: TFileName;
  FN: RawUTF8;
begin
  write(Ctxt.Method, ‘ ‘, Ctxt.URL);
  if not IdemPChar(pointer(Ctxt.URL), PAnsiChar(UpperCase(fRoot))) then begin
    WriteLn(‘ End with 404‘);
    result := 404;
    exit;
  end;
  FN := StringReplaceChars(UrlDecode(copy(Ctxt.URL, Length(fRoot) + 1, maxInt)),
    ‘/‘, ‘‘);
  if PosEx(‘..‘, FN) > 0 then begin
    WriteLn(‘ .. End with 404‘);
    result := 404; // circumvent obvious potential security leak
    exit;
  end;
  while (FN <> ‘‘) and (FN[1] = ‘‘) do
    delete(FN, 1, 1);
  while (FN <> ‘‘) and (FN[length(FN)] = ‘‘) do
    delete(FN, length(FN), 1);
  FileName := fPath + UTF8ToString(FN);
  writeLn(‘ => ‘ + FileName); //c5soft
  if DirectoryExists(FileName) then begin
    Result := ShowDirectory(ctxt, FileName, FN);
  end else begin
    // http.sys will send the specified file from kernel mode
    Ctxt.OutContent := StringToUTF8(FileName);
    Ctxt.OutContentType := HTTP_RESP_STATICFILE;
    result := 200; // THttpApiServer.Execute will return 404 if not found
  end;
end;

var
  Msg: string;

function TTestServer.ShowDirectory(Ctxt: THttpServerRequest;
  const FileName: TFileName; FN: RawUTF8): cardinal;
var
  W: TTextWriter;
  SRName, href: RawUTF8;
  i: integer;
  SR: TSearchRec;
  cRoot: string;

  procedure hrefCompute;
  begin
    SRName := StringToUTF8(SR.Name);
    href := FN + StringReplaceChars(SRName, ‘‘, ‘/‘);
  end;
begin
  if fRoot <> ‘/‘ then cRoot := fRoot + ‘/‘ else cRoot := fRoot;
  // reply directory listing as html
  W := TTextWriter.CreateOwnedStream;
  try
    W.Add(‘<html><body style="font-family: Arial">‘ +
      ‘<h3>%</h3><p><table>‘, [FN]);
    FN := StringReplaceChars(FN, ‘‘, ‘/‘);
    if FN <> ‘‘ then
      FN := FN + ‘/‘;
    if FindFirst(FileName + ‘*.*‘, faDirectory, SR) = 0 then begin
      repeat
        if (SR.Attr and faDirectory <> 0) and (SR.Name <> ‘.‘) then begin
          hrefCompute;
          if SRName = ‘..‘ then begin
            i := length(FN);
            while (i > 0) and (FN[i] = ‘/‘) do dec(i);
            while (i > 0) and (FN[i] <> ‘/‘) do dec(i);
            href := copy(FN, 1, i);
          end;
          W.Add(‘<tr><td><b><a href="‘ + cRoot + ‘%">[%]</a></b></td></tr>‘, [href,
            SRName]);
        end;
      until FindNext(SR) <> 0;
      FindClose(SR);
    end;
    if FindFirst(FileName + ‘*.*‘, faAnyFile - faDirectory - faHidden, SR) = 0 then begin
      repeat
        hrefCompute;
        if SR.Attr and faDirectory = 0 then
          W.Add(‘<tr><td><b><a href="‘ + cRoot +
            ‘%">%</a></b></td><td>%</td><td>%</td></td></tr>‘,
            [href, SRName, KB(SR.Size), DateTimeToStr(
{$IFDEF ISDELPHIXE2}SR.TimeStamp{$ELSE}FileDateToDateTime(SR.Time){$ENDIF})]);
      until FindNext(SR) <> 0;
      FindClose(SR);
    end;
    W.AddShort(‘</table></p><p><i>Powered by mORMot‘‘s <strong>‘);

    W.AddClassName(Ctxt.Server.ClassType);

    W.AddShort(‘</strong></i> - ‘ +
      ‘see <a href=https://synopse.info>https://synopse.info</a></p></body></html>‘);
    Ctxt.OutContent := W.Text;
    Ctxt.OutContentType := HTML_CONTENT_TYPE;
    result := 200;
  finally
    W.Free;
  end;

end;

begin
  with TTestServer.Create(‘D:Programsnginxwwwroot‘) do try
    Msg := ‘Server is now running on http‘;
    if fHttps then Msg := Msg + ‘s‘;
    msg := msg + ‘://localhost‘;
    if fPort <> ‘80‘ then
      Msg := Msg + ‘:‘ + fPort;
    Msg := Msg + fRoot + #13#10#13#10‘Press [Enter] to quit‘;
    WriteLn(Msg);
    readln;
  finally
    Free;
  end;
end.

 技术分享图片 

 



以上是关于mormot支持https的主要内容,如果未能解决你的问题,请参考以下文章

mormot接口封装

mormot websocket

mormot2.0新版的路线

最精简使用MORMOT

Delphi语言最好的JSON代码库 mORMot学习笔记1

转:Delphi语言最好的JSON代码库 mORMot学习笔记1