TFPHttpServer

TFPHttpServer

TFPHttpServer是lazarus自带的http服务端控件。laZARUS可以用它来开发中间件。

uses  fphttpserver

procedure TfpHttpSVR.request(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
  var AResponse: TFPHTTPConnectionResponse);
// /rest/units/qry/{accountno}/{key}
var
  arr: tstringarray;
begin
  AResponse.CustomHeaders.Add('Access-Control-Allow-Origin:*');  //cross domain
  arr := ARequest.URL.Split(['/']);
  if arr[1] = 'rest' then
     AResponse.ContentType := 'application/json; charset=UTF-8'    //ContentType
  else if arr[1] = 'pb' then
    AResponse.ContentType := 'application/octet-stream; charset=UTF-8'; //ContentType
  handlefunc(ARequest, AResponse, '/rest/tables/qry', @rest.test2.tablesQry);
  handlefunc(ARequest, AResponse, '/rest/goods/qry', @rest.test2.goodsQry);
  handlefunc(ARequest, AResponse, '/rest/units/edit', @rest.test2.unitsEdit);
  handlefunc(ARequest, AResponse, '/rest/units/add', @rest.test2.unitsAdd);
  handlefunc(ARequest, AResponse, '/rest/units/delete', @rest.test2.unitsDel);
  handlefunc(ARequest, AResponse, '/pb/tables/qry', @pb.test.tablesQry);
  handlefunc(ARequest, AResponse, '/pb/units/add', @pb.test.unitsAdd);
  handlefunc(ARequest, AResponse, '/pb/units/edit', @pb.test.unitsEdit);
  handlefunc(ARequest, AResponse, '/pb/units/delete', @pb.test.unitsDel);
end;                                                   

procedure TWebModul.DoHandleRequest(Sender: TObject;  var ARequest: TFPHTTPConnectionRequest;  var AResponse: TFPHTTPConnectionResponse);
var
  file1: TMemoryStream;
begin
  file1 := TMemoryStream.Create;
  {...}
  if {ARequest.ContentFields.Values=} true
    then
      begin
        fromspreadsheet(file1);  //from the spreadsheet unit
 
        AResponse.FreeContentStream:= true;
        AResponse.ContentStream :=file1;
        AResponse.ContentType:=htmlcontenttype('.html');  //:='text/html;charset=utf-8'
        AResponse.Code:=200;
        AResponse.SendContent;
      end;
  {...}
  file1.Free;
 
end;