Delphi 跨平台 Socket 通讯库作者: WiNDDRiVER(soulawing@gmail.com)
重要更新(2017.08.22)代码重构, 做了大量修改, 详见源码增加了几个新的 interface, 用法详见 demosICrossSocketICrossSslSocketICrossServerICrossSslServer特性针对不同平台使用不同的IO模型:IOCPWindowsKQUEUEFreeBSD(MacOSX, iOS...)EPOLLLinux(Linux, Android...)支持极高的并发Windows能跑10万以上的并发数, 需要修改注册表调整默认的最大端口数Mac做了初步测试, 测试环境为虚拟机中的 OSX 10.9.5, 即便修改了系统的句柄数限制, 最多也只能打开32000多个并发连接, 或许 OSX Server 版能支持更高的并发吧同时支持IPv4、IPv6零内存拷贝已通过测试WindowsOSXiOSAndroidLinux建议开发环境要发挥跨平台的完整功能请使用Delphi 10.2 Tokyo及以上的版本最低要求支持泛型和匿名函数的Delphi版本, 具体是从哪个版本开始支持泛型和匿名函数的我也不是太清楚

unit kbmMWCrossScoketServerTransport;{.$define httpsyslog}interfaceusesClasses, Sysutils,kbmMWCustomTransport,kbmMWServer,kbmMWGlobal, variants,kbmMWHTTPUtils,kbmMWExceptions,{$ifdef httpsyslog}kbmMWLog,{$endif}Net.CrossSocket,{$IFDEF __SSL__}Net.CrossSslSocket,{$IFDEF POSIX}Net.CrossSslDemoCert,{$ENDIF}{$ENDIF}Net.SocketAPI;typeTProtServer = class(TkbmMWServer);TxalionTransport=class(TkbmMWCustomServerTransport);Txalioninfo=class(TkbmMWServerTransportInfo);Txalionserver = classprivateFServer:Tkbmmwserver;FTransport: TkbmMWCustomServerTransport;    FSocket: {$IFDEF __SSL__}TCrossSslSocket{$ELSE}TCrossSocket{$ENDIF};procedure OnReceived(Sender: TObject; AConnection: ICrossConnection; ABuf: Pointer; ALen: Integer);
publicconstructor Create;destructor Destroy; override;end;TkbmMWCustomCrossScoketServerTransport = class(TkbmMWCustomServerTransport)private{ Private declarations }FCrossScoketServer: TxalionServer;Fhost:string;Fport:integer;// Fssl:boolean;Fversion:string;public// @excludeconstructor Create(AOwner:TComponent); override;// @excludedestructor Destroy; override;publicclass function IsSerializedTransport:boolean; override;class function IsConnectionlessTransport:boolean; override;procedure Listen; override;procedure Close; override;function IsListening:boolean; override;published{ 服务器 ip    例如   127.0.0.1}property Host:string read Fhost write Fhost;property Port:integer read Fport write Fport;Property Version:string read Fversion;end;{$IFDEF LEVEL16}[ComponentPlatformsAttribute({$IFDEF LEVEL26}pidLinux64 or{$ENDIF}{$IFDEF LEVEL23}pidiOSDevice64 or {$ENDIF}{$IFDEF LEVEL18}pidiOSSimulator or pidiOSDevice or {$ENDIF}{$IFDEF LEVEL19}pidAndroid or {$ENDIF}pidWin32 or pidWin64{$IFDEF LEVEL17} or pidOSX32{$ENDIF})]
{$ENDIF}TkbmMWCrossScoketServerTransport= class(TkbmMWCustomCrossScoketServerTransport)published{ Published declarations }property Crypt;property Compression;property StreamFormat;property VerifyTransfer;property TransportStateOptions;property FormatSettings;property Plugin;property Params;property StringConversion;property NodeID;property ClusterID;end;{$I CrossSocketversion.inc}{$ifdef httpsyslog}varfilelogmgr:TkbmMWLocalFileLogManager;{$endif}

implementationfunction kbmMWCrossScoketPutVerificationHeader(Size:integer):Tbytes;
vars:string;c:byte;i:integer;
constEOL=#10#13;
begins:=format('KBMMW X%0.8x ',[Size]); // 16 bytes.c:=0;for i:=KBMMW_STRINGCHAROFS to 16-KBMMW_STRINGCHARLENOFS doc:=c xor ord(s[i]);s:=s+format('X%0.2x'+EOL,[c]);    // 1+2+CR+LF = 5 bytes.
        setlength(result,length(s));for i := 1 to length(s) doresult[i-1]:=ord(s[i]);end;function kbmMWCrossScoketGetVerificationHeader(buff:pointer;len:integer):integer;
vars,s1:string;c,c1:byte;i:integer;pb:pbyte;
constSINVDATA = 'Invalid data';
beginResult:=0;                             // Satisfy compiler.c1:=0;s:='';trypb:=buff;for I := 0 to 20 dos:=s+chr((pb+i)^);// Extract checksum.trys1:=copy(s,17,3);c1:=strtoint(s1);exceptkbmMWRaiseException(KBMMW_ERR_TRANSPORT_INVALIDDATA,SINVDATA);end;// Calculate checksum.c:=0;for i:=KBMMW_STRINGCHAROFS to 16-KBMMW_STRINGCHARLENOFS doc:=c xor ord(s[i]);// Match?if c<>c1 thenexit;//kbmMWRaiseException(KBMMW_ERR_TRANSPORT_INVALIDDATA,SINVDATA);// Extract size.s1:=copy(s,7,9);tryResult:=strtoint(s1);exceptexit;// kbmMWRaiseException(KBMMW_ERR_TRANSPORT_INVALIDDATA,SINVDATA);end;exceptkbmMWDebugDumpMemory(mwdlAdvanced,mwdtTransport,kbmMWDebugWhere,'Exception during iocp verification',PByte(s),ByteLength(s));raise;end;
end;constructor Txalionserver.Create;
begininherited;FSocket :={$IFDEF __SSL__}TCrossSslSocket{$ELSE}TCrossSocket{$ENDIF}.Create(0);//FSocket.OnConnected := OnConnected;FSocket.OnReceived := OnReceived;
end;destructor Txalionserver.Destroy;
beginFSocket.Free;inherited;
end;procedure Txalionserver.OnReceived(Sender: TObject; AConnection: ICrossConnection; ABuf: Pointer; ALen: Integer);varheadlen:integer;// 校验为 21 ，不校验为4
retl,i, j,inlen:integer;cStreamClass:TkbmMWCustomTransportStreamClass;OutStream:IkbmMWCustomResponseTransportStream;InStream:IkbmMWCustomRequestTransportStream;stamp:int64;AInfo:ikbmMWServerTransportInfo;//IkbmMWCustomTransportInfo;
   indata:pbyte;retdata:Tbytes;sr,query,spath,s:String;vt:word;bsize:tbytes;rethead:Tbytes;inStreamFormat:string;
begininStreamFormat:=TxalionTransport(FTransport).StreamFormat;if   (inStreamFormat<>'STANDARD')  thenbeginraise Exception.Create('Only support STANDARD StreamFormat.');end;//           beginif TxalionTransport(FTransport).VerifyTransfer thenbeginheadlen:=21;if kbmMWCrossScoketGetVerificationHeader(abuf,alen)<>(alen-headlen) then  //21为校验的头beginAConnection.SendBytes(Tencoding.UTF8.GetBytes('Invalid data'));exit;end;endelsebeginheadlen:=4;end;stamp:=TkbmMWTiming.GetTimeUS;aInfo:=TkbmMWServerTransportInfo.Create;cStreamClass:=TxalionTransport(FTransport).FControllerClass.CheckGetStreamClass(mwmtResponse);OutStream:=TkbmMWCustomResponseTransportStream(cStreamClass.Create(FTransport,AInfo));cStreamClass:=TxalionTransport(FTransport).FControllerClass.CheckGetStreamClass(mwmtRequest);InStream:=TkbmMWCustomRequestTransportStream(cStreamClass.Create(FTransport,AInfo));InStream.RemoteLocation:=AConnection.PeerAddr;// Client.PeerIP;
inlen:=alen-headlen;tryif inlen>0 thenbeginInStream.DataStream.Clear;InStream.DataStream.SetSize( inlen);indata:=pbyte(abuf);inc(indata,headlen);move(indata^,InStream.DataStream.Memory^,inlen);end;TProtServer(FServer).InternalServeStream(FTransport,InStream,OutStream);TProtServer(FServer).UpdateGlobalStats(InStream,OutStream,stamp);// Send response back.
retl:=OutStream.DataStream.Size;if TxalionTransport(FTransport).VerifyTransfer thenbeginrethead:=kbmMWCrossScoketPutVerificationHeader(retl);AConnection.SendBytes(rethead);//  client.Send(rethead[0],headlen);endelsebeginSetLength(bSize,4);bSize[3]:=(retl shr (8+8+8)) and 255;bSize[2]:=(retl shr (8+8)) and 255;bSize[1]:=(retl shr (8)) and 255;bSize[0]:=retl and 255;AConnection.SendBytes(bsize);//client.Send(bsize[0],4);end;setlength(retdata,retl);move(OutStream.DataStream.Memory^,retdata[0],retl);AConnection.SendBytes(retdata);excepton E: Exception dobegin{$ifdef httpsyslog}Log.Warn('Find error.'+e.Message );log.Warn('info:'+TkbmMWPlatformMarshal.memory2String(indata,inlen));{$endif}AConnection.SendBytes(Tencoding.UTF8.GetBytes(e.Message));//    client.Send(e.Message);end;end;end;
{ TkbmMWCustomhttpsysServerTransport }procedure TkbmMWCustomCrossScoketServerTransport.Close;
beginif state=mwtrstDisconnected then   exit;FCrossScoketServer.FSocket.DisconnectAll;//      Fiocpserver.fiocpServer.Stop;
      SetState(mwtrstDisconnected);
end;constructor TkbmMWCustomCrossScoketServerTransport.Create(AOwner: TComponent);
begininherited;FCrossScoketServer:= TxalionServer.Create;Fhost:='0.0.0.0';Fport:=3000;self.VerifyTransfer:=True;fversion:=sysversion;end;destructor TkbmMWCustomCrossScoketServerTransport.Destroy;
beginif FCrossScoketServer<>nil thenfreeandnil(FCrossScoketServer);inherited;
end;class function TkbmMWCustomCrossScoketServerTransport.IsConnectionlessTransport: boolean;
beginResult:=False;
end;function TkbmMWCustomCrossScoketServerTransport.IsListening: boolean;
beginResult:=(state=mwtrstListening);
end;class function TkbmMWCustomCrossScoketServerTransport.IsSerializedTransport: boolean;
beginResult:=true;
end;procedure TkbmMWCustomCrossScoketServerTransport.Listen;begininherited;if state=mwtrstListening then   exit;FCrossScoketserver.FServer:=server;FCrossScoketserver.FTransport:=self;FCrossScoketserver.FSocket.Listen(Fhost,Fport);SetState(mwtrstListening);end;{$ifdef httpsyslog}
initializationfilelogmgr:=TkbmMWLocalFileLogManager.Create('./kbmmwlog.txt'); // ，一个是日志文件filelogmgr.FileOptions:=[mwlfoDeleteOldLog];//:=true; // 删除老的日志文件filelogmgr.FlushInterval:=0; // 写文件时间间隔，0 为立即写文件Log.LogManager:=filelogmgr; //
     log.Info('Start logging!');{$endif}