网站导航
> 文章列表 > Delphi Web Server 流程分析

Delphi Web Server 流程分析

网友: 文章列表 2024-03-22 01:21:33

Delphi Web Server 流程分析

通过向导 "Web Server Application" (选择 "Stand-alone GUI Application") 创建一个 WebServer Demo。

主单元代码:

......

  private
    FServer: TIdHTTPWebBrokerBridge;
    procedure StartServer;

.............

Delphi的网络组件是基于INDY的，这里的FServer是TIdHTTPWebBrokerBridge,就是WebServer了。是什么呢？

直接"Ctrl+Click"浏览代码，直接报错：

哎........

手动打开单元 "IdHTTPWebBrokerBridge.pas"(路径："D:\\Program Files (x86)\\Embarcadero\\Studio\\22.0\\source\\Indy10\\Protocols"):

TIdHTTPWebBrokerBridge = class(TIdCustomHTTPServer),

先看看继承：

TIdHTTPWebBrokerBridge->TIdCustomHTTPServer->TIdCustomTCPServer->TIdComponent...

是从TCPServer来的。

再看主单元的StartServer方法，是如何启动Server的：

procedure TForm1.StartServer;
begin
  if not FServer.Active then
  begin
    FServer.Bindings.Clear;
    FServer.DefaultPort := StrToInt(EditPort.Text);
    FServer.Active := True;
  end;
end;

设置Active=True启动，(这里可以"Ctrl+Click" "Active"属性)，直接到"IdCustomTCPServer.pas"的 " TIdCustomTCPServer"类，看代码：

SetActive -> Startup():


procedure TIdCustomTCPServer.Startup;
varLScheduler: TIdScheduler;LIOHandler: TIdServerIOHandler;{$IFDEF CanCreateTwoBindings}LBinding: TIdSocketHandle;{$ENDIF}
begin// Set up bindingsif Bindings.Count = 0 then begin// Binding object that supports both IPv4 and IPv6 on the same socket...{$IFDEF CanCreateTwoBindings}LBinding := {$ENDIF}Bindings.Add; // IPv4 or IPv6 by default{$IFDEF CanCreateTwoBindings}case LBinding.IPVersion ofId_IPv4: beginif GStack.SupportsIPv6 then beginBindings.Add.IPVersion := Id_IPv6;end;end;Id_IPv6: beginif GStack.SupportsIPv4 then beginBindings.Add.IPVersion := Id_IPv4;end;end;end;{$ENDIF}end;// Setup IOHandlerLIOHandler := FIOHandler;if not Assigned(LIOHandler) then beginLIOHandler := TIdServerIOHandlerStack.Create(Self);SetIOHandler(LIOHandler);FImplicitIOHandler := True;end;LIOHandler.Init;// Set up schedulerLScheduler := FScheduler;if not Assigned(FScheduler) then beginLScheduler := TIdSchedulerOfThreadDefault.Create(Self);SetScheduler(LScheduler);FImplicitScheduler := True;// Useful in debugging and for thread namesLScheduler.Name := Name + 'Scheduler';   {do not localize}end;LScheduler.Init;StartListening;
end;

这里添加了ip6支持，然后设置IO句柄(用于https,加密，压缩等)，然后是设置Scheduler(用于设置线程或纤程)。然后开始监听端口StartListening()，StartListening()主要是检查监听线程数量和创建监听线程，默认监听线程数量=15：

const
  IdListenQueueDefault = 15;

procedure TIdCustomTCPServer.InitComponent;

..........

FListenQueue := IdListenQueueDefault;

..................

这个数量太小了，现在的一般台式机都可以轻松支持200以上，所以建议开始时设置，

procedure TForm1.FormCreate(Sender: TObject);
begin
  FServer := TIdHTTPWebBrokerBridge.Create(Self);
  FServer.ListenQueue := 200;
end;

StartListening():

procedure TIdCustomTCPServer.StartListening;
varLListenerThreads: TIdListenerList;LListenerThread: TIdListenerThread;I: Integer;LBinding: TIdSocketHandle;LName: string;
beginLListenerThreads := FListenerThreads.LockList;try// Set up any sockets that are not already listeningI := LListenerThreads.Count;trywhile I < Bindings.Count do beginLBinding := Bindings[I];LBinding.AllocateSocket;// do not overwrite if the default. This allows ReuseSocket to be set per bindingif FReuseSocket <> rsOSDependent then beginLBinding.ReuseSocket := FReuseSocket;end;DoBeforeBind(LBinding);LBinding.Bind;LBinding.UseNagle := FUseNagle;Inc(I);end;exceptDec(I); // the one that failed doesn't need to be closedwhile I >= 0 do beginBindings[I].CloseSocket;Dec(I);end;raise;end;if I > LListenerThreads.Count then beginDoAfterBind;end;// Set up any threads that are not already runningLName := Name;if LName = '' then beginLName := 'IdCustomTCPServer'; {do not localize}end;for I := LListenerThreads.Count to Bindings.Count - 1 dobeginLBinding := Bindings[I];LBinding.Listen(FListenQueue);LListenerThread := TIdListenerThread.Create(Self, LBinding);tryLListenerThread.Name := LName + ' Listener #' + IntToStr(I + 1); {do not localize}LListenerThread.OnBeforeRun := DoBeforeListenerRun;//http://www.midnightbeach.com/jon/pubs/2002/BorCon.London/Sidebar.3.htmlLListenerThread.Priority := tpListener;LListenerThreads.Add(LListenerThread);exceptLBinding.CloseSocket;FreeAndNil(LListenerThread);raise;end;LListenerThread.Start;end;finallyFListenerThreads.UnlockList;end;
end;

设置完线程，然后启动线程，就开始端口监听了，工作就转到了监听线程TIdListenerThread：

TIdListenerThread = class(TIdThread)

父类TIdThread处理一般情况，子类只要实现Run()抽象方法：


procedure TIdListenerThread.Run;
varLContext: TIdServerContext;LIOHandler: TIdIOHandler;LPeer: TIdTCPConnection;LYarn: TIdYarn;
beginAssert(Server<>nil);Assert(Server.IOHandler<>nil);LContext := nil;LPeer := nil;LYarn := nil;try// GetYarn can raise exceptionsLYarn := Server.Scheduler.AcquireYarn;// the user to reject connections before they are accepted.  Somehow// expose an event here for the user to decide with...LIOHandler := Server.IOHandler.Accept(Binding, Self, LYarn);if LIOHandler = nil then begin// Listening has finishedStop;Abort;end else begin// We have accepted the connection and need to handle itLPeer := TIdTCPConnection.Create(nil);{$IFDEF USE_OBJECT_ARC}// under ARC, the TIdTCPConnection.IOHandler property is a weak reference.// TIdServerIOHandler.Accept() returns an IOHandler with no Owner assigned,// so lets make the TIdTCPConnection become the Owner in order to keep the// IOHandler alive when this method exits.////LPeer.InsertComponent(LIOHandler);{$ENDIF}LPeer.IOHandler := LIOHandler;LPeer.ManagedIOHandler := True;end;// LastRcvTimeStamp := Now;  // Added for session timeout support// ProcessingTimeout := False;// Check MaxConnectionsif (Server.MaxConnections > 0) and (not Server.Contexts.IsCountLessThan(Server.MaxConnections)) then beginFServer.DoMaxConnectionsExceeded(LIOHandler);LPeer.Disconnect;Abort;end;// Create and init contextLContext := Server.FContextClass.Create(LPeer, LYarn, Server.Contexts);LContext.FServer := Server;// We set these instead of having the context call them directly// because they are protected methods. Also its good to keep// Context indepent of the server as well.LContext.OnBeforeRun := Server.ContextConnected;LContext.OnRun := Server.DoExecute;LContext.OnAfterRun := Server.ContextDisconnected;LContext.OnException := Server.DoException;//Server.ContextCreated(LContext);//// If all ok, lets start the yarnServer.Scheduler.StartYarn(LYarn, LContext);excepton E: Exception do begin// RLebeau 1/11/07: TIdContext owns the Peer by default so// take away ownership here so the Peer is not freed twiceif LContext <> nil then beginTIdServerContextAccess(LContext).FOwnsConnection := False;end;FreeAndNil(LContext);FreeAndNil(LPeer);// Must terminate - likely has not started yetif LYarn <> nil then beginServer.Scheduler.TerminateYarn(LYarn);end;// EAbort is used to kick out above and destroy yarns and other, but// we dont want to show the user// To ignore EIdConnClosedGracefully, for instance...if not (E is EAbort) then beginServer.DoListenException(Self, E);end;end;end;
end;

.......

    // Create and init context
    LContext := Server.FContextClass.Create(LPeer, LYarn, Server.Contexts);
    LContext.FServer := Server;
    // We set these instead of having the context call them directly
    // because they are protected methods. Also its good to keep
    // Context indepent of the server as well.
    LContext.OnBeforeRun := Server.ContextConnected;
    LContext.OnRun := Server.DoExecute;
    LContext.OnAfterRun := Server.ContextDisconnected;
    LContext.OnException := Server.DoException;
    //
    Server.ContextCreated(LContext);
    //
    // If all ok, lets start the yarn
    Server.Scheduler.StartYarn(LYarn, LContext);

通过上下文的事件关联到了Server的执行方法。主要是LContext.OnRun := Server.DoExecute;

TIdCustomTCPServer.DoExecute 没做什么事，就检查了tcpConnected,具体工作在子类

TIdCustomHTTPServer.DoExecute，这个方法是个复杂的处理，主要是循环处理各种HTTP 方法，解析请求头，判断请求类别，归类参数等等，然后调用DoCommandGet（子类通过此方法来具体处理），最后给客户端还回响应Response，直到连接断开。

我们的子类是TIdHTTPWebBrokerBridge，看看其DoCommandGet():


procedure TIdHTTPWebBrokerBridge.DoCommandGet(AThread: TIdContext;ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
beginif FWebModuleClass <> nil then begin// FWebModuleClass, RegisterWebModuleClass supported for backward compatabilityRunWebModuleClass(AThread, ARequestInfo, AResponseInfo)end elsebegin{$IFDEF HAS_CLASSVARS}TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);{$ELSE}IndyWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);{$ENDIF}end;
end;

开始时，FWebModuleClass = nil;

所以执行的是：

TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);


typeTIdHTTPWebBrokerBridgeRequestHandler = class(TWebRequestHandler){$IFDEF HAS_CLASSVARS}privateclass var FWebRequestHandler: TIdHTTPWebBrokerBridgeRequestHandler;{$ENDIF}publicconstructor Create(AOwner: TComponent); override;{$IFDEF HAS_CLASSVARS}{$IFDEF HAS_CLASSDESTRUCTOR}class destructor Destroy;{$ENDIF}{$ENDIF}destructor Destroy; override;procedure Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);end;

这个辅助类是从TWebRequestHandler继承的，其类变量FWebRequestHandler的赋值是通过独立局部函数：
function IdHTTPWebBrokerBridgeRequestHandler: TWebRequestHandler;
begin
  {$IFDEF HAS_CLASSVARS}
  if not Assigned(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler) then
    TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
  Result := TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler;
  {$ELSE}
  if not Assigned(IndyWebRequestHandler) then
    IndyWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
  Result := IndyWebRequestHandler;
  {$ENDIF}
end;

一般的运用都有编译开关HAS_CLASSVARS，所以执行的是：

  if not Assigned(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler) then
    TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
  Result := TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler;

此函数是在单元的初始化调用，并赋值给了WebReq单元的全局变量WebRequestHandlerProc。

initialization
  WebReq.WebRequestHandlerProc := IdHTTPWebBrokerBridgeRequestHandler;

所以TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler.Run()就相当于

TIdHTTPWebBrokerBridgeRequestHandler.Run()

这里的类变量FWebRequestHandler是为了实现单例模式。

通过如此处理，就把TIdHTTPWebBrokerBridge.DoCommandGet()转到了TIdHTTPWebBrokerBridgeRequestHandler.Run()来处理，这里就是运用了桥接模式。

也就是从TIdCustomHTTPServer转接到了TWebRequestHandler。

注：

TIdHTTPWebBrokerBridge->TIdCustomHTTPServer

TIdHTTPWebBrokerBridgeRequestHandler->TWebRequestHandler

具体看看TIdHTTPWebBrokerBridgeRequestHandler.Run():


procedure TIdHTTPWebBrokerBridgeRequestHandler.Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
varLRequest: TIdHTTPAppRequest;LResponse: TIdHTTPAppResponse;
begintryLRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo);tryLResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo);try// WebBroker will free it and we cannot change this behaviourAResponseInfo.FreeContentStream := False;HandleRequest(LRequest, LResponse);finallyFreeAndNil(LResponse);end;finallyFreeAndNil(LRequest);end;except// Let Indy handle this exceptionraise;end;
end;

这里通过监听线程获得的XXXInfo参数构造了Request和Response,并调用了父类的HandleRequest(Web.WebReq.pas):


function TWebRequestHandler.HandleRequest(Request: TWebRequest;Response: TWebResponse): Boolean;
varI: Integer;LWebModule: TComponent;LWebAppServices: IWebAppServices;LGetWebAppServices: IGetWebAppServices;LComponent: TComponent;
beginResult := False;LWebModule := ActivateWebModules;if Assigned(LWebModule) thentrytryif Supports(IInterface(LWebModule), IGetWebAppServices, LGetWebAppServices) thenLWebAppServices := LGetWebAppServices.GetWebAppServices;if LWebAppServices = nil thenfor I := 0 to LWebModule.ComponentCount - 1 dobeginLComponent := LWebModule.Components[I];if Supports(LComponent, IWebAppServices, LWebAppServices) thenif LWebAppServices.Active thenbreakelseLWebAppServices := nil;end;if LWebAppServices = nil thenLWebAppServices := TDefaultWebAppServices.Create;LWebAppServices.InitContext(LWebModule, Request, Response);trytryResult := LWebAppServices.HandleRequest;exceptApplicationHandleException(LWebAppServices.ExceptionHandler);end;finallyLWebAppServices.FinishContext;end;if Result and not Response.Sent thenResponse.SendResponse;exceptApplicationHandleException(LWebAppServices.ExceptionHandler);end;finallyDeactivateWebModules(LWebModule);end;
end;

第一步：

LWebModule := ActivateWebModules;

这个是获取当前活动的Modules。

题外话：Delphi的WebBroker技术经过了多年的发展，随着大环境的发展和变化，其实现方式也不断扩展和进步。系统维护一个Module Pools，单有一个新的客户端请求Request时，就分配一个Modules。

文档:

TWebRequestHandler maintains the Web modules in an application and creates request and response objects when the application receives HTTP request messages.

TWebRequestHandler keeps a pool of active Web modules. In response to a request from the application, TWebRequestHandler creates a request object and assigns it to one of the active Web modules

ActivateWebModules()代码：


function TWebRequestHandler.ActivateWebModules: TComponent;
beginif (FMaxConnections > 0) and (FAddingActiveModules >= FMaxConnections) thenraise EWebBrokerException.CreateRes(@sTooManyActiveConnections);FCriticalSection.Enter;tryFAddingActiveModules := FActiveWebModules.Count + 1;tryif (FMaxConnections > 0) and (FActiveWebModules.Count >= FMaxConnections) thenraise EWebBrokerException.CreateRes(@sTooManyActiveConnections);if FInactiveWebModules.Count > 0 thenbeginResult := FInactiveWebModules[0];FInactiveWebModules.Extract(Result);FActiveWebModules.Add(Result);endelsebeginif WebModuleClass <> nil thenbeginResult := WebModuleClass.Create(nil);FActiveWebModules.Add(Result);endelseraise EWebBrokerException.CreateRes(@sNoDataModulesRegistered);end;finallyFAddingActiveModules := 0;end;finallyFCriticalSection.Leave;end;
end;

Module的最大数量=MaxConnections。

这里的WebModuleClass,可以是TWebModule类，如果是就项目升级，也可以是TDataMudule+TWebDispatcher， DEMO里WebModule单元的全局变量：

var
  WebModuleClass: TComponentClass = TWebModule1;

确定了这个WebModuleClass的类型，所以这里是传类别，不是实例。

这里的WebModuleClass，("if WebModuleClass <> nil then")，这个属性的赋值，我们没有明显的看到在哪里对FWebModuleClass进行赋值，实际这个属性是在外部进行赋值的，查看Demo的项目代码：

program WebServerTest;
{$APPTYPE GUI}usesVcl.Forms,Web.WebReq,IdHTTPWebBrokerBridge,FormUnit1 in 'FormUnit1.pas' {Form1},WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule};{$R *.res}beginif WebRequestHandler <> nil thenWebRequestHandler.WebModuleClass := WebModuleClass;Application.Initialize;Application.CreateForm(TForm1, Form1);Application.Run;
end.

  if WebRequestHandler <> nil then
    WebRequestHandler.WebModuleClass := WebModuleClass;

这里的WebRequestHandler是个“变量型函数”，定义在Web.WebReq.pas：

  function WebRequestHandler: TWebRequestHandler;

..............
function WebRequestHandler: TWebRequestHandler;
begin
  if Assigned(WebRequestHandlerProc) then
    Result := WebRequestHandlerProc
  else
    Result := nil;
end;

梳理下：

首先IdHTTPWebBrokerBridge.pas的初始化部分:

initialization
  WebReq.WebRequestHandlerProc := IdHTTPWebBrokerBridgeRequestHandler; 

WebReq.pas声明函数指针WebRequestHandlerProc:

var
  WebRequestHandlerProc: function: TWebRequestHandler = nil;

使得WebReq单元的WebRequestHandlerProc函数指针指向IdHTTPWebBrokerBridgeRequestHandler()，

执行  if WebRequestHandler <> nil then，调用了function WebRequestHandler: TWebRequestHandler，然后调用IdHTTPWebBrokerBridgeRequestHandler()，获得了TWebRequestHandler的实例，然后设置此实例的WebModuleClasss属性值：

WebRequestHandler.WebModuleClass := WebModuleClass;

此实例间接保存在全局函数指针WebRequestHandlerProc。

第二步：

判断WebModuleClass本身是否支持IGetWebAppServices，如果不支持，就检查WebModuleClass里的组件是否支持IWebAppServices，比如前面说的TDataMudule+TWebDispatcher，就通过TWebDispatcher获得。

没有组件支持IWebAppServices,就进行下一步，直接创建了默认的WebServices:

LWebAppServices := TDefaultWebAppServices.Create;

注： 我们可以试试，如果拖一个TWebDispatcher到TWebModule界面，就提示错误信息：“TWebDispatcher”组件只能添加到TDataModule或TForm，服务器只能有一个WebDispatcher，文档里也强调了，服务器只能有一个TWebModule类，这个是强制要求。

获取LWebAppServices后，初始化LWebAppServices的上下文：

LWebAppServices.InitContext(LWebModule, Request, Response);

然后调用LWebAppServices.HandleRequest，这样就到了真正处理Service的地方了。

这里我们看看TDefaultWebAppServices.HandleRequest(Web.HTTPApp.pas):


function TDefaultWebAppServices.HandleRequest: Boolean;
beginResult := InvokeDispatcher;
end;function TDefaultWebAppServices.InvokeDispatcher: Boolean;
beginif RequestHandler <> nil thenbeginResult := RequestHandler.HandleRequest(Request, Response);endelseraise EWebBrokerException.CreateRes(@sNoDispatcherComponent);
end;function TDefaultWebAppServices.GetRequestHandler: IWebRequestHandler;
beginif FRequestHandler = nil thenFRequestHandler := FindRequestHandler;Result := FRequestHandler;
end;function TDefaultWebAppServices.FindRequestHandler: IWebRequestHandler;
varComponent: TComponent;
beginResult := nil;Component := FindWebDispatcher;if Component <> nil thenif not Supports(Component, IWebRequestHandler, Result) thenAssert(False, 'Expect support for IWebRequestHandler');  { do not localize }
end;function TDefaultWebAppServices.FindWebDispatcher: TComponent;
varJ: Integer;
beginResult := nil;if WebModule is TCustomWebDispatcher thenResult := WebModuleelsefor J := 0 to WebModule.ComponentCount - 1 doif WebModule.Components[J] is TCustomWebDispatcher thenbeginResult := WebModule.Components[J];break;end;
end;

在InvokeDispatcher()方法里，接口RequestHandler(类型为IWebRequestHandler)是通过GetRequestHandler()获得，注意GetRequestHandler()的实现，FRequestHandler是个单例变量。

通过FindWebDispatcher()方法，最终找到实现了IWebRequestHandler接口的组件，也就是TWebModule或者TDataModule里的组件TWebDispatcher。

TWebModule和TWebDispatcher都是TCustomWebDispatcher的子类。

通过RequestHandler.HandleRequest(Request, Response)转到TCustomWebDispatcher.HandleRequest():


function TCustomWebDispatcher.HandleRequest(Request: TWebRequest; Response: TWebResponse): Boolean;
beginFRequest := Request;FResponse := Response;Result := DispatchAction(Request, Response);
end;

到这里，我们看到了"Action"字眼，爬山涉水的，露出了曙光。。。

瞧瞧DispatchAction():


function TCustomWebDispatcher.DispatchAction(Request: TWebRequest;Response: TWebResponse): Boolean;
varI: Integer;Action, Default: TWebActionItem;Dispatch: IWebDispatch;
beginFRequest := Request;FResponse := Response;I := 0;Default := nil;if Response.Sent thenbeginResult := True;{ Note that WebSnapSvr enabled apps have no way to mark response as sent }Exit;end;Result := DoBeforeDispatch(Request, Response) or Response.Sent;while not Result and (I < FActions.Count) dobeginAction := FActions[I];Result := Action.DispatchAction(Request, Response, False);if Action.Default then Default := Action;Inc(I);end;// Dispatch to self registering componentsI := 0;while not Result and (I < FDispatchList.Count) dobeginif Supports(IInterface(FDispatchList.Items[I]), IWebDispatch, Dispatch) thenbeginResult := DispatchHandler(Self, Dispatch,Request, Response, False);end;Inc(I);end;if not Result and Assigned(Default) thenResult := Default.DispatchAction(Request, Response, True);if Result and not Response.Sent thenResult := DoAfterDispatch(Request, Response);end;

用户可以在TWebModule里添加动作，就是外卖熟悉的Route->Action的那个"Action"。

首先判断本次会话是否已经完成，如代码:

  if Response.Sent then
  begin
    Result := True;
    { Note that WebSnapSvr enabled apps have no way to mark response as sent }
    Exit;
  end;

是否已经发送完Response;

  Result := DoBeforeDispatch(Request, Response) or Response.Sent;
注意这一行代码！！！这里可以让我们有机会插入请求处理过程及结果。嗯，我们可以在这里"截胡"。

DoBeforeDispatch（）调用OnBeforeDispatch
procedure TWebModule1.WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
begin
//可以预处理或者完全处理，

//Handled := True会中段后续的处理

//调用Response.Send()，会中段后续的处理
end;

如果前面没有中段处理，则会继续处理后续的"Action"，如果有的话。

到这里流程就基本明白了，如何从获取用户的请求，到我们在Server定制的功能。

网络标签：

相关问题