uniprotocol_datatrans.pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

                  GetMem(FUnDoneBuff^.Data, (FInBuffSize + FRAME_SIZE - 1) div FRAME_SIZE * FRAME_SIZE);
                  FUnDoneBuff^.Tag := Tag;
                  FUnDoneBuff^.BrokenFrameNo := 0;
                  FUnDoneBuff^.DataLen := FInBuffSize;
                  FFrameNO := 0;
                except
                end;
                with CommanderUndoneList.LockList do
                try
                  ResumeItem := Add(FUndoneBuff);
                finally
                  CommanderUndoneList.UnLockList;
                end;
              end;
              if FInBuffSize > 0 then
              begin
                FCommState := csGetTargetData;
              end
              else
                FCommState := csPrepareDealData;
              FFrameNo := 0;
            end;
          srACK:
            begin
              // 对方要求等待其数据准备好
              FCommState := csGetTargetDataCount;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csGetTargetData:
      begin
        case SendResult of
          srGetData:
            begin
              curFrameSize := FInBuffSize - FUnDoneBuff^.BrokenFrameNo * FRAME_SIZE;
              if curFrameSize > FRAME_SIZE then curFrameSize := FRAME_SIZE;
              if curFrameSize > 0 then
                Move(Packet[8], Pointer(DWord(FUnDoneBuff^.Data) + FUnDoneBuff^.BrokenFrameNo * FRAME_SIZE)^, curFrameSize);
              Inc(FUnDoneBuff^.BrokenFrameNo);
              if FInBuffSize > 0 then
                FProcessRatio := MulDiv((FUnDoneBuff^.BrokenFrameNo + 1) * FRAME_SIZE, 100, FInBuffSize);
              if FProcessRatio > 100 then
                FProcessRatio := 100;
              if (FUnDoneBuff^.BrokenFrameNo * FRAME_SIZE >= FInBuffSize) then
                FCommState := csPrepareDealData;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csPrepareDealData:
      begin
        // 等待数据处理完毕，FWaiting变为False
        FWaiting := True;
        FFrameNo := 0;
        FCommState := csDealData;
        FInBuff := FUnDoneBuff^.Data;
        with CommanderUndoneList.LockList do
        try
          Delete(ResumeItem);
        finally
          CommanderUndoneList.UnLockList;
        end;
        Finalize(FUndoneBuff^);
        FreeMem(FUndoneBuff);
        FUnDoneBuff := nil;
        SafePostMessage(OwnerHwnd, WMT_DealData, 0, 0);
      end;
    csDealData:
      begin
        if SendResult <> srGetData then
          FCommState := csHalt;
        if not FWaiting then
        begin
          FFrameNo := 0;
          if Assigned(FInBuff) then
            FreeMem(FInBuff);
          FInBuff := nil;
          if FOutBuffEnabled then
            FCommState := csSendDataCount
          else
            FCommState := csNotifyHangup;
        end;
      end;
    csNotifyHangup:
      begin
        Inc(FFrameNo);
        if (FFrameNo = 1) then
        begin
          if (SendResult <> srACK) then
            FCommState := csHalt;
        end
        else
        begin
          FCommSuccess := True;
          FCommState := csHalt;
          //DataTag := UniCreateGUID;
        end;
      end;
  end;

  // 根据状态(FCommState) 生成命令
  if FCommState <> csHalt then
    with FHostCmd do
    begin
      case FCommState of
        csSendDataCount:
          begin
            //◆ 0xFE + 特征值(16B) + 数据总量(4B) + CRC
            // ⊙ csACK + 0xFE + CRC                 【ACK】
            Comment := '【发送数据总量】';
            Send_Interval := 1000;
            No_Response_Interval := 500;
            Max_Send_Times := 10;
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK + #$FE;
            Echos[0].Echo_Size := 8;
            Echos[0].Echo_HaveCRC := TRue;
            curACK := '';
            curNAK := '';
            Packet := '';
            Command := #$FE + DataTag + IntToChar4B(FOutBuffSize);
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
          end;
        csSendData:
          begin
            //◆ 0xFD + 2B(帧号) + 64B(数据) + CRC
            //⊙ csACK  + 0xFD + 2B(帧号) + CRC     【ACK】
            //⊙ csNAK  + 0xFD + 2B(帧号) + CRC     【NAK】
            Comment := '【发送数据】';
            Send_Interval := 1500;
            No_Response_Interval := 1500;
            Max_Send_Times := 20;
            SetLength(Echos, 0);
            curACK := csACK + #$FD + IntToChar4B(FFrameNO);
            curACK := curACK + Chr(GenerateCRC(curACK[1], Length(curACK)));
            curNAK := '';
            Packet := '';
            Command := #$FD + IntToChar4B(FFrameNO);
            SetLength(Command, FRAME_SIZE + 6);
            FillChar(Command[6], FRAME_SIZE, 0);
            curFrameSize := FOutBuffSize - FFrameNo * FRAME_SIZE;
            if curFrameSize > FRAME_SIZE then curFrameSize := FRAME_SIZE;
            if curFrameSize > 0 then
              Move(Pointer(DWord(FOutBuff) + FFrameNo * FRAME_SIZE)^, Command[6], curFRAMESIZE);
            Command[FRAME_SIZE + 6] := Chr(GenerateCRC(Command[1], FRAME_SIZE + 5));
          end;
        csGetTargetDataCount:
          begin
            //◆ 0xFC + 0x10 + 0x10 + CRC
            //⊙ csACK + 0xFC + 'WAIT'(4B) + CRC  【要求等待数据准备好】 【ACK】
            //⊙ csACK + 0xFC + 特征值(16B) + 数据总量(4B) + CRC
            //⊙ csNAK + 0xFC + CRC           【NAK】
            Comment := '【获得对方数据总量】';
            Send_Interval := 1000;
            No_Response_Interval := 1000;
            Max_Send_Times := 10;
            curACK := csACK + #$FC + 'WAIT';
            curACK := curACK + Chr(GenerateCRC(curACK[1], Length(curACK)));
            curNAK := '';
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK + #$FC;
            Echos[0].Echo_Size := 24;
            Echos[0].Echo_HaveCRC := True;
            Packet := '';
            Command := #$FC + #$10 + #$10;
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
          end;
        csGetTargetData:
          begin
            //◆ 0xFB + 2B(帧号) + CRC
            //⊙ csACK  + 2B(帧号) + 64B(数据) + CRC
            //⊙ csNAK + 0xFB + CRC           【NAK】
            Comment := '【接收数据】';
            Send_Interval := 1500;
            No_Response_Interval := 1500;
            Max_Send_Times := 20;
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK + #$FB + IntToChar4B(FUnDoneBuff^.BrokenFrameNo);
            Echos[0].Echo_Size := FRAME_SIZE + 8;
            Echos[0].Echo_HaveCRC := True;
            curACK := '';
            curNAK := '';
            Packet := '';
            Command := #$FB + IntToChar4B(FUnDoneBuff^.BrokenFrameNo);
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
          end;
        csPrepareDealData:
          begin
            Comment := '【等待数据处理】';
            Command := #$F0 + 'WAIT';
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
            curACK := '';
            curNAK := '';
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK + #$F0 + 'WAIT';
            Echos[0].Echo_Size := 8;
            Echos[0].Echo_HaveCRC := True;
          end;
        csDealData:
          begin
            Comment := '【等待数据处理】';
            Command := #$F0 + 'WAIT';
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
            // 只发送，不接收回应
            curACK := '';
            curNAK := '';
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK + #$F0 + 'WAIT';
            Echos[0].Echo_Size := 8;
            Echos[0].Echo_HaveCRC := True;
          end;
        csNotifyHangup:
          begin
            //◆ 0xF8 + 0x10 + CRC
            //⊙ csACK  + 0xF8 + CRC
            Comment := '【请求挂机】';
            Command := #$F8 + #$10;
            Command := Command + Chr(CrcOfString(Command));
            Send_Interval := 500;
            No_Response_Interval := 300;
            Max_Send_Times := 10;
            SetLength(Echos, 0);
            curACK := csACK + #$F8;
            curNAK := '';
          end;
      end;
    end;
  Result := FHostCmd;
end;

{-------------------  TDataTransResponder   -----------------------------}

constructor TDataTransResponder.Create(SenderID, ProtocolVersion: Integer; Hwnd: THandle);
begin
  inherited;
  DataTag := UniCreateGUID;
  ResumeItem := -1;

  HangupSign := 0;
  SetLength(cmdArray, 7);

  cmdArray[0].CommandCode := csHandShake;
  cmdArray[0].CommandHead := csHandShakeCommand;
  cmdArray[0].CommandLength := Length(csHandShakeCommand);
  cmdArray[0].HaveCRC := False;
  cmdArray[0].Comment := '握手';

  cmdArray[1].CommandCode := csSendDataCount;
  cmdArray[1].CommandHead := #$FE;
  cmdArray[1].CommandLength := 22;
  cmdArray[1].HaveCRC := True;
  cmdArray[1].Comment := '发送者数据总量';

  cmdArray[2].CommandCode := csSendData;
  cmdArray[2].CommandHead := #$FD;
  cmdArray[2].CommandLength := FRAME_SIZE + 6;
  cmdArray[2].HaveCRC := True;
  cmdArray[2].Comment := '发送者数据';

  cmdArray[3].CommandCode := csGetTargetDataCount;
  cmdArray[3].CommandHead := #$FC#$10#$10;
  cmdArray[3].CommandLength := 4;
  cmdArray[3].HaveCRC := True;
  cmdArray[3].Comment := '对方数据总量';

  cmdArray[4].CommandCode := csGetTargetData;
  cmdArray[4].CommandHead := #$FB;
  cmdArray[4].CommandLength := 6;
  cmdArray[4].HaveCRC := True;
  cmdArray[4].Comment := '对方数据';

  cmdArray[5].CommandCode := csDealData;
  cmdArray[5].CommandHead := #$F0 + 'WAIT';
  cmdArray[5].CommandLength := 6;
  cmdArray[5].HaveCRC := True;
  cmdArray[5].Comment := '对方要求等待';

  cmdArray[6].CommandCode := csNotifyHangup;
  cmdArray[6].CommandHead := #$F8#$10;
  cmdArray[6].CommandLength := 3;
  cmdArray[6].HaveCRC := True;
  cmdArray[6].Comment := '挂机';
end;

destructor TDataTransResponder.Destroy;
begin
  inherited;
end;

{--------------------------------------------------------------------------
class function TDataTransResponder.ProtocolImplemented