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.
