socketprotocolserver.~pas

delphi实现的一个完全自动运行的数据库存取的软件保留30天日志记录

      LvDeData:= '';
      {$endif}
      for i:= 0 to PopSize - 1 do
      begin
        {$ifdef SPCDebug}
        LvDeData:= Format('%s%.2x', [LvDeData, FSPCRecvBuf[FSPCRecvFront]]);
        {$endif}
        FSPCRecvBuf[FSPCRecvFront]:= $00;
        FSPCRecvFront:= (FSPCRecvFront + 1) mod SizeOf(FSPCRecvBuf);
      end;
      {$ifdef SPCDebug}
      if Assigned(FSPCOnLogLv1) then FSPCOnLogLv1(Format('DeBuf: %s', [LvDeData]), $00);
      {$endif}
      Result:= TRUE;
    end;
end;

function TSocketProtocolServer.RecvDataLength: integer;
begin
    Result:= (FSPCRecvRear - FSPCRecvFront + SizeOf(FSPCRecvBuf)) mod SizeOf(FSPCRecvBuf);
end;

function TSocketProtocolServer.LocatePacketHeadByte: Boolean;
var
    LvByteHead: Byte;
    LvByteLenHi: Byte;
    LvByteLenLo: Byte;
    LvBytesLen: Word;
    LvByteTail: Byte;
begin
    while (RecvDataLength > 0) do
    begin
      LvByteHead:= GetAt(0);
      if (LvByteHead = $AA) then
      begin
        LvByteLenLo:= GetAt(2);
        LvByteLenHi:= GetAt(3);
        LvBytesLen:= LvByteLenLo + ((LvByteLenHi shl 8) and $FF00);
        LvByteTail:= GetAt(LvBytesLen + 4);
        if (LvByteTail = $55) then
          Break
        else
        begin
          DeRecvBuf(1);
        end;
      end
      else
      begin
        DeRecvBuf(1);
      end;
    end;
    if RecvDataLength > 0 then
      Result:= TRUE
    else
      Result:= FALSE;
end;

function TSocketProtocolServer.GetAt(Index: integer): Byte;
begin
    if Index > RecvDataLength - 1 then
      Result:= FSPCRecvBuf[FSPCRecvFront]
    else
      Result:= FSPCRecvBuf[(Index + FSPCRecvFront) mod SizeOf(FSPCRecvBuf)];
end;

procedure TSocketProtocolServer.Pack2DataGate(PackCmd: Byte; PackData: T20BytesBuf; PackDataLen: integer);
var
    i: integer;
begin   
    //初始化数据发送缓冲区中数据长度
    FSPCSendBufLen:= 0;
    //协议Lv01数据帧头字节
    FSPCSendBuf[FSPCSendBufLen]:= $AA;
    FSPCSendBufLen:= FSPCSendBufLen + 1;
    //协议Lv01数据帧命令字节
    FSPCSendBuf[FSPCSendBufLen]:= PackCmd;
    FSPCSendBufLen:= FSPCSendBufLen + 1;
    //协议Lv01数据帧长度字节Lo
    FSPCSendBuf[FSPCSendBufLen]:= PackDataLen and $FF;
    FSPCSendBufLen:= FSPCSendBufLen + 1;
    //协议Lv01数据帧长度字节Hi
    FSPCSendBuf[FSPCSendBufLen]:= (PackDataLen shr 8) and $FF;
    FSPCSendBufLen:= FSPCSendBufLen + 1;
    //协议Lv01数据帧数据字节
    for i:= 0 to PackDataLen - 1 do
    begin
      FSPCSendBuf[FSPCSendBufLen]:= PackData[i];
      FSPCSendBufLen:= FSPCSendBufLen + 1;
    end;
    //协议Lv01数据帧尾字节
    FSPCSendBuf[FSPCSendBufLen]:= $55;
    FSPCSendBufLen:= FSPCSendBufLen + 1;
end;

procedure TSocketProtocolServer.Pack2OtherClient(PackCmd: Byte; Src, Dst: string; PackData: T4KBytesBuf; PackDataLen: integer);
var
    i: integer;
    LvPackCnt: integer;
    LvPackDataLen: integer;
begin
    //将按照二层协议打包后的协议数据保存到类存储区域中
    FSPCPackDataLen:= 0;
    for i:= 0 to PackDataLen - 1 do
    begin
      FSPCPackData[FSPCPackDataLen]:= PackData[i];
      FSPCPackDataLen:= FSPCPackDataLen + 1;
    end;
    //计算一共可以分为多少个协议数据包(每个数据包含400个字节)
    LvPackCnt:= (FSPCPackDataLen div 400) + integer((FSPCPackDataLen mod 400 <> 0) or (FSPCPackDataLen = 0));
    LvPackDataLen:= integer(FSPCPackDataLen > 400) * 400 + integer(FSPCPackDataLen <= 400) * FSPCPackDataLen;

    //组织发送数据帧
    begin
      //初始化数据发送缓冲区中数据长度
      FSPCSendBufLen:= 0;
      //协议Lv01数据帧头字节
      FSPCSendBuf[FSPCSendBufLen]:= $AA;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv01数据帧命令字节
      FSPCSendBuf[FSPCSendBufLen]:= PackCmd;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv01数据帧长度字节，加44的原因是加上源地址和目的
      //地址的长度和二层协议的命令字，总包数，当前包号，校验字节长度
      //Length Lo
      FSPCSendBuf[FSPCSendBufLen]:= (LvPackDataLen + 44) and $FF;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //Length Hi
      FSPCSendBuf[FSPCSendBufLen]:= ((LvPackDataLen + 44) shr 8) and $FF;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv02数据帧源地址
      for i:= 1 to 20 do
      begin
        if (i <= Length(Src)) then
        begin
          FSPCSendBuf[FSPCSendBufLen]:= Ord(Src[i]);
          FSPCSendBufLen:= FSPCSendBufLen + 1;
        end
        else
        begin
          FSPCSendBuf[FSPCSendBufLen]:= $20;
          FSPCSendBufLen:= FSPCSendBufLen + 1;
        end;
      end;
      //协议Lv02数据帧目的地址
      for i:= 1 to 20 do
      begin
        if (i <= Length(Dst)) then
        begin
          FSPCSendBuf[FSPCSendBufLen]:= Ord(Dst[i]);
          FSPCSendBufLen:= FSPCSendBufLen + 1;
        end
        else
        begin
          FSPCSendBuf[FSPCSendBufLen]:= $20;
          FSPCSendBufLen:= FSPCSendBufLen + 1;
        end;
      end;
      //协议Lv02数据帧二层命令字字节
      FSPCSendBuf[FSPCSendBufLen]:= integer(LvPackCnt <= 1) * CstSPCmdLv1_S_FFrame + integer(LvPackCnt > 1) * CstSPCmdLv1_S_CFrame;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv02数据帧总包数字节
      FSPCSendBuf[FSPCSendBufLen]:= LvPackCnt;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv02数据帧当前包数字节
      FSPCSendBuf[FSPCSendBufLen]:= $00;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv02数据帧数据字节
      for i:= 0 to LvPackDataLen - 1 do
      begin
        FSPCSendBuf[FSPCSendBufLen]:= FSPCPackData[i];
        FSPCSendBufLen:= FSPCSendBufLen + 1;
      end;
      //协议Lv02数据帧校验字节（现在保留）
      FSPCSendBuf[FSPCSendBufLen]:= $00;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
      //协议Lv01数据帧尾字节
      FSPCSendBuf[FSPCSendBufLen]:= $55;
      FSPCSendBufLen:= FSPCSendBufLen + 1;
    end;
end;

function TSocketProtocolServer.PackSendBuf(PackSendData: T512BytesBuf; PackSendDataLen: integer): integer;
begin
    Result:= 0;
    if Assigned(FSPCCS) then
    begin
      if FSPCCS.Active then
        Result:= FSPCCS.Socket.SendBuf(PackSendData, PackSendDataLen)
      else
      begin
        if Assigned(FSPCOnLogLv0) then FSPCOnLogLv0(Format('socket is closed on sending', []), $10);
      end;
    end
    else
    begin
      if Assigned(FSPCOnLogLv0) then FSPCOnLogLv0(Format('socket Object is nil on sending', []), $05);
    end;
end;

procedure TSocketProtocolServer.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('connect to server，〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolServer.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('connecting to server，〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolServer.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('disconnect from server，〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolServer.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
var
    LvErrorType: string;
begin
    //屏蔽错误报警
    ErrorCode:= 0;
    //获得错误类型
    case ErrorEvent of
      eeGeneral:
      begin
        LvErrorType:= 'eeGeneral';
      end;
      eeSend:
      begin
        LvErrorType:= 'eeSend';
      end;
      eeReceive:
      begin
        LvErrorType:= 'eeReceive';
      end;
      eeConnect:
      begin
        LvErrorType:= 'eeConnect';
      end;
      eeDisconnect:
      begin
        LvErrorType:= 'eeDisconnect';
      end;
      eeAccept:
      begin
        LvErrorType:= 'eeAccept';
      end;
    end; 

    if Assigned(FSPCOnLogLv0) then
      FSPCOnLogLv0(Format('connection troubles，〖&Addr: %s, &Port: %d, &EType: %s〗。', [FSPCServerAddr, FSPCServerPort, LvErrorType]), $03);
end;

procedure TSocketProtocolServer.ClientSocketLookup(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//
end;

procedure TSocketProtocolServer.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
    LvSocketRecvBuffer: T1KBytesBuf;  //临时的接收缓冲区
    LvSocketRecvLen: integer;         //接收到的大小
    LvSocketCmd: Byte;                //命令字节（单字节）
    LvSocketLenHi: Byte;              //长度字节高8位
    LvSocketLenLo: Byte;              //长度字节低8位
    LvSocketLen: Word;                //长度字节（双字节）
    LvSocketCmdLv2: Byte;             //二层协议命令字（单字节）
    LvRecvdPackCnt: integer;          //接收到的包数
    LvRecvdPackNO: integer;           //接收到的包号
    LvRecvClientName: string;         //接收到的客户端名称（从数据网关）
    LvRecvSrc: string;                //接收到的源地址名称 （从客户端）
    LvRecvDst: string;                //接收到的目的地址名称 （从客户端）
    i: integer;
begin
    //将读上来的数据放到接收缓冲区存储
    LvSocketRecvLen:= Socket.ReceiveLength;
    //接收到的数据长度
    {$ifdef SPCDebug}
    if Assigned(FSPCOnLogLv1) then FSPCOnLogLv1(Format('RecvLen: %d', [RecvDataLength]), $00);
    {$endif} 
    while (LvSocketRecvLen > SizeOf(LvSocketRecvBuffer)) do
    begin
      Socket.ReceiveBuf(LvSocketRecvBuffer, SizeOf(LvSocketRecvBuffer));
      EnRecvBuf(LvSocketRecvBuffer, SizeOf(LvSocketRecvBuffer));
      LvSocketRecvLen:= LvSocketRecvLen - SizeOf(LvSocketRecvBuffer);
    end;
    Socket.ReceiveBuf(LvSocketRecvBuffer, LvSocketRecvLen);
    EnRecvBuf(LvSocketRecvBuffer, LvSocketRecvLen);
    //
    while LocatePacketHeadByte do
    begin
      //
      LvSocketCmd:= GetAt(1);
      LvSocketLenLo:= GetAt(2);
      LvSocketLenHi:= GetAt(3);
      LvSocketLen:= LvSocketLenLo + ((LvSocketLenHi shl 8) and $FF00);

      case LvSocketCmd of
        CstSPCmdLv0_R_ClientLogin:
        begin
          //开始发送诊断在线命令
          if Assigned(FSPCRspOnLogin) then FSPCRspOnLogin(Self, Boolean(GetAt(4)));
        end;
        CstSPCmdLv0_SR_ClientData:
        begin
          //二层协议解析
          //接收到的源地址
          LvRecvSrc:= '';
          for i:= 0 to 19 do
          begin
            LvRecvSrc:= LvRecvSrc + Chr(GetAt(4 + i));
          end;
          LvRecvSrc:= Trim(LvRecvSrc);
          //接收到的目的地址
          LvRecvDst:= '';
          for i:= 0 to 19 do
          begin
            LvRecvDst:= LvRecvDst + Chr(GetAt(24 + i));
          end;
          LvRecvDst:= Trim(LvRecvDst);

          LvSocketCmdLv2:= GetAt(4 + 40); //源地址目的地址
          LvRecvdPackCnt:= GetAt(4 + 40 + 1);
          LvRecvdPackNO:= GetAt(4 + 40 + 2);
          LvSocketRecvLen:= 0;
          for i:= 0 to (LvSocketLen - 40 - 4) do
          begin
            LvSocketRecvBuffer[i]:= GetAt(4 + 40 + 3 + i);
            LvSocketRecvLen:= LvSocketRecvLen + 1;
          end;
          if Assigned(FSPCRspOnTransData) then
            FSPCRspOnTransData(Self, LvRecvSrc, LvRecvDst, LvSocketCmdLv2, LvRecvdPackCnt, LvRecvdPackNO, LvSocketRecvBuffer, LvSocketRecvLen - 1);
        end;
        CstSPCmdLv0_R_OthersOnLine:
        begin
          //其他客户端上线消息
          LvRecvClientName:= '';
          for i:= 0 to 19 do
          begin
            LvRecvClientName:= LvRecvClientName + Chr(GetAt(4 + i));
          end;
          if Assigned(FSPCRspOnOthersOnLine) then FSPCRspOnOthersOnLine(Self, Trim(LvRecvClientName));
        end;
        CstSPCmdLv0_R_OthersOffLine:
        begin
          //其他客户端离线消息
          LvRecvClientName:= '';
          for i:= 0 to 19 do
          begin
            LvRecvClientName:= LvRecvClientName + Chr(GetAt(4 + i));
          end;
          if Assigned(FSPCRspOnOthersOffLine) then FSPCRspOnOthersOffLine(Self, Trim(LvRecvClientName));
        end;
        else
        begin
          if Assigned(FSPCOnLogLv0) then
            FSPCOnLogLv0(Format('undefined socket cmd〖Lv: %d, Cmd: %.2d〗。', [$01, LvSocketCMD]), $06);
        end;
      end;
      //将处理过的一帧数据出队列
      DeRecvBuf(LvSocketLen + 5);
    end;
end;

procedure TSocketProtocolServer.ClientSocketWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//
end;

end.