uditcpechosocketserver.pas

楠楠写的DBiocp例子都是源码

unit uDITcpEchoSocketServer;

interface

uses
  Windows, Sysutils, uDIBuffer, uIOCompletionPort, uDIClientContext, uDIIocpTcpServer;
  {$I IOCP.inc}
  
type

  TDITcpEchoSocketServer = class(TDIIocpTcpServer)
  private
    procedure NewSocketEvent(FClientContext: TDIClientContext);
    procedure CloseSocketEvent(FClientContext: TDIClientContext);
    procedure RecvCompletedEvent( FClientContext: TDIClientContext;
                                  FDIBuffer: TDIBuffer;
                                  dwIoSize: DWORD );
    procedure SendCompletedEvent( FClientContext: TDIClientContext;
                                  FDIBuffer: TDIBuffer;
                                  dwIoSize: DWORD );
    procedure EchoMesage(FClientContext: TDIClientContext; FDIBuffer: TDIBuffer);
  published
    procedure AppendDisplayMsg(sMsg: String); override;
    procedure AppendLogMessage(sMsg: String); override;
    procedure AppendErrorLogMessage(sMsg: String); override;
    procedure SendMsgToAll;
  public
    constructor Create(IOCompletionPort: TIOCompletionPort);
  end;
  
implementation
  uses uDIMonitor, uFileLogger;

constructor TDITcpEchoSocketServer.Create(IOCompletionPort: TIOCompletionPort);
begin
  inherited Create(IOCompletionPort);
  OnNewSocketEvent := NewSocketEvent;
  OnCloseSocketEvent := CloseSocketEvent;
  OnRecvCompletedEvent := RecvCompletedEvent;
  OnSendCompletedEvent := SendCompletedEvent;
end;

procedure TDITcpEchoSocketServer.AppendDisplayMsg(sMsg: String);
begin

end;

procedure TDITcpEchoSocketServer.AppendLogMessage(sMsg: String);
begin
  _FileLogger.WriteLogMsg(sMsg);
end;

procedure TDITcpEchoSocketServer.AppendErrorLogMessage(sMsg: String);
begin
  _FileLogger.WriteLogMsg(sMsg);
end;

procedure TDITcpEchoSocketServer.NewSocketEvent(FClientContext: TDIClientContext);
begin
  {$IFDEF _ICOP_DEBUG}
      AppendLogMessage('新客户端连接, IP地址：'+FClientContext.FRemoteIP+
                       ' Socket ID: '+ IntToStr(FClientContext.m_KeyID)+
                       ' m_iNumberOfActiveConnections:'+IntToStr(m_iNumberOfActiveConnections));
  {$ENDIF}
end;

procedure TDITcpEchoSocketServer.CloseSocketEvent(FClientContext: TDIClientContext);
begin
  {
  AppendDisplayMsg('客户端关闭, IP地址：'+GetRemoteIPAddr(FClientContext.FRemoteAddr)+
                           ' Socket ID:'+ IntToStr(FClientContext.m_KeyID));  }
end;

procedure TDITcpEchoSocketServer.EchoMesage(FClientContext: TDIClientContext;  FDIBuffer: TDIBuffer);
begin
  FClientContext.FContextLock.Lock;
  FClientContext.SendBuffer.InitBuffer;
  CopyMemory( Pointer(FClientContext.SendBuffer.GetBuffer),
              Pointer(FDIBuffer.GetBuffer),
              FDIBuffer.GetUsed );
  FClientContext.SendBuffer.SetUsed(FDIBuffer.GetUsed);
  FClientContext.FContextLock.UnLock;

  PostWSASend(FClientContext);
end;

procedure TDITcpEchoSocketServer.RecvCompletedEvent( FClientContext: TDIClientContext;
                                                     FDIBuffer: TDIBuffer;
                                                     dwIoSize: DWORD );
begin
  {$IFDEF _IOCP_MONITOR}
      _DIMonitor.AddRecvByte(dwIoSize);
  {$ENDIF}
  EchoMesage(FClientContext, FDIBuffer);
  //投递下一个Buffer
  PostWSARecv(FClientContext);
end;

procedure TDITcpEchoSocketServer.SendCompletedEvent( FClientContext: TDIClientContext;
                                                     FDIBuffer: TDIBuffer;
                                                     dwIoSize: DWORD );
begin
  {$IFDEF _IOCP_MONITOR}
      _DIMonitor.AddSendByte(dwIoSize);
  {$ENDIF}

  if FDIBuffer.GetUsed = dwIoSize then begin
//    {$IFDEF _ICOP_DEBUG}
//        AppendLogMessage('SendCompletedEvent投递完成! Key : '+IntToStr(FClientContext.m_KeyID));
//    {$ENDIF}
  end
  else
  begin
    {$IFDEF _ICOP_DEBUG}
        AppendLogMessage('SendCompletedEvent尚未完成! Key : '+IntToStr(FClientContext.m_KeyID));
    {$ENDIF}
  end;
end;

procedure TDITcpEchoSocketServer.SendMsgToAll;
var
  m_pFreeClientContext: TDIClientContext;
  m_pNextClientContext: TDIClientContext;
begin
  FMapClientContextLock.Lock;

  //取单链表头
  m_pFreeClientContext := FMapClientContext.FClientContextList;
  m_pNextClientContext := nil;
    
  while (m_pFreeClientContext<> nil) do begin
    m_pNextClientContext := m_pFreeClientContext.m_pNext;

    m_pFreeClientContext.SendBuffer.InitBuffer;
    m_pFreeClientContext.SendBuffer.CreateTestPackage;

    PostWSASend(m_pFreeClientContext);
    m_pFreeClientContext := m_pNextClientContext;
  end;

  FMapClientContextLock.UnLock;

  {$IFDEF _ICOP_DEBUG}
      AppendLogMessage('SendMsgToAll完成');
  {$ENDIF}
end;


end.