码迷,mamicode.com
首页 > Web开发 > 详细

mormot支持https

时间:2018-12-21 12:52:36      阅读:599      评论:0      收藏:0      [点我收藏+]

标签:cti   分享   pat   ati   request   ppi   rom   send   attr   

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:\Programs\Nginx\wwwroot\‘) 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

标签:cti   分享   pat   ati   request   ppi   rom   send   attr   

原文地址:https://www.cnblogs.com/hnxxcxg/p/10153641.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!