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:\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.
来自://blog.csdn.net/weixin_34115824/article/details/86055732