利用ScktSrvr打造多功能Socket服务器

Socket服务端编程中最重要的也是最难处理的工作便是客户请求的处理和数据的接收和发送，如果每一个Socket服务器应用程序的开发都要从头到尾处理这些事情的话，人将会很累，也会浪费大量时间。试想，如果有一个通用的程序把客户请求处理和数据的接收、发送都处理好了，程序员只需要在不同的应用中对接收到的数据进行不同的解析并生成返回的数据包，再由这个通用程序将数据包传回客户端，这样，程序设计的工作将会轻松许多。 
　　用Delphi进行过三层数据库应用开发的程序员一定对Borland公司的Borland Socket Server(ScktSrvr.exe)不陌生。这是一个典型的Socket服务器程序，认真读过该软件的源程序的人一定会赞叹其程序编写的高明。其程序风格堪称典范。但它是专用于配合Borland的MIDAS进行多层应用开发的。它能不能让我们实现上面的设想，以便我们应用到不同的应用中去呢？

　　随我来吧，你会有收获的。

　　首先，让我们搞清楚它的工作方式和过程，以便看能不能用它完成我们的心愿，当然改动不能太大，否则我没耐心也没有能力去做。

　　从主窗体的代码开始：不论是以系统服务方式启动程序或直接运行程序，当程序运行时，都会执行主窗体初始化方法：

TSocketForm.Initialize(FromService: Boolean);

　　该方法代码简单易读，为节省篇幅在此不列出它的源代码。该方法从注册表键“HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Socket Server”中读取端口信息，每读到一个端口，则：创建一个TSocketDispatcher的实例，并调用该实例的ReadSettings方法读取注册表数据来初始化该实例，然后激活该实例。

　　TSocketDispatcher继承自TServerSocket，是服务端Socket，当激活时便进入监听状态，监听客户端连接。当有客户端连接时，触发TSocketDispatcher实例的GetThread事件过程：

[delphi] view plain copy

print?

  1. procedure TSocketDispatcher.GetThread(Sender: TObject;
  2. ClientSocket: TServerClientWinSocket;
  3. var SocketThread: TServerClientThread);
  4. begin
  5. SocketThread := TSocketDispatcherThread.Create(False, ClientSocket,
  6. InterceptGUID, Timeout, SocketForm.RegisteredAction.Checked, SocketForm.AllowXML.Checked);
  7. end;

　　该事件过程为每一个客户端连接创建一个TSocketDispatcherThread类的服务线程为该客户端服务，其核心过程就是TSocketDispatcherThread的ClientExecute方法。对该方法的分析可以知道，它主要工作有两个：一是创建一个传送器对象(TSocketTransport)负责与客户端进行数据传输，二是创建一个数据块解析器对象（TDataBlockInterpreter）负责解析传送器对象接收到的客户端请求数据包。

[delphi] view plain copy

print?

  1. procedure TSocketDispatcherThread.ClientExecute;
  2. var
  3. Data: IDataBlock;
  4. msg: TMsg;
  5. Obj: ISendDataBlock;
  6. Event: THandle;
  7. WaitTime: DWord;
  8. begin
  9. CoInitialize(nil);  //初始化COM对象库
  10. try
  11. Synchronize(AddClient);  //显示客户信息
  12. FTransport := CreateServerTransport;  //创建传送器对象, 注意FTransport和下面的FInterpreter是线程对象的属性而不是局部变量
  13. try
  14. Event := FTransport.GetWaitEvent;
  15. PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);    //建立线程消息队列
  16. GetInterface(ISendDataBlock, Obj);    //获得TSocketDispatcherThread线程对象的ISendDataBlock接口
  17. if FRegisteredOnly then
  18. //创建数据块解析器对象，注意ISendDataBlock接口实例Obj作为参数传入了TDataBlockInterpreter的Create方法中
  19. FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
  20. FInterpreter := TDataBlockInterpreter.Create(Obj, ‘‘);
  21. try
  22. Obj := nil;
  23. if FTimeout = 0 then
  24. WaitTime := INFINITE else
  25. WaitTime := 60000;
  26. while not Terminated and FTransport.Connected do
  27. try
  28. case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
  29. WAIT_OBJECT_0:
  30. begin
  31. WSAResetEvent(Event);
  32. Data := FTransport.Receive(False, 0);    //传送器对象接收客户端数据
  33. if Assigned(Data) then                  //接收成功
  34. begin
  35. FLastActivity := Now;
  36. FInterpreter.InterpretData(Data);     //数据块解析器对象对数据进行解析
  37. Data := nil;
  38. FLastActivity := Now;
  39. end;
  40. end;
  41. WAIT_OBJECT_0 + 1:
  42. while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
  43. DispatchMessage(msg);
  44. WAIT_TIMEOUT:
  45. if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
  46. FTransport.Connected := False;
  47. end;
  48. except
  49. FTransport.Connected := False;
  50. end;
  51. finally
  52. FInterpreter.Free;         //释放数据块解析器对象
  53. FInterpreter := nil;
  54. end;
  55. finally
  56. FTransport := nil;          //释放传送器对象
  57. end;
  58. finally
  59. CoUninitialize;            //关闭COM对象库
  60. Synchronize(RemoveClient);    //删除显示的客户信息
  61. end;
  62. end;

　　在代码中我们没有看到如何向客户端传回数据的过程，这项工作是由数据块解析器对象、传送器对象和接口ISendDataBlock（TSocketDispatcherThread实现了该接口）共同协调完成的。从以上代码我们注意到，线程对象的ISendDataBlock接口(Obj变量)被作为参数传入了TDataBlockInterpreter的Create方法中，实际上也就是线程对象被传递到了数据块解析器对象中，后面我们将看到，数据块解析器完成数据解析后，会创建一个新的数据块（TDataBlock）对象来打包要返回到客户端的数据，然后调用ISendDataBlock接口的Send方法（实际上是TSocketDispatcherThread的Send方法）将数据发送到客户端，而TSocketDispatcherThread的Send方法最终调用传送器对象（TSocketDispatcherThread的FTransport）的Send方法进行实际的数据传输。看下面的代码我们就清楚这一点：

[delphi] view plain copy

print?

  1. { TSocketDispatcherThread.ISendDataBlock }
  2. function TSocketDispatcherThread.Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock;
  3. begin
  4. //用传送器对象回传数据，其中Data是由数据块解析器创建的数据块对象，以接口类型参数的方式传到该函数
  5. FTransport.Send(Data);
  6. //当数据块解析器需要进行连续的数据回传（如数据太大，一次不能不能回传所有数据）时，
  7. //它向WaitForResult参数传入True，SocketDispatcherThread就会
  8. //在一次发送数据之后检索并解析客户端的回应，决定是否继续回传数据。
  9. if WaitForResult then
  10. while True do
  11. begin
  12. Result := FTransport.Receive(True, 0); //检索客户端回应
  13. if Result = nil then break;
  14. if (Result.Signature and ResultSig) = ResultSig then
  15. break else
  16. FInterpreter.InterpretData(Result);  //解析客户端回应
  17. end;
  18. end;

　　从上面的简单分析我们知道，在一次C/S会话过程中用到了几个对象，分别是：传送器(TSocketTransport)对象，数据块解析器（TDataBlockInterpreter）对象，数据块（TDataBlock）对象，还有就是ISendDataBlock接口，它由TSocketDispatcherThread实现。而数据处理主要在前两者，它们分工很明确，而这两者的协调就是通过后两者实现。

　　对象间的明确分工和有序合作给我们改造提供了条件。再看离我们的设想有多远。1、客户请求的处理：TSocketDispatcher已经为我们做得很好了，这方面我们基本不需要改动。2、数据的接收：就看传送器能不能接收不同类型的数据了，若不能，再看方不方便派生和使用新的传送器类。3、发送数据：用TSocketDispatcherThread的Send方法就完成了，我们只需在解析请求后生成返回的数据块对象，传递给该方法就可以了。4、解析数据：不同的应用中对数据的解析肯定是不同的，只有用新的解析器类去实现，主要看在TSocketDispatcherThread的ClientExecute方法中能否应用不同的解析器类。

　　从接收数据开始。

　　数据接收由传送器(TSocketTransport)对象完成，该类在Sconnect单元中（请先将Sconnect单元做一个备份），我们看它的接收（Receive）方法：

[delphi] view plain copy

print?

  1. function TSocketTransport.Receive(WaitForInput: Boolean; Context: Integer): IDataBlock;
  2. var
  3. RetLen, Sig, StreamLen: Integer;
  4. P: Pointer;
  5. FDSet: TFDSet;
  6. TimeVal: PTimeVal;
  7. RetVal: Integer;
  8. begin
  9. Result := nil;
  10. TimeVal := nil;
  11. FD_ZERO(FDSet);
  12. FD_SET(FSocket.SocketHandle, FDSet);
  13. if not WaitForInput then
  14. begin
  15. New(TimeVal);
  16. TimeVal.tv_sec := 0;
  17. TimeVal.tv_usec := 1;
  18. end;
  19. RetVal := select(0, @FDSet, nil, nil, TimeVal);
  20. if Assigned(TimeVal) then
  21. FreeMem(TimeVal);
  22. if RetVal = SOCKET_ERROR then
  23. raise ESocketConnectionError.Create(SysErrorMessage(WSAGetLastError));
  24. if (RetVal = 0) then Exit;
  25. //以上代码与Socket原理密切相关，功能是实现数据接收控制，本人理解还不是很透，也不需要改动它。
  26. //以下代码才开始接收数据
  27. RetLen := FSocket.ReceiveBuf(Sig, SizeOf(Sig));  //检索数据签名
  28. if RetLen <> SizeOf(Sig) then
  29. raise ESocketConnectionError.CreateRes(@SSocketReadError);  //出错
  30. CheckSignature(Sig);  //检查数据标志，若不合法则产生异常
  31. RetLen := FSocket.ReceiveBuf(StreamLen, SizeOf(StreamLen));  //检索数据长度
  32. if RetLen = 0 then
  33. raise ESocketConnectionError.CreateRes(@SSocketReadError);  //出错
  34. if RetLen <> SizeOf(StreamLen) then
  35. raise ESocketConnectionError.CreateRes(@SSocketReadError); //出错
  36. Result := TDataBlock.Create as IDataBlock;  //创建数据块对象
  37. Result.Size := StreamLen;  //设置数据块对象的Size，即数据长度
  38. Result.Signature := Sig;   //设置数据块对象的数据标志
  39. P := Result.Memory;  //取得数据块对象的内存指针
  40. Inc(Integer(P), Result.BytesReserved);  //跳过保留字节数
  41. while StreamLen > 0 do  //接收StreamLen字节的数据并写入数据块对象的数据域
  42. begin
  43. RetLen := FSocket.ReceiveBuf(P^, StreamLen);
  44. if RetLen = 0 then
  45. raise ESocketConnectionError.CreateRes(@SSocketReadError);
  46. if RetLen > 0 then
  47. begin
  48. Dec(StreamLen, RetLen);
  49. Inc(Integer(P), RetLen);
  50. end;
  51. end;
  52. if StreamLen <> 0 then
  53. raise ESocketConnectionError.CreateRes(@SInvalidDataPacket);  //出错
  54. InterceptIncoming(Result);  //如果采用了加密、压缩等处理过数据，在此将其还原
  55. end;

　　分析到此，我们得先了解一下数据块对象，它并不复杂，因此在此不对其代码进行分析，只简单说明它的结构。其实从MIDAS应用的客户端传来的请求就是一个数据块，上述接收过程将其接收后还原成一个数据块对象。注意不要混淆数据块和数据块对象，前者是数据流，后者是一个对象，封装了数据块和对数据块操作的方法。数据块的前8个字节（两个整数）为保留字节（BytesReserved=8），分别是数据块签名（Signature）和实际数据长度（Size），紧接着才是实际的数据，其长度由Size域指定。数据块签名取值于一些预定义的常量，这些常量定义在SConnect单元中，如下：

[delphi] view plain copy

print?

  1. const
  2. { Action Signatures }
  3. CallSig         = $DA00; // Call signature
  4. ResultSig       = $DB00; // Result signature
  5. asError         = $01;   // Specify an exception was raised
  6. asInvoke        = $02;   // Specify a call to Invoke
  7. asGetID         = $03;   // Specify a call to GetIdsOfNames
  8. asCreateObject  = $04;   // Specify a com object to create
  9. asFreeObject    = $05;   // Specify a dispatch to free
  10. asGetServers    = $10;   // Get classname list
  11. asGetGUID       = $11;   // Get GUID for ClassName
  12. asGetAppServers = $12;   // Get AppServer classname list
  13. asSoapCommand   = $14;   // Soap command
  14. asMask          = $FF;   // Mask for action

　　从传送器的接收方法可看出，如果接收到的数据签名不合法，将引发异常，后续数据就不再接收。再看下面对签名的检查：

[delphi] view plain copy

print?

  1. procedure CheckSignature(Sig: Integer);
  2. begin
  3. if (Sig and $FF00 <> CallSig) and
  4. (Sig and $FF00 <> ResultSig) then
  5. raise Exception.CreateRes(@SInvalidDataPacket);
  6. end;

　　签名的高字节必须为CallSig或ResultSig，满足这个条件就可通过接收检查这一关，后续数据就可正常接收。签名的低字节由解析器解析，以实现不同的数据处理。

　　对数据签名的检查使得Scktsrvr.exe的应用范围局限于MIDAS应用。如果我们要做成通用Socket服务器，比如做一个WWW服务器或做一个HTTP代理服务器，客户端（浏览器）发送来的请求（Http请求根本就不符合数据块的结构）是通不过检查的，连请求都无法接收，更谈不上处理了。因此这是首先要改造的部分。

　　为了使服务器保留MIDAS的功能，又能用于其他Socket应用，我把数据传输分为MIDAS数据传输和自定义数据传输，如果是前者，接收方法自然不需变动，如果是后者，则跳过两个保留字节的接收，直接接收数据写到数据块对象中，至于数据解析，前面说过，是必须用新的解析器类的，我们在新的解析器中处理。改造很简单：

1、给传送器类添加一个IsCustomTrans属性：

[delphi] view plain copy

print?

  1. TSocketTransport = class(TInterfacedObject, ITransport)
  2. private
  3. ...
  4. FIsCustomTrans: Boolean;        { === My Code === }
  5. ...
  6. public
  7. ...
  8. property IsCustomTrans: Boolean read FIsCustomTrans write FIsCustomTrans;        { === My Code === }
  9. end;

2、改写TSocketTransport的Receive方法：

[delphi] view plain copy

print?

  1. function TSocketTransport.Receive(WaitForInput: Boolean; Context: Integer): IDataBlock;
  2. var
  3. RetLen, Sig, StreamLen: Integer;
  4. P: Pointer;
  5. FDSet: TFDSet;
  6. TimeVal: PTimeVal;
  7. RetVal: Integer;
  8. begin
  9. ...
  10. if (RetVal = 0) then Exit;
  11. if not IsCustomTrans then        { === My Code === }
  12. begin
  13. RetLen := FSocket.ReceiveBuf(Sig, SizeOf(Sig));
  14. ...
  15. if RetLen <> SizeOf(StreamLen) then
  16. raise ESocketConnectionError.CreateRes(@SSocketReadError);
  17. end
  18. else
  19. StreamLen:=FSocket.ReceiveLength;    { === My Code === }
  20. Result := TDataBlock.Create as IDataBlock;
  21. if not IsCustomTrans then        { === My Code === }
  22. Result.Signature := Sig;
  23. ...
  24. end;

2、TSocketTransport的Send方法用于实际回传数据，也需改写：

[delphi] view plain copy

print?

  1. function TSocketTransport.Send(const Data: IDataBlock): Integer;
  2. var
  3. P: Pointer;
  4. begin
  5. Result := 0;
  6. InterceptOutgoing(Data);
  7. P := Data.Memory;
  8. if IsCustomTrans then        { === My Code === }
  9. FSocket.SendBuf(PByteArray(P)^[Data.BytesReserved],Data.Size) { === My Code === 不发送保留字节}
  10. else
  11. FSocket.SendBuf(P^, Data.Size + Data.BytesReserved);
  12. end;
  13. 到此，发送和接收的处理就改造完了，只用了几行代码，是不是很简单？
  14. 　　接下来要处理的是数据解析。
  15. 　　MIDAS的数据解析器类为TDataBlockInterpreter，它继承于TCustomDataBlockInterpreter。这两个类也在Sconnect单元中，定义如下：
  16. TCustomDataBlockInterpreter = class
  17. protected
  18. procedure AddDispatch(Value: TDataDispatch); virtual; abstract;
  19. procedure RemoveDispatch(Value: TDataDispatch); virtual; abstract;
  20. { Sending Calls }
  21. procedure CallFreeObject(DispatchIndex: Integer); virtual; abstract;
  22. function CallGetIDsOfNames(DispatchIndex: Integer; const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; virtual; stdcall; abstract;
  23. function CallInvoke(DispatchIndex, DispID: Integer; const IID: TGUID; LocaleID: Integer;
  24. Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; virtual; stdcall; abstract;
  25. function CallGetServerList: OleVariant; virtual; abstract;
  26. { Receiving Calls }
  27. function InternalCreateObject(const ClassID: TGUID): OleVariant; virtual; abstract;
  28. function CreateObject(const Name: string): OleVariant; virtual; abstract;
  29. function StoreObject(const Value: OleVariant): Integer; virtual; abstract;
  30. function LockObject(ID: Integer): IDispatch; virtual; abstract;
  31. procedure UnlockObject(ID: Integer; const Disp: IDispatch); virtual; abstract;
  32. procedure ReleaseObject(ID: Integer); virtual; abstract;
  33. function CanCreateObject(const ClassID: TGUID): Boolean; virtual; abstract;
  34. function CallCreateObject(Name: string): OleVariant;  virtual;  abstract;
  35. public
  36. procedure InterpretData(const Data: IDataBlock); virtual; abstract;
  37. end;
  38. { TBinary... }
  39. TDataBlockInterpreter = class(TCustomDataBlockInterpreter)
  40. private
  41. FDispatchList: TList;
  42. FDispList: OleVariant;
  43. FSendDataBlock: ISendDataBlock;
  44. FCheckRegValue: string;
  45. function GetVariantPointer(const Value: OleVariant): Pointer;
  46. procedure CopyDataByRef(const Source: TVarData; var Dest: TVarData);
  47. function ReadArray(VType: Integer; const Data: IDataBlock): OleVariant;
  48. procedure WriteArray(const Value: OleVariant; const Data: IDataBlock);
  49. function ReadVariant(out Flags: TVarFlags; const Data: IDataBlock): OleVariant;
  50. procedure WriteVariant(const Value: OleVariant; const Data: IDataBlock);
  51. procedure DoException(const Data: IDataBlock);
  52. protected
  53. procedure AddDispatch(Value: TDataDispatch); override;
  54. procedure RemoveDispatch(Value: TDataDispatch); override;
  55. function InternalCreateObject(const ClassID: TGUID): OleVariant; override;
  56. function CreateObject(const Name: string): OleVariant; override;
  57. function StoreObject(const Value: OleVariant): Integer; override;
  58. function LockObject(ID: Integer): IDispatch; override;
  59. procedure UnlockObject(ID: Integer; const Disp: IDispatch); override;
  60. procedure ReleaseObject(ID: Integer); override;
  61. function CanCreateObject(const ClassID: TGUID): Boolean; override;
  62. {Sending Calls}
  63. procedure CallFreeObject(DispatchIndex: Integer); override;
  64. function CallGetIDsOfNames(DispatchIndex: Integer; const IID: TGUID; Names: Pointer;
  65. NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; override;
  66. function CallInvoke(DispatchIndex, DispID: Integer; const IID: TGUID; LocaleID: Integer;
  67. Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;  override;
  68. function CallGetServerList: OleVariant; override;
  69. {Receiving Calls}
  70. procedure DoCreateObject(const Data: IDataBlock);
  71. procedure DoFreeObject(const Data: IDataBlock);
  72. procedure DoGetIDsOfNames(const Data: IDataBlock);
  73. procedure DoInvoke(const Data: IDataBlock);
  74. function DoCustomAction(Action: Integer; const Data: IDataBlock): Boolean; virtual;
  75. procedure DoGetAppServerList(const Data: IDataBlock);
  76. procedure DoGetServerList(const Data: IDataBlock);
  77. public
  78. constructor Create(SendDataBlock: ISendDataBlock; CheckRegValue: string);
  79. destructor Destroy; override;
  80. function CallCreateObject(Name: string): OleVariant;  override;
  81. procedure InterpretData(const Data: IDataBlock); override;
  82. end;

　　TCustomDataBlockInterpreter类完全是一个抽象类，它的方法全是虚拟、抽象方法。TDataBlockInterpreter继承于它，实现了它的所有方法。

　　TDataBlockInterpreter如何解析数据块我们就不去理它了，因为我们不用动它，我们要做的是自己的解析器类。如果有兴趣的话，网上搜索一下“读一读Scktsrvr.exe的源程序”。

　　要创建我们自己的解析器类，很自然想到的就是从TCustomDataBlockInterpreter继承，象TDataBlockInterpreter类一样一个个实现它的虚拟方法。但是且慢，先考虑一下，实现这一大堆的方法对我们有用吗？这些方法主要是用于响应MIDAS客户的数据库访问请求的。虽然我们可以因为用不上而在方法的实现中置之不理，但是拷贝这一大堆方法到新类中并生成一大串无用的空方法就是一件烦人的事情，有些函数类方法还必须得写一行无用的返回值行，浪费时间。因此，我决定为TCustomDataBlockInterpreter创建一个祖先类。

　　解析器类的主要方法就是：

procedure InterpretData(const Data: IDataBlock);

　　这一个方法从TCustomDataBlockInterpreter类移到新的解析器祖先类中，新的解析器祖先类定义和实现如下：

[delphi] view plain copy

print?

  1. type
  2. TBaseDataBlockInterpreter = class
  3. protected
  4. FDispatchList: TList;
  5. FSendDataBlock: ISendDataBlock;
  6. public
  7. constructor Create(SendDataBlock: ISendDataBlock; CheckRegValue: string);
  8. destructor Destroy; override;
  9. procedure InterpretData(const Data: IDataBlock); virtual; abstract;
  10. function DisconnectOnComplete: Boolean; virtual;
  11. end;
  12. implementation
  13. constructor TBaseDataBlockInterpreter.Create(SendDataBlock: ISendDataBlock;CheckRegValue: string);
  14. begin
  15. inherited Create;
  16. FDispatchList := TList.Create;
  17. FSendDataBlock:=SendDataBlock;
  18. //CheckRegValue未用，保留该参数只是使该方法与TDataBlockInterpreter参数一致
  19. end;
  20. destructor TBaseDataBlockInterpreter.Destroy;
  21. var
  22. i: Integer;
  23. begin
  24. for i := FDispatchList.Count - 1 downto 0 do
  25. TDataDispatch(FDispatchList[i]).FInterpreter := nil;
  26. FDispatchList.Free;
  27. FSendDataBlock := nil;
  28. inherited;
  29. end;
  30. function TBaseDataBlockInterpreter.DisconnectOnComplete: Boolean;
  31. begin
  32. Result:=False;
  33. end;

　　该类中有关FDispatchList的代码是直接从TDataBlockInterpreter类中移过来的（蓝色字部分），如果不移到此，当MIDAS客户端断开连接时服务端会出错，我不明白是为什么。该类加了一个虚拟方法DisconnectOnComplete，简单地返回False。设置该方法的目的是用于一些服务端完成服务后主动断开连接的应用，在子类中重载该方法并返回True即可，这将在后面叙述。TCustomDataBlockInterpreter类从TBaseDataBlockInterpreter继承，并取消InterpretData方法：

[delphi] view plain copy

print?

  1. TCustomDataBlockInterpreter = class(TBaseDataBlockInterpreter)   { === Modified === }
  2. protected
  3. ...
  4. public
  5. //procedure InterpretData(const Data: IDataBlock); virtual; abstract;  { === Modified === }
  6. end;
  7. 　　对TDataBlockInterpreter的更改也很简单：
  8. TDataBlockInterpreter = class(TCustomDataBlockInterpreter)
  9. private
  10. //FDispatchList: TList;                       { === Modified === }
  11. FDispList: OleVariant;
  12. //FSendDataBlock: ISendDataBlock;      { === Modified === }
  13. ...
  14. protected
  15. ...
  16. public
  17. ...
  18. end;
  19. constructor TDataBlockInterpreter.Create(SendDataBlock: ISendDataBlock; CheckRegValue: string);
  20. begin
  21. inherited Create(SendDataBlock, CheckRegValue);   { === Modified === }
  22. //FSendDataBlock := SendDataBlock;                { === Modified === }
  23. //FDispatchList := TList.Create;               { === Modified === }
  24. FCheckRegValue := CheckRegValue;
  25. end;
  26. destructor TDataBlockInterpreter.Destroy;  //该方法的代码都注释完了，可以删除该方法
  27. //var
  28. //  i: Integer;
  29. begin
  30. //  for i := FDispatchList.Count - 1 downto 0 do
  31. //    TDataDispatch(FDispatchList[i]).FInterpreter := nil;
  32. //  FDispatchList.Free;
  33. //  FSendDataBlock := nil;
  34. inherited Destroy;
  35. end;

　　至此，对解析器类的修改完成。当某应用(非MIDAS应用)需要一个解析器时，从TBaseDataBlockInterpreter继承，然后实现InterpretData方法即可，根据应用性质决定是否重载DisconnectOnComplete方法使之返回True。

　　还有什么要做呢？我们给TSocketTransport加了一个IsCustomTrans属性，该属性的值在何处设置？与解析器有关系吗？不同的解析器类又如何根据应用的性质创建呢？

　　由上面对Scktsrvr工作过程的分析我们知道，传送器对象和解析器对象都是在服务线程(TSocketDispatcherThread)的ClientExecute方法中创建、使用并销毁的，而服务线程又是由服务Socket(TSocketDispatcher)创建的，因此必须从这两个类中进行处理。

　　回过头看TSocketDispatcherThread的ClientExecute方法，传送器对象（TSocketTransport）的创建这下面这句：

FTransport := CreateServerTransport;

间接地通过方法CreateServerTransport来创建传送器对象，再看CreateServerTransport方法：

[delphi] view plain copy

print?

  1. function TSocketDispatcherThread.CreateServerTransport: ITransport;
  2. var
  3. SocketTransport: TSocketTransport;
  4. begin
  5. SocketTransport := TSocketTransport.Create;
  6. SocketTransport.Socket := ClientSocket;
  7. SocketTransport.InterceptGUID := FInterceptGUID;
  8. Result := SocketTransport as ITransport;
  9. end;

　　传送器对象在这里创建，当然这里就是设置它的IsCustomTrans属性的最佳地方。IsCustomTrans属性是区分MIDAS应用和非MIDAS应用的，我们很容易想到的就是为TSocketDispatcherThread也添加一个新属性来标志是哪一类应用，然后根据该属性的值来设置传送器对象的IsCustomTrans属性值就很容易办到。加一个什么样的属性呢？

　　我们先来看看解析器对象。MIDAS应用使用的解析器类是TDataBlockInterpreter，非MIDAS应用使用我们自定义的解析器类。解析器类在TSocketDispatcherThread中是一个属性：

FInterpreter: TDataBlockInterpreter;

定义为TDataBlockInterpreter类型，就只能应用于MIDAS应用，必须更改，让它可以使用我们的自定义解析器类。但我们自定义的解析器类的类名是什么，我自己都还没想好呢，怎么指定FInterpreter的类型？就算定好了类名，定义成

FInterpreter: TMyDataBlockInterpreter;

那MIDAS应用要用的TDataBlockInterpreter又怎么办。不管定义为TBaseDataBlockInterpreter的哪一个子类都行不通，必须要定义成基类：

FInterpreter: TBaseDataBlockInterpreter;

而TBaseDataBlockInterpreter是一个抽象类，我们不能直接创建它的实例，创建对象时必须要使用其子类来创建，在这里就是TDataBlockInterpreter类或我们自定义的解析器类。类似于

FInterpreter:=TDataBlockInterpreter.Create()

和

FInterpreter:=TMyDataBlockInterpreter.Create()。

问题是类名事先不能确定，我们不能等到定好了类名后再来这里写代码，这样做不可能通用。因此必须要能够动态指定类名。这就需要用到类引用类型了，因为可以用类名给类引用类型的变量赋值，然后由它来创建对象。为此，我们先定义一个TBaseDataBlockInterpreter类的类引用类型TDataBlockInterpreterClass，放在TBaseDataBlockInterpreter类的定义之前即可：

[delphi] view plain copy

print?

  1. TDataBlockInterpreterClass = class of TBaseDataBlockInterpreter;
  2. 为TSocketDispatcherThread添加一个DataBlockInterpreterClass属性
  3. TSocketDispatcherThread = class(TServerClientThread, ISendDataBlock)
  4. private
  5. ...
  6. FInterpreter: TBaseDataBlockInterpreter;  { === Modified === }
  7. FDataBlockInterpreterClass: TDataBlockInterpreterClass; { === New === }
  8. protected
  9. ...
  10. public
  11. ...
  12. property DataBlockInterpreterClass: TDataBlockInterpreterClass read FDataBlockInterpreterClass write FDataBlockInterpreterClass; { === New === }
  13. end;

于是设置传送器类的IsCustomTrans属性和创建不同解析器对象就迎韧而解了：

[delphi] view plain copy

print?

  1. function TSocketDispatcherThread.CreateServerTransport: ITransport;
  2. var
  3. SocketTransport: TSocketTransport;
  4. begin
  5. SocketTransport := TSocketTransport.Create;
  6. SocketTransport.Socket := ClientSocket;
  7. SocketTransport.InterceptGUID := FInterceptGUID;
  8. if DataBlockInterpreterClass.ClassName=‘TDataBlockInterpreter‘ then  { === New == = }
  9. SocketTransport.IsCustomTrans:=False  { === New === }
  10. else         { === New === }
  11. SocketTransport.IsCustomTrans:=True; { === New === }
  12. Result := SocketTransport as ITransport;
  13. end;
  14. procedure TSocketDispatcherThread.ClientExecute;
  15. begin
  16. ...
  17. if FRegisteredOnly then
  18. FInterpreter := DataBlockInterpreterClass.Create(Obj, SSockets)  { === Modified === }
  19. else
  20. FInterpreter := DataBlockInterpreterClass.Create(Obj, ‘‘);  { === Modified === }
  21. try
  22. ...
  23. WAIT_OBJECT_0:
  24. begin
  25. WSAResetEvent(Event);
  26. ...
  27. if FInterpreter.DisconnectOnComplete then   //添加的两行代码，DisconnectOnComplete在此运用
  28. FTransport.Connected := False;
  29. end;
  30. WAIT_OBJECT_0 + 1:
  31. ...
  32. finally
  33. FInterpreter.Free;
  34. FInterpreter := nil;
  35. end;
  36. ...
  37. end;

最后给TSocketDispatcher类也添加一个DataBlockInterpreterClass属性，并修改其GetThread方法：

[delphi] view plain copy

print?

  1. TSocketDispatcher = class(TServerSocket)
  2. private
  3. ...
  4. FDataBlockInterpreterClass: TDataBlockInterpreterClass;{ === New === }
  5. ...
  6. public
  7. ...
  8. property DataBlockInterpreterClass: TDataBlockInterpreterClass read FDataBlockInterpreterClass write FDataBlockInterpreterClass; { === New === }
  9. end;
  10. procedure TSocketDispatcher.GetThread(Sender: TObject;
  11. ClientSocket: TServerClientWinSocket;
  12. var SocketThread: TServerClientThread);
  13. begin
  14. SocketThread := TSocketDispatcherThread.Create(True, ClientSocket,
  15. InterceptGUID, Timeout, SocketForm.RegisteredAction.Checked, SocketForm.AllowXML.Checked);{ === Modified === }
  16. TSocketDispatcherThread(SocketThread).DataBlockInterpreterClass:=FDataBlockInterpreterClass;{ === New === }
  17. SocketThread.Resume;{ === New === }
  18. end;

至此，与Socket有关的所有类更改完成，添加和改动的代码不过数十行，Scktsrvr.exe在保留原功能的基础上可以很方便地增加其他服务功能，做成一个多功能Socket服务端应用程序。

在Scktsrvr主窗体代码中，对主窗体的ReadSettings方法的子过程CreateItem进行一点点修改：

[delphi] view plain copy

print?

  1. procedure CreateItem(ID: Integer);
  2. var
  3. SH: TSocketDispatcher;
  4. begin
  5. SH := TSocketDispatcher.Create(nil);
  6. SH.DataBlockInterpreterClass:=TDataBlockInterpreter;    { === New === }
  7. ...
  8. end;

保存并编译，新的Scktsrvr.exe产生了，但功能还没有增加。假设要增加http代理功能，首先从TBaseDataBlockInterpreter派生一个新类TProxyDataBlockInterpreter并实现InterpretData方法，然后定义一个TSocketDispatcher类型的变量，再创建一个TSocketDispatcher对象实例到该变量并指定其DataBlockInterpreterClass属性为TProxyDataBlockInterpreter即可。示例如下：

[delphi] view plain copy

print?

  1. var
  2. ProxySocket: TSocketDispatcher;
  3. procedure CreateProxyServerSocket;
  4. begin
  5. ProxySocket:= TSocketDispatcher.Create(nil);
  6. with ProxySocket do
  7. begin
  8. Port:=8080;
  9. ThreadCacheSize := 10;
  10. FInterceptGUID := ‘‘;
  11. FTimeout := 0;
  12. DataBlockInterpreterClass:=TProxyDataBlockInterpreter;
  13. Open;
  14. end;
  15. end;

后话：TSocketDispatcher类和TSocketDispatcherThread类在Scktsrvr.exe的主窗体单元中，为使应用更加灵活，最好将这两个类的代码拷贝出来放到一个独立的单元中（当然还要进行一些修改），这样，在我们自己的应用中加入这个单元和SConnect单元，就可以很方便地按我们自己喜好的风格设计Socket服务器应用程序界面了。

http://blog.csdn.net/aroc_lo/article/details/9170247

时间： 2024-11-03 13:43:06

利用ScktSrvr打造多功能Socket服务器的相关文章

java 利用NIO建立Socket服务器

Socket的Channel在Selector上注册某一种动作,Selector通过select操作,监视所有在该Selector注册过的Channel的对应的动作,如果监测到某一对应的动作,则返回selectedKeys,自己手动取到各个SelectionKey进行相应的处理.当然NIO不仅可以接受Socket的Channel,还有文件操作等其他IO操作. AD: WOT2015 互联网运维与开发者大会 热销抢票 传统的Java 的IO,利用Socket建立服务器,接收客户端连接,一般都是为每

如何用PHP实现Socket服务器

想要构建聊天应用,或者甚至是游戏吗?那么,socket服务器将成为你迈出的第一步.一旦你了解了创建服务器的基本功能,那么后续的优化步骤就会变得同样简单. socket服务器的工作方式是这样的,不间断地运行以等待客户端的连接.一旦客户端连接上了,服务器就会将它添加到客户名单中,然后开始等待来自客户端的消息. 不要走开,下面是完整的源代码: // Set time limit to indefinite execution set_time_limit (0); // Set the ip and

CentOS 6.5下利用Rsyslog+LogAnalyzer+MySQL部署日志服务器

一.简介 LogAnalyzer 是一款syslog日志和其他网络事件数据的Web前端.它提供了对日志的简单浏览.搜索.基本分析和一些图表报告的功能.数据可以从数据库或一般的syslog文本文件中获取,所以LogAnalyzer不需要改变现有的记录架构.基于当前的日志数据,它可以处理syslog日志消息,Windows事件日志记录,支持故障排除,使用户能够快速查找日志数据中看出问题的解决方案. LogAnalyzer 获取客户端日志会有两种保存模式,一种是直接读取客户端/var/log/目录下的

C#高性能Socket服务器SocketAsyncEventArgs的实现(IOCP)

原创性申明 本文作者:小竹zz  博客地址:http://blog.csdn.net/zhujunxxxxx/article/details/43573879转载请注明出处 引言 我一直在探寻一个高性能的Socket客户端代码.以前,我使用Socket类写了一些基于传统异步编程模型的代码(BeginSend.BeginReceive,等等)也看过很多博客的知识,在linux中有poll和epoll来实现,在windows下面 微软MSDN中也提供了SocketAsyncEventArgs这个类来

转：Socket服务器整体架构概述

Socket服务器主要用于提供高效.稳定的数据处理.消息转发等服务,它直接决定了前台应用程序的性能.我们先从整体上认识一下Socket服务器,Socket服务器从架构上一般分为:网络层.业务逻辑层.会话层.数据访问层,如图: (图1) (一) 网络层 网络层主要用于侦听socket连接.创建socket.接受消息.发送消息.关闭连接.作为socket通信服务器,网络层的性能相当重要,所以我们在设计网络层时,要着重在以下几方面获得突破:最大连接数.最大并发数.秒处理消息数.如何突破呢?下面我为大家

怎样利用App打造自明星实现自盈利

1.了解各个概念 为了大家都能看懂这篇文章,先说明几个概念. App(Application):能够在移动设备上使用,满足人们咨询.购物.社交.娱乐.搜索等需求的一切应用程序. 自媒体:说白了,媒体就是一个传播渠道,传播思想也好,传播信息也罢,总之是一个渠道. 自明星:个人通过自媒体成为让大众熟知的某个领域的名人. 自盈利:就是个人通过自媒体.自明星.自电商达到盈利的目的. 从App的定义中,我们知道App不不过一个渠道,还能做非常多其它事情.那么,利用App来搭建自媒体平台,应该是顺理成章的事

如何利用App打造自明星实现自盈利

1.了解各个概念 为了大家都能看懂这篇文章,先说明几个概念. App(Application):可以在移动设备上使用,满足人们咨询.购物.社交.娱乐.搜索等需求的一切应用程序. 自媒体:说白了,媒体就是一个传播渠道,传播思想也好,传播信息也罢,总之是一个渠道. 自明星:个人通过自媒体成为让大众熟知的某个领域的名人. 自盈利:就是个人通过自媒体.自明星.自电商达到盈利的目的. 从App的定义中,我们知道App不仅仅是一个渠道,还能做很多其他事情.那么,利用App来搭建自媒体平台,应该是顺理成章的事

异步Socket服务器与客户端

本文灵感来自Andre Azevedo 在CodeProject上面的一片文章,An Asynchronous Socket Server and Client,讲的是异步的Socket通信. Socket连接(Socket Connection) Socket服务(Socket Service) 连接主机(Connection Host) 加密与压缩(Encrypt与Compress) 请求入队(Enqueuing Requests) 确保发送和接收(Ensure send and recie

网络编程四：互联网中TCP Socket服务器的实现过程需要考虑哪些安全问题

这篇曾经是答在这里的 互联网中TCP Socket服务器的实现过程需要考虑哪些安全问题- auxten 的回答 最近总是有人问我相关的问题,在专栏补发一下,希望能帮到更多人 首先,这是个很大的命题,之前在360负责过几个对外的服务的研发,也算是有点小经验,我试着答一下 在Internet环境下安全问题我主要分为如下几类 1. 信息传输过程中被黑客窃取 2. 服务器自身的安全 3. 服务端数据的安全 首先,如果能用https,就尽量用https,能用nginx等常见服务器,就用常见服务器,主要能避