读一读Scktsrvr.exe的源程序

　2006-02-04 13:34:36　来源：WEB开发网　　　

核心提示：读一读Scktsrvr.exe的源程序使用DELPHI做多层开发的朋友们都应该对Scktsrvr.exe这个程序不陌生的，Borland公司在DELPHI中给出了它的源代码，读一读Scktsrvr.exe的源程序，这是一个900来行的程序，程序不算长，然后将其写在Data中，传回客户端就了事，现在我只选其中部分仔细读一

读一读Scktsrvr.exe的源程序

使用DELPHI做多层开发的朋友们都应该对Scktsrvr.exe这个程序不陌生的，
Borland公司在DELPHI中给出了它的源代码。
这是一个900来行的程序，程序不算长，
现在我只选其中部分仔细读一读。
走的线路大致是，从服务器接到客户端连接，处理客户端的一个请求（这儿
选了客户端向服务器发出的'取应用服务器列表'请求)

服务器接受了客户端连接后,
因为ServerSocket采用的是阻塞模式,服务器执行了下面这个线程来
服务客户端：

//SCKTMAIN.PAS

PRocedure TSocketDispatcherThread.ClientExecute;
var
Data: IDataBlock;
msg: TMsg;
Obj: ISendDataBlock;
Event: THandle;
WaitTime: DWord;
begin
CoInitialize(nil);　　　　　　　　 //初始化COM
try
　 Synchronize(AddClient);　　　　　　 //在程序界面上显示客户信息,
　　　　//用同步保证AddClient线程安全性
　 FTransport := CreateServerTransport;
　 try
　　 Event := FTransport.GetWaitEvent;
　　 PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
　　 GetInterface(ISendDataBlock, Obj);
　　 if FRegisteredOnly then
　　　 FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
　　　 FInterpreter := TDataBlockInterpreter.Create(Obj, ');
　　 try
　　　 Obj := nil;
　　　 if FTimeout = 0 then
　　　　 WaitTime := INFINITE else
　　　　 WaitTime := 60000;
　　　 while not Terminated and FTransport.Connected do
　　　 try
　　　　 case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
　　　　　　　//MsgWaitForMultipleObjects保持线程同步之用,
　　　　　　　//本文暂不细说它.
　　　　　 WAIT_OBJECT_0:　//有数据来了
　　　　　 begin
　　　　　　 WSAResetEvent(Event);
　　　　　　 Data := FTransport.Receive(False, 0); //从客户端接收数据块
　　　　　　 if Assigned(Data) then
　　　　　　 begin
　　　　　　　 FLastActivity := Now;
　　　　　　　 FInterpreter.InterpretData(Data);//下面接着分析这儿
　　　　　　　 Data := nil;
　　　　　　　 FLastActivity := Now;
　　　　　　 end;
　　　　　 end;
　　　　　 WAIT_OBJECT_0 + 1:
　　　　　　 while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
　　　　　　　 DispatchMessage(msg);
　　　　　 WAIT_TIMEOUT:
　　　　　　 if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
　　　　　　　 FTransport.Connected := False;
　　　　 end;
　　　 except
　　　　 FTransport.Connected := False;
　　　 end;
　　 finally
　　　 FInterpreter.Free;
　　　 FInterpreter := nil;
　　 end;
　 finally
　　 FTransport := nil;
　 end;
finally
　 CoUninitialize;
　 Synchronize(RemoveClient);
end;
end;
就这么舒舒服服的六十来行。
除开那些流程控制的语句，我们主要看到两个东西:
数据传输(FTransport) 和数据解析(FInterpreter)。

在本文中,我更感兴趣的是它的应用协议的实现,
数据传输(FTransport)就先扔在一边,以后再看了.

现在我们就来看看它的数据解析部分。
。。。
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, ');
//这两种创建TDataBlockInterpreter类实例的方法的区别也不去管它.
。。。
FInterpreter.InterpretData(Data);
。。。
就是这儿，就是这么一句。
它具体到底干了些什么呢？？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
。。。
type
TSocketDispatcherThread = class(TServerClientThread, ISendDataBlock)
private
。。。
　 FInterpreter: TDataBlockInterpreter;
　 FTransport: ITransport;
。。。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
FInterpreter这个对象引用就是这儿定义的。

procedure TDataBlockInterpreter.InterpretData(const Data: IDataBlock);
var
Action: Integer;
begin
Action := Data.Signature;//取出由客户端传来的数据块中请求标志值
　　　 //客户端数据块的具体数据格式等会儿说.
if (Action and asMask) = asError then DoException(Data);
try
　 case (Action and asMask) of　　 //根据客户端的请求标志值作相应的处理.
　　　　　 //呵,就只有这么几个。一个大型的MIDAS系统
　　　　　 //就全站在它们肩上.
　　 asInvoke: DoInvoke(Data);
　　 asGetID: DoGetIDsOfNames(Data);
　　 asCreateObject: DoCreateObject(Data);
　　 asFreeObject: DoFreeObject(Data);
　　 asGetServers: DoGetServerList(Data);
　　 asGetAppServers: DoGetAppServerList(Data);//取这个再进一步读一读.
　 else
　　 if not DoCustomAction(Action and asMask, Data) then
　　　 raise EInterpreterError.CreateResFmt(@SInvalidAction, [Action and asMask]);
　 end;
except
　 on E: Exception do
　 begin
　　 Data.Clear;
　　 WriteVariant(E.Message, Data);
　　 Data.Signature := ResultSig or asError;
　　 FSendDataBlock.Send(Data, False);
　 end;
end;
end;
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
顺着线一步步摸下去，
看它是怎么取APPSERVER列表返回客户端的。

很简单，就是通过GetMIDASAppServerList取本地的MIDAS应用服务
器列表，然后将其写在Data中，传回客户端就了事。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
procedure TDataBlockInterpreter.DoGetAppServerList(const Data: IDataBlock);
var
VList: OleVariant;
List: TStringList;
i: Integer;
begin
Data.Clear;
List := TStringList.Create;
try
　 GetMIDASAppServerList(List, FCheckRegValue);//取本机的应用服务器列表
　　　　　//想知道它是怎么做的吗?
　　　　　//源码上都有,自己看.
　 if List.Count > 0 then
　 begin
　　 VList := VarArrayCreate([0, List.Count - 1], varOleStr);
　　 for i := 0 to List.Count - 1 do
　　　 VList[i] := List[i];
　 end else
　　 VList := NULL;
finally
　 List.Free;
end;
WriteVariant(VList, Data);
Data.Signature := ResultSig or asGetAppServers;
FSendDataBlock.Send(Data, False);//将应用服务器列表传回客户端
end;

========================================================
哦..前面还有一个地方没有说,就是这个神秘的Data的数据格式,它是以接口
形式提供的,
这个程序中用的是TDataBlock中实现的这个接口.
源码中可以看出,TDataBlock中包含了一个Stream,
function TDataBlock.GetSize: Integer;
begin
Result := FStream.Size - BytesReserved;//BytesReserved的值这儿是8
end;
从这儿可以看出.数据块是从Stream的第8个字节算起,前面就是两个int型数的位置了.
function TDataBlock.GetSignature: Integer;
begin
FStream.Position := 0;
FStream.Read(Result, SizeOf(Result));
end;
呵, 没错, Stream的头四字节就是它的Signature.客户端的请求标志就是放在这儿.

function TDataBlock.GetStream: TStream;
var
DataSize: Integer;
begin
FStream.Position := 4;
DataSize := FStream.Size - BytesReserved;
FStream.Write(DataSize, SizeOf(DataSize));
FStream.Position := 0;
Result := FStream;
end;
这儿很明显,就是Data中包含数据的长度值.

需要提一下的是,如果你想改变一下传输数据块的格式,比如给它加密加压什么的,
中需要自己来实现IDataBlock接口,替掉TDataBlock就是了.

从这些源码中可以得到很多东西,无论是从优美的风格上,
无论是通讯程序开发还是MIDAS数据库以及DCOM学习或应用者,
它都是值得一读的源程序.
我觉得,更重要的是,它提供了一个严谨优美和实际的范例,更给出了
一个灵活实用的框架体系。

　　　　　　　　　　　　　　　　　　　　　　 halfdream(哈欠) 于2001-10-14晚