mormot支持https

最新推荐文章于 2024-10-11 07:55:03 发布

利客阿平

最新推荐文章于 2024-10-11 07:55:03 发布

阅读量1.5k

点赞数

分类专栏： DataSnap三层开发

本文链接：https://blog.csdn.net/itkeyuan/article/details/103247701

版权

DataSnap三层开发专栏收录该内容

25 篇文章

订阅专栏

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源程序：

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

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;

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;

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.

以后是微软官网上的解析:

将 SSL 证书绑定至端口号

Certhash参数指定证书的指纹。
Ipport参数指定 IP 地址和端口，以及与所述的 httpcfg.exe 工具的 -i开关相同的功能。
Appid参数是可用于标识所属应用程序的 GUID。