Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

版权申明
查看: 4983|回复: 0

完成端口-Delphi应用(2)

[复制链接]

该用户从未签到

发表于 2010-3-13 07:27:22 | 显示全部楼层 |阅读模式
  {线程池报警通信TCP服务器侦听线程,负责接收报警终端的tcp}
  TAlarmTCPServer = class(TThread)
    private
      FAlarmPort            : Integer;                             //报警控制侦听端口
      FAlarmCompletePort    : THandle;                             //报警控制部分的完成端口
      FThreadPool           : TThreadPool;                         //线程池指针
      FAlarmSocketLists     : TThreadList;                         //报警控制Socket数据对象列表
      FServerSocket         : TSocket;                             //报警控制侦听Socket
      FTimeOutCounter       : TTimeOutCounter;                     //心跳计数线程
      function PrepareRecv(PHandelDataPPerHandelData;Block: PBlock = nil): Boolean;
    public
      procedure Close();                                           //安全关闭释放线程
      constructor Create(AParent:TThreadPool;CompletePort:THandle;AlarmPort:Integer;ASubDataLs:TThreadList;ATimeOutCounter:TTimeOutCounter);
      procedure Execute;override;
      destructor Destroy;override;
  end;

 

procedure TAlarmTCPServer.Close;
begin
  Self.Terminate;
  shutdown(FServerSocket,FD_CLOSE);
  closesocket(FServerSocket);
  WSACleanup();
end;

constructor TAlarmTCPServer.Create(AParent: TThreadPool;CompletePort:THandle;AlarmPort:Integer;ASubDataLs: TThreadList;ATimeOutCounter:TTimeOutCounter);
var
  wsaData: TWSADATA ;
  Ret:Integer;
begin
  FreeOnTerminate       := True;
  FTimeOutCounter       := ATimeOutCounter;
  FThreadPool           := AParent;
  FAlarmCompletePort    := CompletePort;
  FAlarmPort            := AlarmPort;
  FAlarmSocketLists     := ASubDataLs;
    //初始化侦听网络
  Ret := WSAStartup($0202, wsaData);
  if Ret <> 0 then
  begin
    FThreadPool.PShowRealMsg(0,'报警TCP服务','初始化网络失败!');
    Self.Terminate;
    Exit;
  end;
  inherited Create(False);
end;

destructor TAlarmTCPServer.Destroy;
begin
  inherited;
end;

procedure TAlarmTCPServer.Execute;
var
    Ret:Integer;
    InternetAddr: SOCKADDR_IN;
    Accept:TSocket;
    PHandleDataPPerHandelData;
    Flags,RecvBytesWORD;
    TimeOutObject : TCounterObject;
    nRecvBuf,nSendBuf:integer;
    Block : pBlock;
    i:Integer;
begin
  //创建TCPServer的侦听Socket
  FServerSocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, WSA_FLAG_OVERLAPPED);
  if (FServerSocket = INVALID_SOCKET) then
  begin
    FThreadPool.PShowRealMsg(0,'报警TCP服务','报警TCPSocket创建失败!');
    Self.Terminate;
    exit;
  end;
  //绑定侦听地址和端口
  InternetAddr.sin_family := AF_INET;
  InternetAddr.sin_addr.s_addr := htonl(INADDR_ANY);
  InternetAddr.sin_port := htons(FAlarmPort);
  if (bind(FServerSocket, InternetAddr, sizeof(InternetAddr)) = SOCKET_ERROR) then
  begin
    FThreadPool.PShowRealMsg(0,'报警TCP服务','报警TCP绑定地址和侦听端口失败!');
    Self.Terminate;
    exit;
  end;
  //启动服务Socket的侦听
  if (listen(FServerSocket, 5) = SOCKET_ERROR) then
  begin
    FThreadPool.PShowRealMsg(0,'报警TCP服务','报警TCP服务器侦听启动失败!');
    Self.Terminate;
    exit;
  end;
  FThreadPool.PShowRealMsg(0,'报警TCP服务','报警TCP服务器侦听线程启动成功!');
 
  //接收客户Socket接入,并放入队列
  while( not Self.Terminated ) DO
  begin
     //侦听报警控制端口,接收新客户端Socket的接入
     try
        Accept := WSAAccept(FServerSocket, nil, nil, nil, 0);
     except
     end;
           
     if (Accept = SOCKET_ERROR) then
     begin
        FThreadPool.PShowRealMsg(0,'报警TCP服务','客户端Socket连接失败!');
        Continue;
     end else begin
        FThreadPool.PShowRealMsg(0,'报警TCP服务','客户端【Socket='+ IntToStr(Accept) +'】接入成功,等待验证!');
     end;

     //创建接入的Socket对应结构体,并与完成端口关联
     PHandleData := LPPerHandelData(GlobalAlloc(GPTR, sizeof(PerHandelData)));
     if (PHandleData = nil) then
     begin
       shutdown(Accept,FD_CLOSE);
       closesocket(Accept);
       Continue;
     end;
   
     //与完成端口关联
     PHandleData.Socket := Accept;
     if (CreateIoCompletionPort(Accept, FAlarmCompletePort, DWORD(PHandleData), 0) = 0) then
     begin
        shutdown(Accept,FD_CLOSE);
        closesocket(Accept);
        GlobalFree(DWORD(PHandleData));
        Continue;
     end;

     PHandleData.PItemPt := nil;
     PHandleData.PSrcType := CST_LOGINTYPE_SE;       //前端设备登录
     PHandleData.Socket := Accept;
     PHandleData.PSrcName:='NONAMES';
     for i:= 0  to 9 do PHandleData.PDstAddrs:='';
     for i:= 0  to 9 do PHandleData.PRoutors[0] := 0;
     PHandleData.OperType := APP_OPERTYPE_RECV;
     PHandleData.PSrcSectionID := 1;
     PHandleData.MemoryBuffer := TMemoryBuffer.Create;
     PHandleData.RingBuffer   := TRingBuffer.Create(4096 * 10);
     FAlarmSocketLists.Add(PHandleData); //保存该Socket对象数据到线程安全列表
     TimeOutObject               := TCounterObject.Create;
     TimeOutObject.PerHandelData := PHandleData;
     FTimeOutCounter.PAddClientOfCounter(TimeOutObject); //对该客户端增加心跳计数器
     Flags    := 0;
     nRecvBuf := 0;
     nSendBuf := 0;
     setsockopt(Accept,SOL_SOCKET,SO_RCVBUF,PChar(@nRecvBuf),sizeof(integer));
     setsockopt(Accept,SOL_SOCKET,SO_SNDBUF,PChar(@nSendBuf),sizeof(integer));

     //创建Socket数据对象与之关联
     Block := PHandleData.MemoryBuffer.AllocBlock;
     PrepareRecv(PHandleData,Block);
  end;
end;

function TAlarmTCPServer.PrepareRecv(PHandelDataPPerHandelData;  Block: PBlock): Boolean;
var
  ErrCode: Integer;
  Flags, Transfer: Cardinal;
begin
  if not Assigned(Block) then
   Block := PHandelData.MemoryBuffer.AllocBlock ;
  with Block^.Data do
  begin
    Flags := 0;
    OperType := APP_OPERTYPE_RECV;
    FillChar(Buffer, SizeOf(Buffer), 0);
    FillChar(Overlapped, SizeOf(Overlapped), 0);
    wsaBuffer.buf := @Buffer;
    wsaBuffer.len := DATABUF_MAXSIZE;
    Result := SOCKET_ERROR <> WSARecv(PHandelData.Socket, @wsaBuffer, 1, @Transfer, @Flags, @Overlapped, nil);
    if not Result then
    begin
      ErrCode := WSAGetLastError;
      Result := ErrCode = ERROR_IO_PENDING;
      if not Result then
      begin
        Block.Data.IsUse := False;
      end;
    end;
  end;
end;

评分

参与人数 1威望 +1 收起 理由
猫工 + 1 优秀文章

查看全部评分

回复

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2025-5-2 23:44 , Processed in 0.027698 second(s), 11 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表