当前位置：首页 > news >正文

mormot2创建一个httpserver

news 2025/10/28 9:33:51

用mormot2搭建一个简单的服务，返回一个html网站或页面

非常的简单，性能也强，还能跨平台

代码

object Form1: TForm1Left = 0Top = 0Caption = 'Form1'ClientHeight = 441ClientWidth = 624Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -12Font.Name = 'Segoe UI'Font.Style = []OnDestroy = FormDestroyTextHeight = 15object SpeedButton1: TSpeedButtonLeft = 168Top = 64Width = 129Height = 22Caption = 'start'OnClick = SpeedButton1Clickend
end

unit Unit1;interfaceusesWinapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Vcl.Buttons, mormot.core.base, mormot.crypt.core, mormot.core.json,mormot.net.server, mormot.net.http, mormot.core.buffers, mormot.core.data,mormot.core.variants, mormot.core.text, mormot.core.os;typeTForm1 = class(TForm)SpeedButton1: TSpeedButton;procedure SpeedButton1Click(Sender: TObject);procedure FormDestroy(Sender: TObject);private{ Private declarations }FServer: THttpServer;public{ Public declarations }function OnHttpRequest(Ctxt: THttpServerRequestAbstract): Cardinal;function ReturnStaticFile(Ctxt: THttpServerRequestAbstract): Cardinal;end;varForm1: TForm1;implementation{$R *.dfm}function TForm1.ReturnStaticFile(Ctxt: THttpServerRequestAbstract): Cardinal;
varFilePath, Ext: string;ContentType: RawUtf8;
begin// 将URL路径映射到文件系统路径if Ctxt.Url = '/' thenFilePath := ExtractFilePath(ParamStr(0)) + 'html\index.html'elseFilePath := ExtractFilePath(ParamStr(0)) + 'html' + Ctxt.Url;if not FileExists(FilePath) thenbeginResult := HTTP_NOTFOUND;Ctxt.OutContent := 'File not found: ' + Ctxt.Url;Exit;end;// 根据文件扩展名设置正确的Content-TypeExt := LowerCase(ExtractFileExt(FilePath));if Ext = '.html' thenContentType := 'text/html; charset=utf-8'else if Ext = '.css' thenContentType := 'text/css'else if Ext = '.js' thenContentType := 'application/javascript'else if Ext = '.png' thenContentType := 'image/png'else if Ext = '.jpg' thenContentType := 'image/jpeg'else if Ext = '.ico' thenContentType := 'image/x-icon'elseContentType := 'application/octet-stream';Ctxt.OutContentType := ContentType;Ctxt.OutContent := StringFromFile(FilePath);Result := HTTP_SUCCESS;end;procedure TForm1.FormDestroy(Sender: TObject);
beginFServer.free;
end;function TForm1.OnHttpRequest(Ctxt: THttpServerRequestAbstract): Cardinal;
beginCtxt.OutContentType := 'application/json; charset=utf-8';if IsPost(Ctxt.Method) thenbegin
//    if Ctxt.Url = '/token' then  //获取token
//      Exit(OnTokenRequestByCache(Ctxt))
//    else if Ctxt.Url = '/refresh-token' then   //刷新token
//      Exit(OnRefreshRequestByCache(Ctxt));endelse if IsGet(Ctxt.Method) thenbeginExit(ReturnStaticFile(Ctxt));   //这里可以返回一个html网站或页面endelsebeginResult := HTTP_NOTFOUND;Ctxt.OutContent := '{"error":"not_found"}';end;
end;procedure TForm1.SpeedButton1Click(Sender: TObject);
varopts: THttpServerOptions;CertFile, KeyFile: string;APort: Integer;
beginopts := [hsoNoXPoweredHeader, hsoNoStats, hsoHeadersInterning, hsoThreadSmooting,
//    hsoLogVerbose ,hsoEnableLogging, hsoIncludeDateHeader];tryAPort := 8090;// 检查并启用TLSif FileExists(CertFile) and FileExists(KeyFile) thenInclude(opts, hsoEnableTls);// 使用正确的 THttpServer 构造函数FServer := THttpServer.Create(IntToStr(APort),      // 端口号作为字符串nil,                  // OnStart 事件（可选）nil,                  // OnStop 事件（可选）'',         // 进程名称32,                   // 线程池大小10000,                // KeepAlive 超时时间（毫秒）opts,                 // 服务器选项nil                   // 日志类（可选）);FServer.HttpQueueLength := 10000;FServer.OnRequest := OnHttpRequest;//  FServer.Start;// 设置SSL证书（如果启用TLS）if hsoEnableTls in opts thenbegin// 等待服务器启动并加载SSL证书THttpServer(FServer).WaitStarted(5, CertFile, KeyFile);endelsebegin// 启动非SSL服务器THttpServer(FServer).WaitStarted(5);end;excepton e: Exception dobeginend;end;end;end.

查看全文

http://www.dtcms.com/a/536833.html