mormot THttpApiServer使用例子

THttpApiServer封装了WINDOWS的HTTPS.SYS。

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs
, SynCommons, SynZip, SynCrtSock
;

type
TTestServer = class
protected
fPath: TFileName;
fServer: THttpApiServer;
function Process(Ctxt: THttpServerRequest): cardinal;
public
constructor Create(const Path: TFileName);
destructor Destroy; override;
end;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TTestServer }

constructor TTestServer.Create(const Path: TFileName);
begin
fServer := THttpApiServer.Create(false);
fServer.AddUrl('root','888',false,'+',true);
fServer.RegisterCompress(CompressDeflate); // our server will deflate html :)
fServer.OnRequest := Process;
fPath := IncludeTrailingPathDelimiter(Path);
end;

destructor TTestServer.Destroy;
begin
fServer.Free;
inherited;
end;

function TTestServer.Process(Ctxt: THttpServerRequest): cardinal;
var W: TTextWriter;
FileName: TFileName;
FN, SRName, href: RawUTF8;
i: integer;
SR: TSearchRec;

procedure hrefCompute;
begin
SRName := StringToUTF8(SR.Name);
href := FN+StringReplaceChars(SRName,'\','/');
end;

begin
writeln(Ctxt.Method,' ',Ctxt.URL);
if not IdemPChar(pointer(Ctxt.URL),'/ROOT') then begin
result := 404;
exit;
end;
FN := StringReplaceChars(UrlDecode(copy(Ctxt.URL,7,maxInt)),'/','\');
if PosEx('..',FN)>0 then begin
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);
if DirectoryExists(FileName) then begin
// 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="/root/%">[%]</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="/root/%">%</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=http://synopse.info>http://synopse.info</a></p></body></html>');
Ctxt.OutContent := W.Text;
Ctxt.OutContentType := HTML_CONTENT_TYPE;
result := 200;
finally
W.Free;
end;
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;

end.

调用:

with TTestServer.Create('d:\Documents\Smart Mobile Projects\Featured Demos\Binary Data Import\www\') do
try
write('Server is now running on http://localhost:888/root'#13#10#13#10+
'Press [Enter] to quit');
readln;
finally
Free;
end;

mormot THttpApiServer使用例子的更多相关文章

  1. mormot orm rest注意事项

    mORMot创建ORM RestFul,当CreateMissingTables的时候报错,搜了n多资料没搞定,后来胡乱建了个表测试了一通搞定了. ORM对应的每个数据表都需要一个ID字段并设置主键, ...

  2. mORMot 数据库操作

    程序中要使用数据库,首先是引用SynCommons, SynDB单元,根据不同的数据库类型,简单举几个例子: 1 使用Access数据库,引用SynCommons, SynDB,SynOleDb三个单 ...

  3. mormot支持https

    mormot支持https 将ssl证书导入电脑系统,以Windows 10为例: 运行 mmc 证书导入成功后,双击证书,查看证书指纹: 第二项工作:将证书与https绑定:以管理员身份启动cmd, ...

  4. 最精简使用MORMOT

    MORMOT是免费开源的SDK,它封装了HTTP.SYS,这是许多人使用它的原因,让人难以想像的是它居然支持DELPHI6及以上版本. 但MORMOT本身已经被封装的很庞大,它提供许多的单元,这让人不 ...

  5. SQLServer地址搜索性能优化例子

    这是一个很久以前的例子,现在在整理资料时无意发现,就拿出来再改写分享. 1.需求 1.1 基本需求: 根据输入的地址关键字,搜索出完整的地址路径,耗时要控制在几十毫秒内. 1.2 数据库地址表结构和数 ...

  6. C#+HtmlAgilityPack+XPath带你采集数据(以采集天气数据为例子)

    第一次接触HtmlAgilityPack是在5年前,一些意外,让我从技术部门临时调到销售部门,负责建立一些流程和寻找潜在客户,最后在阿里巴巴找到了很多客户信息,非常全面,刚开始是手动复制到Excel, ...

  7. REGEX例子

    作为REGEX的例子,代码9.3显示了一个给定的文件有多少行,具有给定的模式,通过命令行输入(注:有更有效率的方式来实现这个功能,如Unix下的grep命令,在这里只是给出了另一种方式).这个程序像下 ...

  8. CSharpGL(25)一个用raycast实现体渲染VolumeRender的例子

    CSharpGL(25)一个用raycast实现体渲染VolumeRender的例子 本文涉及的VolumeRendering相关的C#代码是从(https://github.com/toolchai ...

  9. 简单例子了解View的事件分发

    什么是事件分发 我们在写自定义ViewGroup或者自定义View的时候经常要处理用户的点击事件,如果我们的View在最底层,他在很多ViewGroup里面,我们如何让我们的点击事件准确传递到View ...

随机推荐

  1. Linxu IO测试软件

    fio 安装 apt-get install fio fdisk -l Device Boot Start End Blocks Id System/dev/sda1 * 2048 968390655 ...

  2. 认识zookeeper

    之前稍微看了一下Hadoop相关的技术文档,有了解到Hbase用zookeeper做分布式应用程序协调服务. 现在做的项目里,也是用zookeeper做集群和负载均衡(从类名LoadBalance看来 ...

  3. JAVA_Java中关于supper和this的理解

    2015-04-04 Created By BaoXinjian

  4. yield个人理解及简明示例

    1.写法有2种:yield return <expression>和yield breakyield用于在迭代中返回一个值,并将值带入下一次迭代中.yield break则意味着停止迭代. ...

  5. 2013年第四届蓝桥杯C/C++程序设计本科B组决赛

    1.猜灯谜(枚举) 2.连续奇数和(等差数列) 3.空白格式化(去除空格) 4.高僧斗法(阶梯nim) 5.格子刷油漆(dp) 6.农场阳光 1.猜灯谜 A 村的元宵节灯会上有一迷题:请猜谜 * 请猜 ...

  6. XE6移动开发环境搭建之IOS篇(1):准备安装材料(有图有真相)

    网上能找到的关于Delphi XE系列的移动开发环境的相关文章甚少,本文尽量以详细的图文内容.傻瓜式的表达来告诉你想要的答案. 原创作品,请尊重作者劳动成果,转载请注明出处!!! 1.选择方案 --- ...

  7. PaintCode调研

    1.   背景 PaintCode是一款面向iOS和Mac应用开发者及设计师的矢量图形可视化开发工具.它可以让设计师把设计好的psd文件直接导入该工具,然后生成用Quartz 2D 产生的object ...

  8. ORA-15028: ASM file '..' not dropped; currently being accessed --转载

    Couple of weeks ago we had a problem with one of our busiest databases. The FRA was filling quite ra ...

  9. 剑指Offer:面试题25——二叉树中和为某一值的路径(java实现)

    问题描述: 输入一棵二叉树和一个整数,打印出二叉树中结点指的和为输入整数的所有路径.从树的根结点开始往下一直到叶结点所经过的结点形成一条路径.二叉树结点的定义如下: public class Tree ...

  10. Linux下find命令

    转自:http://www.cnblogs.com/skynet/archive/2010/12/25/1916873.html 1.1.find命令的一般形式 man文档中给出的find命令的一般形 ...