unicommx.pas

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

procedure TCommThread.SetOutBuffSize(value: Cardinal);
begin
  FOutBuffSize := value;
  if Assigned(FCurrentProtocolExecutor) then
    FCurrentProtocolExecutor.OutBuffSize := value;
end;

function TCommThread.GetCurrentData: string;
begin
  Result := '';
  try
    if Assigned(FCurrentProtocolExecutor) then
      Result := FCurrentProtocolExecutor.Datas.Text;
  except
  end;
end;

{  生成握手命令 }
function TCommThread.HandShakeCommand: THostCommand;
begin
  with Result do
  begin
    Comment := '【握手】';
    // 注意：此处为CurrentTransferMode，CurrentTransferMode会随需要变动
    case FCurrentTransferMode of
      tmCommander:
        Command := csHandShakeCommand + 'Commander';
      tmResponder:
        Command := csHandShakeCommand + 'Responder';
    end;
    Send_Interval := 1000;
    No_Response_Interval := 1000;
    Max_Send_Times := 10;
    SetLength(Echos, 3);
    Echos[0].Echo_Head := #$A5#$A5;
    Echos[0].Echo_Size := 7;
    Echos[0].Echo_HaveCRC := True;
    Echos[1].Echo_Head := csHandShakeCommand + 'Commander';
    Echos[1].Echo_Size := Length(Echos[1].Echo_Head);
    Echos[1].Echo_HaveCRC := False;
    Echos[2].Echo_Head := csHandShakeCommand + 'Responder';
    Echos[2].Echo_Size := Length(Echos[2].Echo_Head);
    Echos[2].Echo_HaveCRC := False;
    curACK := '';
    curNAK := '';
  end;
end;

{
  握手流程
                          硬件握手
                             |
            发送握手命令+传送类型(Commander|Responder)
                             |
        ------------------------------------------
        |                                         |
     回应为数据                   -------------------------------------
即对方为固定Responder             |                                    |
        |                 回应为握手命令+Commander       回应为握手命令+Responder
传送类型设定为Commander      表明对方为Commander             表明对方为Responder
                                  |                                    |
                          如果自己为Responder:               如果自己为Commander:
                             生成ProtocolExecutor                继续发送握手命令
                             回应命令                        如果自己为Responder:
                          如果自己为Commander:                    如果自己为主动连接方，
                             如果自己为主动连接方，                   则将自己的本次传送类型
                                 则将自己的本次传送类型               变为Responder,
                                 变为Responder,                       生成ProtocolExecutor
                                 生成ProtocolExecutor                 回应命令
                                 回应命令                    如果自己为被动连接方，
                             如果自己为被动连接方，                继续发送握手命令
                                 继续发送握手命令

对于 Responder: 如果在20秒钟内没有收到任何命令或者'WAIT'信号，则认为断线

}
{
  数据传输协议
  Commander => 发送数据总量         <-------
            => 发送数据                     |
            * 发送缓冲区空，要求新数据      |
            => 接收对方数据总量             |
            => 接收对方数据         --------
            * 如果发送缓冲区空，则挂机
}

{ 生成协议处理者实例 }
procedure TCommThread.CreateProtocolExecutor;
var
  ProtocolExecutorClass: TCustomProtocolExecutorClass;
begin
  case FCurrentTransferMode of
    tmCommander:
      begin
        ProtocolExecutorClass := GetProtocolClass(FSenderID, FProtocolVersion, True);
        if ProtocolExecutorClass <> nil then
        try
          FCurrentProtocolExecutor := ProtocolExecutorClass.Create(FSenderID, FProtocolVersion, OwnerHwnd);
          FCurrentProtocolExecutor.isInitiative := FCommDevice.isInitiative;
          FCurrentProtocolExecutor.OutBuffSize := FOutBuffSize;
          FCurrentProtocolExecutor.OutBuff := FOutBuff;
          if (DataTag = '') or (Length(DataTag) <> 16) then DataTag := UniCreateGUID;
          FCurrentProtocolExecutor.DataTag := DataTag;

          FCurrentProtocolExecutor.FDatas.Add('SenderID=' + IntToStr(FSenderID));
          FCurrentProtocolExecutor.FDatas.Add('Time=' + FloatToStr(Now));
          // 是否主动拨出
          if FCurrentProtocolExecutor.isInitiative then
            FCurrentProtocolExecutor.FDatas.Add('isInitiative=ON')
          else
            FCurrentProtocolExecutor.FDatas.Add('isInitiative=OFF');
          if FCurrentTransferMode = tmCommander then
            FCurrentProtocolExecutor.FDatas.Add('CurrentTransferMode=Commander')
          else if FCurrentTransferMode = tmResponder then
            FCurrentProtocolExecutor.FDatas.Add('CurrentTransferMode=Responder');

          FHostCmd := FCurrentProtocolExecutor.ProcessProtocol(FCommState, FLastSendResult, FPacket, FParameters);
        except
          FCurrentProtocolExecutor := nil;
          FCommState := csHalt;
        end
        else
        begin
          Debug(FCommDevice.DeviceName, '找不到合适的Commander协议插件');
          FCommState := csHalt;
        end;
      end;
    tmResponder:
      begin
        ProtocolExecutorClass := GetProtocolClass(FDefaultProtocolType, FDefaultProtocolVersion, False);
        if ProtocolExecutorClass <> nil then
        try
          FCurrentProtocolExecutor := ProtocolExecutorClass.Create(FDefaultProtocolType, FDefaultProtocolVersion, OwnerHwnd);
          FCurrentProtocolExecutor.isInitiative := FCommDevice.isInitiative;
          FCurrentProtocolExecutor.OutBuffSize := FOutBuffSize;
          FCurrentProtocolExecutor.OutBuff := FOutBuff;
          if (DataTag = '') or (Length(DataTag) <> 16) then DataTag := UniCreateGUID;
          FCurrentProtocolExecutor.DataTag := DataTag;

          FCurrentProtocolExecutor.FDatas.Add('SenderID=' + IntToStr(FSenderID));
          FCurrentProtocolExecutor.FDatas.Add('Time=' + FloatToStr(Now));
          // 是否主动拨出
          if FCurrentProtocolExecutor.isInitiative then
            FCurrentProtocolExecutor.FDatas.Add('isInitiative=ON')
          else
            FCurrentProtocolExecutor.FDatas.Add('isInitiative=OFF');
          if FCurrentTransferMode = tmCommander then
            FCurrentProtocolExecutor.FDatas.Add('CurrentTransferMode=Commander')
          else if FCurrentTransferMode = tmResponder then
            FCurrentProtocolExecutor.FDatas.Add('CurrentTransferMode=Responder');

          FCommState := csResponseCommand;
        except
          FCurrentProtocolExecutor := nil;
          FCommState := csHalt;
        end
        else
        begin
          Debug(FCommDevice.DeviceName, '找不到合适的Responder协议插件');
          FCommState := csHalt;
        end;
      end;
  end;
end;

{ 处理通信事件  }
procedure TCommThread.Process_Communication_Event;
var
  LastCmdComment, RespondeData: string;
  dwSleep: Cardinal;
begin
  // 说明：在处理中如果发现通信状态不是预期值，则转为停止通信(csHalt)状态
  case FCommState of
    csInit:
      begin
        // 等待初始化。关闭设备后打开设备，转到等待初始化完毕状态
        if WaitFor_Any_Events([Event_Terminate], 10) = WAIT_OBJECT_0 then
          Exit;
        FCommDevice.CloseDevice;
        FCommDevice.OpenDevice;
        FCommState := csWaitForInit;
        FCurrentProtocolExecutor := nil;
      end;
    csWaitForInit:
      begin
        // 等待初始化完毕。一直等待知道初始化完毕，转到等待连接状态
        if WaitFor_Any_Events([Event_Terminate, FCommDevice.Event_InitState], INFINITE) <> WAIT_OBJECT_0 then
        begin
          SafePostMessage(OwnerHwnd, WMT_InitCompleted, 0, Integer(FCommDevice.InitSuccess));
          if FCommDevice.InitSuccess then
            FCommState := csWaitForConnect
          else
            FCommState := csHalt;
        end;
      end;
    csWaitForConnect:
      begin
        // 等待连接。一直等待直到连接成功，转为软件握手状态
        if WaitFor_Any_Events([Event_Terminate, FCommDevice.Event_ConnectState], INFINITE) <> WAIT_OBJECT_0 then
        begin
          SafePostMessage(OwnerHwnd, WMT_ConnectState, Integer(FCommDevice.Connected), Integer(FCommDevice.IsInitiative));
          if FCommDevice.Connected then
          begin
            FCurrentTransferMode := FDefaultTransferMode;
            FCommState := csHandShake;
          end
          else
            FCommState := csHalt;
        end;
      end;
    csHandShake:
      begin
        // 软件握手。如果成功，则根据发送者标识创建相应的协议处理实例
        FHostCmd := HandShakeCommand;
        FLastSendResult := SendCmd;
        case FLastSendResult of
          srGetData:
            begin
              if Copy(FPacket, 1, 2) = #$A5#$A5 then
              begin
                //如果握手结果为获得数据，则对方定是固定的Responder
                //此时不管自己为Commander或者Responder，都要设定为Commander模式
                FCurrentTransferMode := tmCommander;
                FSenderID := ord(FPacket[3]) * 100 + ord(FPacket[4]);
                FProtocolVersion := ord(FPacket[5]) * 100 + ord(FPacket[6]);
                // 生成服务器模式下的协议执行者
                CreateProtocolExecutor;
              end
              else if Pos(csHandShakeCommand + 'Commander', FPacket) > 0 then
              begin
                if FCurrentTransferMode = tmCommander then
                begin
                  // 如果自己也为Commander, 则主动连接的一方为Responder
                  if FCommDevice.isInitiative then
                  begin
                    FCurrentTransferMode := tmResponder;
                    // 生成客户模式下的协议执行者
                    CreateProtocolExecutor;
                  end
                  else
                  begin
                    //如果自己为被动连接一方，且对方也为Commander，则继续握手
                  end;
                end
                else if FCurrentTransferMode = tmResponder then
                begin
                  // 生成客户模式下的协议执行者
                  CreateProtocolExecutor;
                end;
              end
              else if Pos(csHandShakeCommand + 'Responder', FPacket) > 0 then
              begin
                if FCurrentTransferMode = tmResponder then
                begin
                  if not FCommDevice.isInitiative then
                  begin
                    // 如果自己也为Responder, 则被动连接的一方为Commander
                    FCurrentTransferMode := tmCommander;
                    // 继续握手
                  end
                  else
                  begin
                    // 自己也为Responder, 属主动连接的一方，则开始回应命令
                    // 因为对方为被动连接，将变为Commander
                    // 生成客户模式下的协议执行者
                    CreateProtocolExecutor;
                  end;
                end
                else if FCurrentTransferMode = tmCommander then
                begin
                  // 继续握手
                end;
              end
              else
                FCommState := csHalt;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csHalt:
      begin
        // 停止通信状态。如果需要保存通信结果，则保存当前协议处理实例
        if Assigned(FCurrentProtocolExecutor) then
        begin
          if (FCurrentProtocolExecutor.CommSuccess) or (FCurrentProtocolExecutor.SaveUncompletedData) then
          begin
            FProtocolExecutorList.Add(FCurrentProtocolExecutor);
            SafePostMessage(OwnerHwnd, WMT_CommCompleted, Integer(FCurrentProtocolExecutor.CommSuccess), Integer(FCommDevice.isInitiative));
          end
          else
            FCurrentProtocolExecutor.Free;