MORMOT是免费开源的SDK,它封装了HTTP.SYS,这是许多人使用它的原因,让人难以想像的是它居然支持DELPHI6及以上版本。
只需要复制MORMOT的以下几个单元文件:
SynCommons.pas,SynCrtSock.pas,SynLZ.pas,SynZip.pas,SynCrtSock.pas,
Synopse.inc,SynopseCommit.inc,
trees.obj,deflate.obj。
总共才9个文件。
1 unit Unit1; 2 3 interface 4 5 uses 6 SynCommons, SynCrtSock, SynZip, Winapi.Windows, Winapi.Messages, 7 System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, 8 Vcl.Forms, Vcl.Dialogs; 9 10 type 11 TfrmMain = class(TForm) 12 procedure FormCreate(Sender: TObject); 13 procedure FormDestroy(Sender: TObject); 14 private 15 { Private declarations } 16 svr: THttpApiServer; 17 /// <summary> 18 /// 处理客户端http请求,并返回结果 19 /// </summary> 20 /// <param name="Ctxt">http 请求</param> 21 /// <returns>成功--200;失败--404</returns> 22 function Process(Ctxt: THttpServerRequest): cardinal; 23 public 24 { Public declarations } 25 end; 26 27 var 28 frmMain: TfrmMain; 29 30 implementation 31 32 {$R *.dfm} 33 34 { TForm1 } 35 36 procedure TfrmMain.FormCreate(Sender: TObject); 37 begin 38 svr := THttpApiServer.Create(True); // 创建http通信 39 svr.RegisterCompress(CompressGZip); // 压缩 40 svr.Clone(8); // 创建N个工作线程 41 svr.AddUrl('', '81', False, '+', True); // 注册http URL 42 svr.AddUrl('', '91', True, '+', True); // 注册https url 43 svr.OnRequest := Process; // 处理通信事件 44 svr.Start; // 开启HTTP通信 45 end; 46 47 procedure TfrmMain.FormDestroy(Sender: TObject); 48 begin 49 svr.Shutdown; 50 svr.Free; 51 end; 52 53 function TfrmMain.Process(Ctxt: THttpServerRequest): cardinal; 54 var 55 method: string; 56 fn: RawUTF8; 57 begin 58 Result := 404; // 失败--404; 成功--200 59 Ctxt.OutCustomHeaders := 'Access-Control-Allow-Origin:*'; // 允许跨域访问 60 Ctxt.OutContentType := 'text/plain; charset=GBK'; // 应答字符集和样式 61 method := Ctxt.method; 62 if method = 'GET' then 63 begin 64 fn := SynCommons.StringReplaceChars(UrlDecode(copy(Ctxt.URL, 2, MaxInt)), '/', ''); 65 end 66 else if method = 'POST' then 67 begin 68 69 end; 70 end; 71 72 end.