uniprotocol_datatrans.pas

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

功能： 判断是否实现了特定协议类型以及协议版本的通信协议。
输入： ProtocolType: Integer;   协议类型，即发送者标识
       ProtocolVersion: Integer 协议版本
输出： boolean 是否实现协议
---------------------------------------------------------------------------}

class function TDataTransResponder.ProtocolImplemented(ProtocolType: Integer; ProtocolVersion: Integer; isCommander: Boolean): Boolean;
begin
  Result := (ProtocolType = cnDataTransferID) and (not isCommander);
end;

{--------------------------------------------------------------------------
class function TDataTransResponder.SaveUncompletedData
功能： 判断是否要保存通讯没有完全成功时接收到的数据
输入： 无
输出： boolean 是否保存
---------------------------------------------------------------------------}

class function TDataTransResponder.SaveUncompletedData: Boolean;
begin
  Result := False;
end;

{--------------------------------------------------------------------------
function TDataTransResponder.ProcessProtocol
功能： 处理当前通信状态，并生成新的命令
输入： var FCommState: Integer;  当前的通信状态
       SendResult: Integer;            上一次的发送结果
       Packet: string;                 上一次的数据
       Parameters: TStrings            通信参数
输出： THostCommand 存放新的命令
       var FCommState: Integer;  存放下一步的通信状态
---------------------------------------------------------------------------}

function TDataTransResponder.RespondCommand(var FCommState: Integer; Data: string; Parameters: TStrings; var LastCmdComment: string; var dwSleep: Cardinal): string;
var
  curCmdIndex, cmdPos, curFrameSize: Integer;
  curCmd, Tag: string;
  I: Integer;
begin
  FDataBuff := FDataBuff + Data;
  if Length(FDataBuff) > MAX_COMMAND_LEN then
    FDataBuff := Copy(FDataBuff, Length(FDataBuff) - MAX_COMMAND_LEN + 1, MAX_COMMAND_LEN);
  LastCmdComment := '';
  dwSleep := 0;
  Result := '';

  curCmdIndex := GetCompatibleCommand(FDataBuff, cmdArray, cmdPos);
  if curCmdIndex <> -1 then
  begin
    LastCmdComment := cmdArray[curCmdIndex].Comment;
    curCmd := Copy(FDataBuff, cmdPos, cmdArray[curCmdIndex].CommandLength);
    FDataBuff := '';
    case cmdArray[curCmdIndex].CommandCode of
      csHandShake:
        begin
          Result := csACK + Chr(cnDataTransferID shr 8) + Chr(cnDataTransferID and $FF) + #0 + #1;
          Result := Result + Chr(CRCofString(Result));
          FWaiting := False;
        end;
      csSendDataCount:
        begin
          // 对方在发送数据总量
          FInBuffSize := Char4BToInt(Copy(CurCmd, 18, 4));
          // 对方的特征值
          Tag := Copy(CurCmd, 2, 16);
          // 查看是否断点续传
          ResumeItem := -1;
          with ResponderUndoneList.LockList do
          try
            for i := 0 to Count - 1 do
            begin
              FUndoneBuff := Items[i];
              if (FUndoneBuff^.Tag = Tag) and (FInBuffSize = FUndoneBuff^.DataLen) then
              begin
                ResumeItem := i;
                Break;
              end;
            end;
          finally
            ResponderUndoneList.UnLockList;
          end;
          // 不是断点续传，则开辟新的缓冲区
          if ResumeItem = -1 then
          begin
            //注意！此处使用GetMem会导致内存使用增长，而且可能会发生异常
            //GetMem(FUndoneBuff, SizeOf(TUndoneBuff));
            New(FUndoneBuff);
            GetMem(FUnDoneBuff^.Data, (FInBuffSize + FRAME_SIZE - 1) div FRAME_SIZE * FRAME_SIZE);
            FUnDoneBuff^.Tag := Tag;
            FUnDoneBuff^.BrokenFrameNo := 0;
            FUnDoneBuff^.DataLen := FInBuffSize;
            FFrameNO := 0;
            with ResponderUndoneList.LockList do
            try
              ResumeItem := Add(FUndoneBuff);
            finally
              ResponderUndoneList.UnLockList;
            end;
          end;
          Result := csACK + #$FE + IntToChar4B(FUnDoneBuff^.BrokenFrameNo);
          Result := Result + Chr(CRCofString(Result));
          MessagePosted := False;
          FWaiting := False;
        end;
      csSendData:
        begin
          // 对方在发送数据
          FFrameNo := Char4BToInt(Copy(CurCmd, 2, 4));
          if FUndoneBuff <> nil then
          begin
            FUnDoneBuff^.BrokenFrameNo := FFrameNo;
            if FUnDoneBuff^.DataLen > 0 then
              FProcessRatio := MulDiv((FUnDoneBuff^.BrokenFrameNo + 1) * FRAME_SIZE, 100, FUnDoneBuff^.DataLen);
            if FProcessRatio > 100 then
              FProcessRatio := 100;

            if FUnDoneBuff^.BrokenFrameNo < ((FUnDoneBuff^.DataLen + FRAME_SIZE - 1) div FRAME_SIZE) then
            begin
              // 说明： FWaiting 为真时，表明数据已经接收完毕，正在等待处理。
              // 处理完毕后自动变为 False
              // Newcycling 为真时，表明此轮数据已经接收完毕，正在等待下一轮数据接收
              // 如果收到对方要求接收的命令时自动变为 False
              // FWaiting 为 False 的时长可能与 Newcycling 为 False 的时长不等
              // 只有两者均为 False 时才可处理数据
              // 如果此期间再收到其他数据，属于无效数据，并不保存，只是发送回应，表明收到
              if (not FWaiting) and (not NewCycling) then
              begin
                // 当接收到最后一帧时，有效数据块可能并不是整个帧大小，此时只取有用部分
                curFrameSize := FUnDoneBuff^.DataLen - FRAME_SIZE * FUnDoneBuff^.BrokenFrameNo;
                if curFrameSize > FRAME_SIZE then
                  curFrameSize := FRAME_SIZE;
                Move(curCmd[6], Pointer(DWord(FUnDoneBuff^.Data) + FUnDoneBuff^.BrokenFrameNo * FRAME_SIZE)^, curFrameSize);
              end;
            end;
          end;
          Result := csACK + #$FD + IntToChar4B(FFrameNo);
          Result := Result + Chr(CRCofString(Result));

          // 如果数据接收完毕
          //将通信标志置为等待，同时通知接收到数据
          //为防止数据包重复发送，设定NewCycling标志，
          //表明本次数据接收已经完毕，如果再接收到，属无效数据
          if (FFrameNo + 1) * FRAME_SIZE >= FInBuffSize then
            if not MessagePosted then
            begin
              //DataTag := UniCreateGUID;
              FWaiting := True;
              FInBuff := nil;
              FInBuffsize := 0;
              with ResponderUndoneList.LockList do
              try
                Delete(ResumeItem);
                if FUnDoneBuff <> nil then
                begin
                  FInBuff := FUnDoneBuff^.Data;
                  FInBuffsize := FUnDoneBuff^.DataLen;
                  Finalize(FUndoneBuff^);
                  FreeMem(FUndoneBuff);
                end;
              finally
                ResponderUndoneList.UnLockList;
                FUndoneBuff := nil;
              end;
              SafePostMessage(OwnerHwnd, WMT_DealData, 0, 0);
              MessagePosted := True;
            end;
        end;
      csGetTargetDataCount:
        begin
          // 对方要求数据总量
          // 如果接收到这个命令，表明上一轮数据传输已经完毕
          if (not MessagePosted) and (FInBuffSize > 0) then
          begin
            FWaiting := True;
            MessagePosted := True;
            SafePostMessage(OwnerHwnd, WMT_DealData, 0, 0);
          end;
          if (not FWaiting) then
          begin
            if Assigned(FInBuff) then FreeMem(FInBuff);
            FInBuff := nil;
            FInBuffSize := 0;
          end;
          if FWaiting then
          begin
            dwSleep := 500;
            Result := csACK + #$FC + 'WAIT';
            Result := Result + Chr(CRCofString(Result));
          end
          else if FOutBuffEnabled then
          begin
            // 如果输出缓冲区没有激活，则报告实际数据总量
            Result := csACK + #$FC + DataTag + IntToChar4B(FOutBuffSize);
            Result := Result + Chr(CRCofString(Result));
          end
          else
          begin
            // 如果输出缓冲区没有激活，则报告数据总量为0
            Result := csACK + #$FC + DataTag + #0#0#0#0;
            Result := Result + Chr(CRCofString(Result));
          end;
        end;
      csGetTargetData:
        begin
          // 对方要求数据
          FFrameNo := Char4BToInt(Copy(curCmd, 2, 4));
          if FOutBuffSize > 0 then
            FProcessRatio := MulDiv((FFrameNo + 1) * FRAME_SIZE, 100, FOutBuffSize);
          if FProcessRatio > 100 then
            FProcessRatio := 100;
          if FFrameNo * FRAME_SIZE < FOutBuffSize then
          begin
            //⊙ csACK  + 2B(帧号) + 64B(数据) + CRC
            Result := csACK + #$FB + IntToChar4B(FFrameNo);
            SetLength(Result, 8 + FRAME_SIZE);
            FillChar(Result[8], FRAME_SIZE, 0);
            // 当接收到最后一帧时，有效数据块可能并不是整个帧大小，此时只取有用部分
            curFrameSize := FOutBuffSize - FRAME_SIZE * FFrameNo;
            if curFrameSize > FRAME_SIZE then
              curFrameSize := FRAME_SIZE;
            Move(Pointer(DWord(FOutBuff) + FFrameNo * FRAME_SIZE)^, Result[8], curFrameSize);
            Result[8 + FRAME_SIZE] := Chr(GenerateCRC(Result[1], 7 + FRAME_SIZE));
          end;
        end;
      csDealData:
        begin
          Result := csACK + #$F0 + 'WAIT';
          Result := Result + Chr(CRCofString(Result));
        end;
      csNotifyHangup:
        begin
          Result := csACK + #$F8;
          Result := Result + Chr(CRCofString(Result));
          Inc(HangupSign);
          // cheer 2001.8.29
          if HangupSign >= 2 then
          begin
            FCommSuccess := True;
            FCommState := csHalt;
          end;
        end;
    end;
  end;
end;

procedure FreeUndoneList;
var
  i: Integer;
  UndoneBuff: PUndoneBuff;
begin
  with CommanderUnDoneList.LockList do
  try
    for i := 0 to Count - 1 do
    begin
      UndoneBuff := Items[i];
      Finalize(UndoneBuff^);
      FreeMem(UndoneBuff);
    end;
  finally
    CommanderUnDoneList.UnlockList;
  end;
  CommanderUnDoneList.Free;

  with ResponderUnDoneList.LockList do
  try
    for i := 0 to Count - 1 do
    begin
      UndoneBuff := Items[i];
      Finalize(UndoneBuff^);
      FreeMem(UndoneBuff);
    end;
  finally
    ResponderUnDoneList.UnlockList;
  end;
  ResponderUnDoneList.Free;
end;

{-----------------------------------------------------------------------------}

initialization
  // 注册协议处理插件
  RegisterExecutorClass(TDataTransCommander);
  RegisterExecutorClass(TDataTransResponder);
  CommanderUnDoneList := TThreadList.Create;
  ResponderUnDoneList := TThreadList.Create;

finalization
  FreeUndoneList;
end.