uniprotocol_datatrans.pas

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

unit UniProtocol_DataTrans;

{----------------------------------------------
         UniProtocol_DataTransfer

         数据传输协议插件
            Ver 1.03

  Copyright 1999-2001 AT Corp.Ltd
-----------------------------------------------}

//****************************************
//教训：Record类型要使用New开辟内存。
//      如果使用GetMem会导致内存使用增长，而且可能会发生异常
//****************************************

interface

uses
  UniCommX, SysUtils, Classes, Windows, Forms;

type

  PUndoneBuff = ^TUndoneBuff;
  TUndoneBuff = record
    Tag: string; //本次传送对方的特征值
    BrokenFrameNo: Cardinal;
    Data: Pointer; //已接收到的数据
    DataLen: Cardinal;
  end;

  TDataTransCommander = class(TCustomProtocolExecutor)
  private
    FHostCmd: THostCommand;
    FFrameNo: Cardinal;
    FUndoneBuff: PUndoneBuff;
    ResumeItem: Integer;
  public
    constructor Create(SenderID, ProtocolVersion: Integer; Hwnd: THandle); override;
    destructor Destroy; override;
    class function ProtocolImplemented(ProtocolType: Integer; ProtocolVersion: Integer; isCommander: Boolean): Boolean; override;
    class function SaveUncompletedData: Boolean; override;
    function ProcessProtocol(var FCommState: Integer; SendResult: Integer; Packet: string; Parameters: TStrings): THostCommand; override;
  published
    property Datas;
  end;

  TDataTransResponder = class(TCustomProtocolExecutor)
  private
    FFrameNo: Cardinal;
    HangupSign: Integer;
    NewCycling: Boolean;
    MessagePosted: Boolean;
    cmdArray: array of TCommandTag;
    FUndoneBuff: PUndoneBuff;
    ResumeItem: Integer;
  public
    constructor Create(SenderID, ProtocolVersion: Integer; Hwnd: THandle); override;
    destructor Destroy; override;
    class function ProtocolImplemented(ProtocolType: Integer; ProtocolVersion: Integer; isCommander: Boolean): Boolean; override;
    class function SaveUncompletedData: Boolean; override;
    function RespondCommand(var FCommState: Integer; Data: string; Parameters: TStrings; var LastCmdComment: string; var dwSleep: Cardinal): string; override;
  published
    property Datas;
  end;

implementation

const

  FRAME_SIZE = 256;
  MAX_COMMAND_LEN = FRAME_SIZE + 20; // 命令最大长度

  csACK = #$A5#$A5; // csACK: 确认
  csNAK = #$5A#$5A; // csNAK: 否定回应
  csCRLF = #13#10;

  csSendDataCount = csUser + 1;
  csSendData = csUser + 2;
  csGetTargetDataCount = csUser + 3;
  csGetTargetData = csUser + 4;
  csPrepareDealData = csUser + 5;
  csDealData = csUser + 6;

var
  CommanderUnDoneList: TThreadList;
  ResponderUnDoneList: TThreadList;

  //------------------------------------------------------------

  {
  命令及应答：

  注：◆为主机命令    ⊙为通信座应答  【】内为注解
      csACK = 0xA5 + 0xA5   csNAK = 0x5A + 0x5A

      ● 握手
          ◆ 0x53 + 0x57 + 0x41 + 0x54 (‘SWAT’)
          ⊙ csACK  + 2B(传送者标识) + 2B(协议版本号) + CRC
      ● 发送数据总量
          ◆ 0xFE + 特征值(16B) + 数据总量(4B) + CRC
          ⊙ csACK + 0xFE + CRC                 【ACK】
      ● 发送数据(每帧64B)
          ◆ 0xFD + 4B(帧号) + 64B(数据) + CRC
          ⊙ csACK  + 0xFD + 4B(帧号) + CRC     【ACK】
          ⊙ csNAK  + 0xFD + 4B(帧号) + CRC     【NAK】
      ● 要求对方数据总量
          ◆ 0xFC + 0x10 + 0x10 + CRC
          ⊙ csACK + 0xFC + 'WAIT'(4B) + CRC  【要求等待数据准备好】 【ACK】
          ⊙ csACK + 0xFC + 特征值(16B) + 数据总量(4B) + CRC
          ⊙ csNAK + 0xFC + CRC           【NAK】
      ● 请求数据
          ◆ 0xFB + 4B(帧号) + CRC
          ⊙ csACK  + 0xFB + 4B(帧号) + 64B(数据) + CRC
          ⊙ csNAK + 0xFB + CRC           【NAK】
      ● 主机要求等待
          ◆ 0xF0 + 'WAIT' + CRC;
      ● 主机要求挂机
          ◆ 0xF8 + 0x10 + CRC
          ⊙ csACK  + 0xF8 + CRC
  【Responder连续2次收到挂机命令，且校验正确，应答后挂机，否则可以处理其他命令。
  主机收到Responder第二次应答后挂机，否则连续发送10次后挂机】。

  注：
  1、 固定数据取CRC只是为延长命令长度，减少“正确误码”或为处理方便。
  2、 当主机没有收到应答时，要求重发都由主机来执行。
  3、 16字节特征值为随机数。
  4、 主机发送的所有命令前都额外加 0XFFFF 2个字节，不计其CRC
  5、 发给主机的一切应答前都额外加 0XFFFF 2个字节，不计其CRC
  6、 传送者标识为传送者类别代码。如通信座为 0x00+0x01，电子门锁可能为 0x00+0x02等等
  }

    {-------------------  TDataTransCommander   -----------------------------}

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

destructor TDataTransCommander.Destroy;
begin
  inherited Destroy;
end;

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

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

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

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

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

function TDataTransCommander.ProcessProtocol(var FCommState: Integer; SendResult: Integer; Packet: string; Parameters: TStrings): THostCommand;
  function FindParams(Key: string): string;
  begin
    Result := Parameters.Values[IntToStr(cnDataTransferID) + '_' + Key];
  end;

  function GetSubParams(Key: string; KeyIndex: Integer): string;
  var
    i: Integer;
    curKeyIndex: Integer;
    Params: string;
  begin
    Result := '';
    Params := FindParams(Key);
    if Params = '' then
      Exit;
    curKeyIndex := 0;
    if Params[Length(Params)] <> ',' then
      Params := Params + ',';
    while Pos(',', Params) > 0 do
    begin
      i := Pos(',', Params);
      if curKeyIndex = KeyIndex then
      begin
        Result := Copy(Params, 1, i - 1);
        Break;
      end;
      Delete(Params, 1, i);
      Inc(curKeyIndex);
    end;
  end;
var
  curFrameSize, i: Integer;
  Tag: string;
begin

  // 处理状态改变
  case FCommState of
    csHandShake:
      begin
        FProcessRatio := 0;
        if FOutBuffSize <> 0 then
          FCommState := csSendDataCount
        else
          FCommState := csGetTargetDataCount;
        FFrameNo := 0;
      end;
    csSendDataCount:
      begin
        case SendResult of
          srGetdata:
            begin
              FCommState := csSendData;
              FFrameNo := Char4BToInt(Copy(Packet, 4, 4));
              if (FFrameNo + 1) * FRAME_SIZE >= FOutBuffSize then
                FFrameNo := 0;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csSendData:
      begin
        case SendResult of
          srACK:
            begin
              if FOutBuffSize > 0 then
                FProcessRatio := MulDiv((FFrameNo + 1) * FRAME_SIZE, 100, FOutBuffSize);
              if FProcessRatio > 100 then
                FProcessRatio := 100;
              if (FFrameNo + 1) * FRAME_SIZE >= FOutBuffSize then
              begin
                FCommState := csGetTargetDataCount;
                FFrameNo := 0;
              end
              else
                Inc(FFrameNo);
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csGetTargetDataCount:
      begin
        case SendResult of
          srGetData:
            begin
              FInBuffSize := Char4BToInt(Copy(Packet, 20, 4));
              // 对方的特征值
              Tag := Copy(Packet, 4, 16);
              // 查看是否断点续传
              ResumeItem := -1;
              with CommanderUndoneList.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
                CommanderUndoneList.UnLockList;
              end;
              // 不是断点续传，则开辟新的缓冲区
              if ResumeItem = -1 then
              begin
                FUndoneBuff := nil;
                try
                  New(FUndoneBuff);