Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program project1;
- {$mode objfpc}{$H+}
- uses
- heaptrc, sysutils, HttpDefs, CustWeb, CustHTTPApp, FPHTTPServer;
- type
- { TMyHttpApplication }
- TMyHttpApplication = class(TCustomHTTPApplication)
- protected
- function InitializeWebHandler: TWebHandler; override;
- end;
- { TMyEmbeddedHttpServer }
- TMyEmbeddedHttpServer = class(TEmbeddedHttpServer)
- protected
- function CreateRequest: TFPHTTPConnectionRequest; override;
- function CreateResponse(ARequest: TFPHTTPConnectionRequest):
- TFPHTTPConnectionResponse; override;
- public
- property Active;
- end;
- { TMyHttpServerHandler }
- TMyHttpServerHandler = class(TFPHTTPServerHandler)
- protected
- function CreateServer: TEmbeddedHttpServer; override;
- public
- procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
- end;
- { TMyHttpApplication }
- function TMyHttpApplication.InitializeWebHandler: TWebHandler;
- begin
- Result := TMyHttpServerHandler.Create(Self);
- end;
- { TMyEmbeddedHttpServer }
- function TMyEmbeddedHttpServer.CreateRequest: TFPHTTPConnectionRequest;
- begin
- Result := TFPHTTPConnectionRequest.Create;
- end;
- function TMyEmbeddedHttpServer.CreateResponse(
- ARequest: TFPHTTPConnectionRequest): TFPHTTPConnectionResponse;
- begin
- Result := TFPHTTPConnectionResponse.Create(ARequest);
- end;
- { TMyHttpServerHandler }
- function TMyHttpServerHandler.CreateServer: TEmbeddedHttpServer;
- begin
- Result := TMyEmbeddedHttpServer.Create(Self);
- end;
- var
- App: TMyHttpApplication;
- procedure TMyHttpServerHandler.HandleRequest(ARequest: TRequest;
- AResponse: TResponse);
- begin
- if not App.Terminated then
- App.Terminate;
- end;
- begin
- App := TMyHttpApplication.Create(nil);
- try
- App.Port := 5445;
- App.Threaded := True;
- App.Initialize;
- App.Run;
- DeleteFile('HEAP.TRC');
- SetHeapTraceOutput('HEAP.TRC');
- finally
- App.Free;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement