unit unModbus;

unit unModbus;

interface

uses
  Windows, Messages, SysUtils,unGeneral,
  Dialogs;

const

  //参数值
  READ_REG_COUNT           = $08;     //读寄存器命令字节数
  READ_RETURN_BASE_COUNT   = $05;     //读返回字节基本数
  WRITE_REGONE_COUNT       = $08;     //写单个寄存器命令字节数
  WRITE_REGTWO_COUNT       = $0D;     //写两个寄存器命令字节数
  WRITE_REGMUL_BASE_COUNT  = $09;     //写多个寄存器命令字节基本数
  WRITE_RETURN_COUNT       = $08;     //写正确返回命令字节数
  ERR_RETURN_COUNT         = $05;     //错误返回命令字节数

  //功能码
  FUN_READ_REG    = $03;  //读寄存器值
  FUN_WRITE_REG   = $06;  //写单个寄存器
  FUN_WRITE_REGX  = $10;  //写多个寄存器

  //从机接收错误返回信息
  FUN_ERR_READ    = $83;  //读寄存器值从机接收错误
  FUN_ERR_WRITE   = $86;  //写单个寄存器从机接收错误
  FUN_ERR_WRITEX  = $90;  //写多个寄存器从机接收错误
 

type
  TModbusAgree = class
  private
    //字节转换为错误代码
    //function ByteToCode(Abyte:Byte):Byte;
  protected

  public
    constructor Create;
    //打包读寄存器命令
    function PackedRead(Addr:Byte; RegStartAddr, RegCount:Word; var Datas:array of Byte):Integer;
    //解包读寄存器返回数据（函数返回值为数据字节数，返回0时表示错误数据）
    function UnPackRead(const ABytes:array of Byte; const Addr:Byte; const Count:Integer;
        var Datas:array of Byte):Integer;
    //打包写单个寄存器命令
    function PackedWriteOne(Addr:Byte; RegAddr, AData:Word; var Datas:array of Byte):Integer;
    //打包写两个寄存器命令
    function PackedWriteTwo(Addr:Byte; RegStartAddr, AData1, AData2:Word;
        var Datas:array of Byte):Integer;
    //打包写多个寄存器命令
    function PackedWriteMuli(Addr:Byte; RegStartAddr, RegCount:Word;
              AData:array of Word; var Datas:array of Byte):Integer;
    //解包写单个寄存器返回数据
    function UnPackWriteReturnOne(const ABytes:array of Byte; const Count:Integer; const Addr:Byte;
    const RegAddr, AData:Word):Boolean;
    //解包写多个寄存器返回数据
    function UnPackWriteReturnMuli(const ABytes:array of Byte; const Count:Integer; const Addr:Byte;
        const RegStartAddr, RegCount:Word):Boolean;

  end;

var
  ModbusAgree:TModbusAgree;     //MODBUS协议

implementation

uses unCRC16_Modbus;

{ TModbusAgree }

constructor TModbusAgree.Create;
begin
  //
end;

function TModbusAgree.PackedRead(Addr: Byte; RegStartAddr, RegCount: Word;
                                  var Datas:array of Byte):Integer;
var
  crc:Word;
begin
  Datas[0]:=Addr;
  Datas[1]:=FUN_READ_REG;
  Datas[2]:=HiByte(RegStartAddr);
  Datas[3]:=RegStartAddr;
  Datas[4]:=HiByte(RegCount);
  Datas[5]:=RegCount;
  Datas[6]:=0;
  Datas[7]:=0;
  crc:=CalCRC16(Datas,0,5);
  Datas[6]:=crc;
  Datas[7]:=HiByte(crc);
  Result:=READ_REG_COUNT;
end;

function TModbusAgree.UnPackRead(const ABytes:array of Byte; const Addr:Byte; const Count:Integer;
    var Datas:array of Byte): Integer;
var
  i,n:Integer;
  crc,rc:Word;
begin
  Result:=0;
  n:=Count-READ_RETURN_BASE_COUNT;
  {if (Count < READ_RETURN_BASE_COUNT+2) or (n <> ABytes[2]) then
    raise ECommException.Create(ERR_MODBUS_LEN); }

   
  {if (ABytes[1] = FUN_ERR_READ) and (Count = ERR_RETURN_COUNT)  then
  begin
    crc:=CalCRC16(ABytes,0,Count-3);
    if (HiByte(crc) <> ABytes[Count-1]) or (Byte(crc) <> ABytes[Count-2]) then
      raise ECommException.Create(ERR_MODBUS_INV);
    raise ECommException.Create(ABytes[2]);
  end;}
 
  crc:=CalCRC16(ABytes,0,Count-3);
  rc:=MakeWord(ABytes[Count-2],ABytes[Count-1]);
  {if crc <> rc then
    raise ECommException.Create(ERR_MODBUS_CRC)
  else if (ABytes[0] = Addr) and (ABytes[1] = FUN_READ_REG)  and (ABytes[2] = n) then
  begin
    for i := 0 to n-1 do
      Datas[i]:=ABytes[i+3];
    Result:=ABytes[2];
  end
  else
    raise ECommException.Create(ERR_MODBUS_INV); }

  //if (ABytes[0] = Addr) and (ABytes[1] = FUN_READ_REG)  and (ABytes[2] = n) then
  if (ABytes[0] = Addr) and (ABytes[1] = FUN_READ_REG) then
  begin
    for i := 0 to n-1 do
      Datas[i]:=ABytes[i+3];
    Result:=ABytes[2];
  end;
end;

function TModbusAgree.PackedWriteOne(Addr: Byte; RegAddr, AData: Word;
    var Datas:array of Byte):Integer;
var
  crc:Word;
begin
  Datas[0]:=Addr;
  Datas[1]:=FUN_WRITE_REG;
  Datas[2]:=HiByte(RegAddr);
  Datas[3]:=RegAddr;
  Datas[4]:=HiByte(AData);
  Datas[5]:=AData;
  Datas[6]:=0;
  Datas[7]:=0;
  crc:=CalCRC16(Datas,0,5);
  Datas[6]:=crc;
  Datas[7]:=HiByte(crc);
  Result:=WRITE_REGONE_COUNT;
end;

function TModbusAgree.PackedWriteTwo(Addr: Byte; RegStartAddr, AData1, AData2: Word;
    var Datas:array of Byte):Integer;
const
  RegCount = 2;
  ByteCount = 4;
var
  crc:Word;
begin
  Datas[0]:=Addr;
  Datas[1]:=FUN_WRITE_REGX;
  Datas[2]:=HiByte(RegStartAddr);
  Datas[3]:=RegStartAddr;
  Datas[4]:=HiByte(RegCount);
  Datas[5]:=RegCount;
  Datas[6]:=ByteCount;
  Datas[7]:=HiByte(AData1);
  Datas[8]:=AData1;
  Datas[9]:=HiByte(AData2);
  Datas[10]:=AData2;
  crc:=CalCRC16(Datas,0,10);
  Datas[11]:=crc;
  Datas[12]:=HiByte(crc);
  Result:=WRITE_REGTWO_COUNT;
end;

function TModbusAgree.PackedWriteMuli(Addr:Byte; RegStartAddr, RegCount:Word;
          AData:array of Word; var Datas:array of Byte):Integer;
var
  crc:Word;
  i:Integer;
begin
  Datas[0]:=Addr;
  Datas[1]:=FUN_WRITE_REGX;
  Datas[2]:=HiByte(RegStartAddr);
  Datas[3]:=RegStartAddr;
  Datas[4]:=HiByte(RegCount);
  Datas[5]:=RegCount;
  Datas[6]:=RegCount*2;
  for i := 0 to RegCount-1 do
  begin
    Datas[i*2+7]:=HiByte(Adata[i]);
    Datas[i*2+8]:=Adata[i];
  end;
  crc:=CalCRC16(Datas,0,RegCount*2+6);
  Datas[RegCount*2+7]:=crc;
  Datas[RegCount*2+8]:=HiByte(crc);
end;

function TModbusAgree.UnPackWriteReturnOne(const ABytes:array of Byte; const Count:Integer;
    const Addr:Byte; const RegAddr, AData:Word):Boolean;
var
  crc,rg,rd,rc:Word;
begin
  Result:=False;
  {if Count <> WRITE_RETURN_COUNT then
    raise ECommException.Create(ERR_MODBUS_LEN); }
  {if (ABytes[1] = FUN_ERR_WRITE) and (Count = ERR_RETURN_COUNT) then
  begin
    crc:=CalCRC16(ABytes,0,Count-3);
    if (HiByte(crc) <> ABytes[Count-1]) or (Byte(crc) <> ABytes[Count-2]) then
      raise ECommException.Create(ERR_MODBUS_INV);
    raise ECommException.Create(ABytes[2]);
  end;}
 
  crc:=CalCRC16(ABytes,0,Count-3);
  rc:=MakeWord(ABytes[6],ABytes[7]);
 
  {if crc <> rc then
    raise ECommException.Create(ERR_MODBUS_CRC);}

  rg:=MakeWord(ABytes[3],ABytes[2]);
  rd:=MakeWord(ABytes[5],ABytes[4]);

  if (ABytes[0] = Addr) and (ABytes[1] = FUN_WRITE_REG) and (rg = RegAddr) and (rd = AData) then
    Result:=True
  else
    //raise ECommException.Create(ERR_MODBUS_INV);

end;

function TModbusAgree.UnPackWriteReturnMuli(const ABytes: array of Byte; const Count:Integer;
    const Addr: Byte; const RegStartAddr, RegCount: Word):Boolean;
var
  crc,rg,rn,rc:Word;
begin
  Result:=False;
  {if Count <> WRITE_RETURN_COUNT then
    raise ECommException.Create(ERR_MODBUS_LEN);}
  {if (ABytes[1] = FUN_ERR_WRITE) and (Count = WRITE_RETURN_COUNT) then
  begin
    crc:=CalCRC16(ABytes,0,Count-3);
    if (HiByte(crc) <> ABytes[Count-1]) or (Byte(crc) <> ABytes[Count-2]) then
      raise ECommException.Create(ERR_MODBUS_INV);
    raise ECommException.Create(ABytes[2]);
  end;}

  crc:=CalCRC16(ABytes,0,Count-3);
  rc:=MakeWord(ABytes[6],ABytes[7]);
  {if crc <> rc then
    raise ECommException.Create(ERR_MODBUS_CRC);}

  rg:=MakeWord(ABytes[3],ABytes[2]);
  rn:=MakeWord(ABytes[5],ABytes[4]);

  if (ABytes[0]=Addr) and (ABytes[1]=FUN_WRITE_REGX) and (rg=RegStartAddr) and (rn=RegCount) then
    Result:=True
  else
    //raise ECommException.Create(ERR_MODBUS_INV);
end;

end.
//注：只实现了03$,06$和10$命令

下面这个是CRC16
unit unCRC16_Modbus;

interface

function CalCRC16(AData:array of Byte; AStart,AEnd:Integer): Word;

implementation

function CalCRC16(AData:array of Byte; AStart,AEnd:Integer): Word;
const
  GENP = $A001;
 
var
  crc:Word;
  i:Integer;
  tmp:Byte;
 
procedure CalOneByte(AByte:Byte);
var
  j:Integer;
begin
  crc:=crc xor AByte;
  for j := 0 to 7 do
  begin
    tmp:=crc and 1;
    crc:=crc shr 1;
    crc:= crc and $7FFF;
    if tmp = 1 then
      crc:= crc xor GENP;
    crc:=crc and $FFFF;
  end;  
end;

begin
  crc:=$FFFF;
  for i := AStart to AEnd do
    CalOneByte(AData[i]);
  Result:=crc;
end;  

end.