⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 socketprotocol.pas

📁 delphi实现的一个完全自动运行的数据库存取的软件保留30天日志记录
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    if Index > RecvDataLength - 1 then
      Result:= FSPCRecvBuf[FSPCRecvFront]
    else
      Result:= FSPCRecvBuf[(Index + FSPCRecvFront) mod SizeOf(FSPCRecvBuf)];
end;

procedure TSocketProtocolClient.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 TSocketProtocolClient.Pack2OtherClient(PackCmd: Byte; Src, Dst: string; PackData: T2048BytesBuf; 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 TSocketProtocolClient.PackSendBuf(PackSendData: T512BytesBuf; PackSendDataLen: integer): integer;
begin
    if (FSPCCS.Active) then
    begin
      Result:= FSPCCS.Socket.SendBuf(PackSendData, PackSendDataLen);
    end
    else
    begin
      Result:= (-1);
      if Assigned(FSPCOnLogLv0) then
        FSPCOnLogLv0(Format('Socket连接处于关闭状态,无法发送Socket数据', []), $05);
    end;
end;

procedure TSocketProtocolClient.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('已连接到服务器,〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolClient.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('正在连接服务器,〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolClient.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    if Assigned(FSPCOnLogLv2) then
      FSPCOnLogLv2(Format('从服务器断开,〖&Addr: %s, &Port: %d〗。', [FSPCServerAddr, FSPCServerPort]), $00);
end;

procedure TSocketProtocolClient.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('与服务器连接错误,〖&Addr: %s, &Port: %d, &EType: %s〗。', [FSPCServerAddr, FSPCServerPort, LvErrorType]), $03);
end;

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

procedure TSocketProtocolClient.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
    LvSocketRecvBuffer: array [0..4095] of Byte;  //临时的接收缓冲区
    LvSocketRecvLen: integer;                     //接收到的大小
    LvSocketCmd: Byte;                            //命令字节(单字节)
    LvSocketLenHi: Byte;                          //长度字节高8位
    LvSocketLenLo: Byte;                          //长度字节低8位
    LvSocketLen: Word;                            //长度字节(双字节)
    LvSocketCmdLv2: Byte;                         //二层协议命令字(单字节)
    LvPackCnt: integer;                           //计算得到的包数
    LvPackDataLen: integer;                       //计算得到的包长度
    LvRecvdPackCnt: integer;                      //接收到的包数
    LvRecvdPackNO: integer;                       //接收到的包号
    LvRecvClientName: string;                     //接收到的客户端名称(从数据网关)
    LvRecvSrc: string;                            //接收到的源地址名称 (从客户端)
    LvRecvDst: string;                            //接收到的目的地址名称 (从客户端)
    i: integer;
begin
    //将读上来的数据放到接收缓冲区存储
    LvSocketRecvLen:= Socket.ReceiveLength;
    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
      //记录一下信息
      if Assigned(FSPCOnLogLv3) then FSPCOnLogLv3(Format('BufSize: %d', [RecvDataLength]), $00);
      //
      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); //源地址目的地址
          case LvSocketCmdLv2 of
            CstSPCmdLv1_R_CFrame:
            begin
              LvRecvdPackCnt:= GetAt(4 + 40 + 1);
              LvRecvdPackNO:= GetAt(4 + 40 + 2);              
              LvPackCnt:= (FSPCPackDataLen div 400) + integer((FSPCPackDataLen mod 400 <> 0) or (FSPCPackDataLen = 0));

              if (LvPackCnt = LvRecvdPackCnt) and (LvRecvdPackNO < LvRecvdPackCnt - 1) then
              begin
                LvPackDataLen:= integer((FSPCPackDataLen - 400 * (LvRecvdPackNO + 1)) > 400) * 400 +
                  integer((FSPCPackDataLen - 400 * (LvRecvdPackNO + 1)) <= 400) * (FSPCPackDataLen - 400 * (LvRecvdPackNO + 1));
                  
                //初始化数据发送缓冲区中数据长度
                FSPCSendBufLen:= 0;
                //协议Lv01数据帧头字节
                FSPCSendBuf[FSPCSendBufLen]:= $AA;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv01数据帧命令字节
                FSPCSendBuf[FSPCSendBufLen]:= CstSPCmdLv0_SR_ClientData;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv01数据帧长度字节,加44的原因是加上源地址和目的
                //地址的长度和二层协议的命令字,总包数,当前包号,校验字节长度
                FSPCSendBuf[FSPCSendBufLen]:= LvPackDataLen + 44;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv02数据帧源地址
                for i:= 1 to 20 do
                begin
                  if (i <= Length(LvRecvDst)) then
                  begin
                    FSPCSendBuf[FSPCSendBufLen]:= Ord(LvRecvDst[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(LvRecvSrc)) then
                  begin
                    FSPCSendBuf[FSPCSendBufLen]:= Ord(LvRecvSrc[i]);
                    FSPCSendBufLen:= FSPCSendBufLen + 1;
                  end
                  else
                  begin
                    FSPCSendBuf[FSPCSendBufLen]:= $20;
                    FSPCSendBufLen:= FSPCSendBufLen + 1;
                  end;
                end;
                //协议Lv02数据帧二层命令字字节
                FSPCSendBuf[FSPCSendBufLen]:= integer(LvRecvdPackCnt - 1 - LvRecvdPackNO > 1) * CstSPCmdLv1_S_CFrame +
                  integer(LvRecvdPackCnt - 1 - LvRecvdPackNO <= 1) * CstSPCmdLv1_S_FFrame;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv02数据帧总包数字节
                FSPCSendBuf[FSPCSendBufLen]:= LvPackCnt;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv02数据帧当前包数字节
                FSPCSendBuf[FSPCSendBufLen]:= LvRecvdPackNO + 1;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv02数据帧数据字节
                for i:= 0 to LvPackDataLen - 1 do
                begin
                  FSPCSendBuf[FSPCSendBufLen]:= FSPCPackData[i + 400 * (LvRecvdPackNO + 1)];
                  FSPCSendBufLen:= FSPCSendBufLen + 1;
                end;
                //协议Lv02数据帧校验字节(现在保留)
                FSPCSendBuf[FSPCSendBufLen]:= $00;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
                //协议Lv01数据帧尾字节
                FSPCSendBuf[FSPCSendBufLen]:= $55;
                FSPCSendBufLen:= FSPCSendBufLen + 1;
              end
              else
              begin
                if Assigned(FSPCOnLogLv0) then
                  FSPCOnLogLv0(Format('数据包总数与包号错误〖Cnt: %.2d, NO.: %.2d〗', [LvRecvdPackCnt, LvRecvdPackNO]), $08);
              end;
            end;
            CstSPCmdLv1_R_FFrame:
            begin
              FSPCSendBusy:= FALSE;
              if Assigned(FSPCRspOnTransData) then FSPCRspOnTransData(Self, GetAt(4 + 40 + 3));
            end;
            else
            begin
              if Assigned(FSPCOnLogLv0) then
                FSPCOnLogLv0(Format('未定义的Socket命令字〖Lv: %d, Cmd: %.2d〗。', [$02, LvSocketCMD]), $07);
            end;
          end;
        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('未定义的Socket命令字〖Lv: %d, Cmd: %.2d〗。', [$01, LvSocketCMD]), $06);
        end;
      end;
      //将处理过的一帧数据出队列
      DeRecvBuf(LvSocketLen + 5);
    end;
end;

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

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -