delphi实现modbus通信

-------------------------------------------------------------基础单元BaseCommon----start--------------------------------------------------------------------------------

unit BaseCommon;

interface

uses
System.SysUtils,Winapi.Windows,Vcl.Forms;

Const
//CRC校验用
ModbusCrc16: array[0..$FF] of word = ($0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241, $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440, $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40, $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841, $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40, $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41, $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641, $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040, $F001, $30C0, $3180,
$F141, $3300, $F3C1, $F281, $3240, $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441, $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41, $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840, $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41, $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40, $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640, $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041, $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240, $6600, $A6C1, $A781,
$6740, $A501, $65C0, $6480, $A441, $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41, $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840, $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41, $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40, $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640, $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041, $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241, $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440, $9C01, $5CC0, $5D80,
$9D41, $5F00, $9FC1, $9E81, $5E40, $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841, $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40, $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41, $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641, $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040);

type
//项目运行状态 初始化，运行，暂停，结束,重新运行
TStateFreshMode=(Init_State, Testing_State,Pause_State, End_State,Retest_State);

//读取文本文件
function ReadTxtFile(FileName:string;var sMsg:string):Boolean;
//数组转string
function BytesToStr(Buff:TByteArray;BuffLen:Integer;var sOut:string;var sMsg:string):Boolean;
//string转数组
function StrToBytes(sHex:string;var Buff:TByteArray;var BuffLen:Integer;var sMsg:string):Boolean;
//延时函数
procedure SafeSleep(MSecs:LongInt);
//获取时间间隔
function ms_between(pastms, the_now: Cardinal): Cardinal;
//CRC校验
function CalcCRC16(p: PByte; nbyte: word; var CRCvalue: word;var sMsg:string):Boolean;

var
FTestRunMode:TStateFreshMode; //运行状态模式

implementation
{$REGION '读取文本文件'}
function ReadTxtFile(FileName:string;var sMsg:string):Boolean;
var
F:TextFile;//文件类
sLine:string;//读取到的一行数据
begin
Result:=False;
try
sMsg:='';
//检查文件是否存在
if not FileExists(FileName) then
begin
sMsg:='['+FileName+'] does not exist';
Exit;
end;
AssignFile(F, FileName);
try
Reset(F); //只读打开
while not Eof(F) do
begin
Readln(F, sLine);
sMsg:=sMsg+sLine;
end;
finally
CloseFile(F);
end;
Result:=True;
except
on e:Exception do
begin
sMsg:='ReadTxtFileException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION '数组转string'}
function BytesToStr(Buff:TByteArray;BuffLen:Integer;var sOut:string;var sMsg:string):Boolean;
var
i:Integer;
begin
Result:=False;
sOut:='';
try
for i := 0 to BuffLen-1 do
begin
sOut:=sOut+InttoHex(Integer(Buff[i]),2); //转成16进制
end;
sMsg:='OK';
Result:=True;
except
on e:Exception do
begin
sMsg:='BytesToStrException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION 'string转数组'}
//每两位转换一次
function StrToBytes(sHex:string;var Buff:TByteArray;var BuffLen:Integer;var sMsg:string):Boolean;
var
i:Integer;
j:Integer;//数组下标
begin
Result:=False;
try
if sHex.Length<2 then
begin
sMsg:='HexString too short';
Exit
end;
if (sHex.Length mod 2)<>0 then
begin
sMsg:='HexString Length should be double';
Exit
end;
j:=0;
for i := 1 to sHex.Length do
begin
//if not (Char(sHex[i]) in ['0'..'9','a' .. 'z', 'A' .. 'Z']) then
if not CharInSet(Char(sHex[i]),['0'..'9','a' .. 'z', 'A' .. 'Z']) then
begin
sMsg:='HexString incorrect';
Exit;
end;
if (i mod 2)=0 then
begin
Buff[j]:=StrToInt('$'+Copy(sHex,i-1,2));
Inc(j);
end;
end;
BuffLen:=sHex.Length div 2;
Result:=True;
except
on e:Exception do
begin
sMsg:='StrToBytesException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION '延迟函数'}
procedure SafeSleep(MSecs:LongInt);
var
FirstTickCount,Now:LongInt;
begin
FirstTickCount:=GetTickCount();
repeat
Application.ProcessMessages;
Now:=GetTickCount();
until (Now - FirstTickCount >=MSecs)or(Now<FirstTickCount);
end;
{$ENDREGION}

{$REGION '获取时间间隔'}
function ms_between(pastms, the_now: Cardinal): Cardinal;
begin
if (pastms > the_now) then
begin
result := $FFFFFFFF - pastms + the_now;
end
else
begin
result := the_now - pastms;
end;
end;
{$ENDREGION}

{$REGION 'CRC校验'}
//用法举例
//res: word;
//res := $FFFF;
//CalcCRC16(pCommandBuf, 6, res);
//CmdData[6] := Lo(res);
//CmdData[7] := Hi(res);
function CalcCRC16(p: PByte; nbyte: word; var CRCvalue: word;var sMsg:string):Boolean;
var
i: word;
q: PByte;
begin
Result:=False;
sMsg:='';
try
q := p;
for i := 1 to nbyte do
begin
CRCvalue := Hi(CRCvalue) xor ModbusCrc16[q^ xor Lo(CRCvalue)];
inc(q)
end;
Result:=True;
except
on e:Exception do
begin
sMsg:='CalcCRC16Exception:'+e.Message;
end;
end;
end;
{$ENDREGION}

end.

-------------------------------------------------------------基础单元BaseCommon----end--------------------------------------------------------------------------------

-------------------------------------------------------------基础单元UntModBusBase----start-----------------------------------------------------------------------------

{********************************************************************}
{* 单元名称：UntModBusBase基础单元 *}
{* 功能描述：管理 连接、接收、发送 *}
{* *}
{*新建：张金宝 20230320 *}
{* *}
{* *}
{* *}
{* *}
{* *}
{* *}
{* *}
{* *}
{********************************************************************}
unit UntModBusBase;

interface
uses
Winapi.Windows,System.SysUtils,Classes,Winsock2,BaseCommon;

type
TModbusClient=class
private
//连接对象
FSocket: TSocket;
protected

public
//构造函数
constructor Create();
//销毁函数
destructor Destroy();override;
//连接设备
function ConnectDev(IP:string;Port:string;var sMsg:string):Boolean;
//发送数据
function SendBytes(SendBuff:TByteArray;SendLen:Integer;var SucessLen:Integer;var sMsg:string):Boolean;
//接收数据
function RecvBytes(var RecvBuff:TByteArray;var RecvLen:Integer;var sMsg:string):Boolean;
//断开连接
function DisConnDev(var sMsg:string):Boolean;
end;
implementation
{$REGION '构造函数'}
constructor TModbusClient.Create;
begin
inherited;
end;
{$ENDREGION}

{$REGION '销毁函数'}
destructor TModbusClient.Destroy;
begin
inherited;
end;
{$ENDREGION}

{$REGION '连接设备'}
//参数说明：IP IP地址
// Port 端口号
// sMsg 错误消息
//返回值 True 成功，False 失败
function TModbusClient.ConnectDev(IP:string;Port:string;var sMsg:string):Boolean;
var
WSAData:TWSAData;//套接字实现的信息
iResult:Integer;//函数返回值
sockaddr:TSockAddr;//连接地址
begin
Result:=False;
try
//通过进程启动 Winsock DLL 的使用
iResult:=WSAStartup(MAKEWORD(2,2),WSAData);
if (iResult<>NO_ERROR) then
begin
sMsg:=Format('WSAStartup function failed with error: %d',[iResult]);
Exit;
end;
//创建socket连接服务器
FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if (FSocket = INVALID_SOCKET) then
begin
sMsg:=Format('socket function failed with error: %d',[WSAGetLastError()]);
WSACleanup();
Exit;
end;
//设置连接地址 端口
TSockAddrIn(sockaddr).sin_family := AF_INET;
TSockAddrIn(sockaddr).sin_addr.S_addr := inet_addr(PAnsiChar(AnsiString(IP)));
TSockAddrIn(sockaddr).sin_port := htons(StrToInt(Port));
//连接服务
iResult:=connect(FSocket, sockaddr, SizeOf(TSockAddrIn));
if iResult=SOCKET_ERROR then
begin
sMsg:=Format('connect function failed with error: %d',[WSAGetLastError()]);
closesocket(FSocket);
WSACleanup();
Exit;
end;
sMsg:='OK';
Result:=True;
except
on e:Exception do
begin
sMsg:='ConnectDevException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION '发送数据'}
//参数说明:SendBuff 发送的数据
// SendLen 缓冲区长度
// SucessLen 发送成功的数据长度
// sMsg 错误消息
//返回值 True 成功，False 失败
function TModbusClient.SendBytes(SendBuff:TByteArray;SendLen:Integer;var SucessLen:Integer;var sMsg:string):Boolean;
var
iResult:Integer;//函数返回值
//调用方式标志
//MSG_DONTROUTE：指定数据不应受到路由的约束。 Windows 套接字服务提供程序可以选择忽略此标志。
//MSG_OOB仅) (流式套接字（例如SOCK_STREAM）发送 OOB 数据。
flags:Integer;
begin
Result:=False;
try
SucessLen:=0;
flags:=0;
//发送数据
iResult:=send(FSocket,SendBuff,SendLen,flags);
if iResult = SOCKET_ERROR then
begin
sMsg:=Format('send failed with error: %d',[WSAGetLastError()]);
Exit;
end;
SucessLen:=iResult;
sMsg:='OK';
Result:=True;
except
on e:Exception do
begin
sMsg:='SendBytesException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION '接收数据'}
//参数说明:RecvBuff 接收到的数据
// RecvLen 接收到的数据长度
// sMsg 错误消息
//返回值 True 成功，False 失败
function TModbusClient.RecvBytes(var RecvBuff:TByteArray;var RecvLen:Integer;var sMsg:string):Boolean;
var
iResult:Integer;//函数返回值
//调用方式标志
//MSG_PEEK 查看传入数据。 数据将复制到缓冲区中，但不会从输入队列中删除。
//MSG_OOB 处理带外 (OOB) 数据。
//MSG_WAITALL 仅当发生以下事件之一时，接收请求才会完成：
//调用方提供的缓冲区已完全满。
//该连接已关闭。
//请求已被取消或出错。
//请注意，如果基础传输不支持MSG_WAITALL，或者套接字处于非阻塞模式，则此调用将失败并出现 WSAEOPNOTSUPP。 此外，如果指定了MSG_WAITALL以及MSG_OOB、MSG_PEEK或MSG_PARTIAL，则此调用将失败并出现 WSAEOPNOTSUPP。 数据报套接字或面向消息的套接字不支持此标志。
flags:Integer;
begin
Result:=False;
try
RecvLen:=4096;//默认4096
flags:=0;
repeat
//接收数据
iResult:=recv(FSocket, RecvBuff[0], RecvLen, flags);
until not iResult<=0;

if iResult<0 then
begin
sMsg:=Format('recv failed: %d',[WSAGetLastError()]);
Exit;
end;
RecvLen:=iResult;
sMsg:='OK';
Result:=True;
except
on e:Exception do
begin
sMsg:='RecvBytesException:'+e.Message;
end;
end;
end;

{$ENDREGION}

{$REGION '断开连接'}
//参数说明：
// sMsg 错误消息
//返回值 True 成功，False 失败
function TModbusClient.DisConnDev(var sMsg:string):Boolean;
var
iResult:Integer;//函数返回值
begin
Result:=False;
try
iResult:=closesocket(FSocket);
if iResult=SOCKET_ERROR then
begin
sMsg:=Format('closesocket function failed with error: %d',[WSAGetLastError()]);
WSACleanup();
Exit;
end;
//函数终止使用 Winsock 2 DLL
WSACleanup();
sMsg:='OK';
Result:=True;
except
on e:Exception do
begin
sMsg:='DisConnDevException:'+e.Message;
end;
end;
end;
{$ENDREGION}

end.

-------------------------------------------------------------基础单元----end-----------------------------------------------------------------------------

-------------------------------------------------------------使用-----start---------------------------------------------------------------------------------

mClient:TModbusClient;

mClient:=TModbusClient.Create;

//连接

procedure TModBusTestForm.ConnectButtonClick(Sender: TObject);
var
bRet:Boolean;//返回值
sMsg:string;//错误信息
begin
try

bRet:=mClient.ConnectDev(IPEdit.Text,PortEdit.Text,sMsg);
if bRet then
begin
StatusBar.Panels[0].Text:='连接成功';
end
else
begin
StatusBar.Panels[0].Text:='连接失败:'+sMsg;
end;

except
on e:Exception do
begin
ShowMessage('连接异常:'+e.Message);
end;
end;
end;

//断开

procedure TModBusTestForm.DisConnButtonClick(Sender: TObject);
var
bRet:Boolean;//返回值
sMsg:string;//错误信息
begin
try
bRet:=mClient.DisConnDev(sMsg);
if bRet then
begin
StatusBar.Panels[0].Text:='断开成功';
end
else
begin
StatusBar.Panels[0].Text:='断开失败:'+sMsg;
end;
except
on e:Exception do
begin
ShowMessage('断开异常:'+e.Message);
end;
end;
end;

//发送

procedure TModBusTestForm.SendButtonClick(Sender: TObject);
var
bRet:Boolean;//返回值
sMsg:string;//错误信息
SendBuff:TByteArray;//发送的报文
SendLen:Integer;//发送的报文长度
SucessLen:Integer;//发送成功的报文长度
addr:Integer;//地址
iValue:Integer;//发送的数据
RecvBuff:TByteArray;//返回的报文
RecvLen:Integer;//返回报文长度
sRet:string;//返回值
begin
try
addr:=StrToInt(SendAddrEdit.Text);
iValue:=StrToInt(SendValueEdit.Text);
SendLen:=12;
SendBuff[0] := $03;//事务处理标识符高位 客户机发起 用户定义
SendBuff[1] := $13;//事务处理标识符低位
SendBuff[2] := $00;//协议标识符高位 固定0X0000
SendBuff[3] := $00;//协议标识符低位 固定0X0000
SendBuff[4] := $00;//长度 高位
SendBuff[5] := $06;//长度 低位
SendBuff[6] := $01;//单元标识符 客户机发起 用户定义
SendBuff[7] := $06;//功能码 写入单个0x06 写入多个0x10 读取0x03
SendBuff[8] := Hi(addr);//寄存器地址高位
SendBuff[9] := Lo(addr);//寄存器地址低位
SendBuff[10] := Hi(iValue);//寄存器值 高位
SendBuff[11] := Lo(iValue);//寄存器值 低位

//sRet:=TEncoding.UTF8.GetString(SendBuff);
//sRet:=BytesToBase64(SendBuff);
bRet:=mClient.SendBytes(SendBuff,SendLen,SucessLen,sMsg);
if bRet then
begin
StatusBar.Panels[0].Text:='发送成功,报文长度:'+IntToStr(SucessLen);
//获取发送返回的报文
bRet:=mClient.RecvBytes(RecvBuff,RecvLen,sMsg);
if bRet then
begin
//返回报文转16进制
bRet:=BytesToStr(RecvBuff,RecvLen,sRet,sMsg);
if bRet then
begin
SendRetMemo.Text:=sRet;
end
else
begin
SendRetMemo.Text:='返回值转换失败:'+sMsg;
end;
end
else
begin
SendRetMemo.Text:='返回值接收失败:'+sMsg;
end;
end
else
begin
StatusBar.Panels[0].Text:='发送失败:'+sMsg;
end;
except
on e:Exception do
begin
ShowMessage('发送异常:'+e.Message);
end;
end;
end;

//接收

procedure TModBusTestForm.RecvButtonClick(Sender: TObject);
var
bRet:Boolean;//返回值
sMsg:string;//错误信息
addr:Integer;//地址
iRecvCount:Integer;//发送的数据
SendBuff:TByteArray;//发送的报文
SendLen:Integer;//发送的报文长度
SucessLen:Integer;//发送成功的报文长度
RecvBuff:TByteArray;//返回的报文
RecvLen:Integer;//返回报文长度
sRet:string;//返回值
begin
try
addr:=StrToInt(RecvAddrEdit.Text);
iRecvCount:=StrToInt(RecvCountEdit.Text);
SendLen:=12;
SendBuff[0] := $00;//事务处理标识符高位 用户定义
SendBuff[1] := $00;//事务处理标识符低位 用户定义
SendBuff[2] := $00;//协议标识符高位 固定0X0000
SendBuff[3] := $00;//协议标识符低位 固定0X0000
SendBuff[4] := $00;//长度 高位
SendBuff[5] := $06;//长度 低位
SendBuff[6] := $01;//单元标识符客户机发起 用户定义
SendBuff[7] := $03;//功能码 写入单个0x06 写入多个0x10 读取0x03
SendBuff[8] := Hi(addr);//起始地址高位
SendBuff[9] := Lo(addr);//起始地址低位
SendBuff[10] := Hi(iRecvCount);//寄存器数量高位
SendBuff[11] := Lo(iRecvCount);//寄存器数量低位
bRet:=mClient.SendBytes(SendBuff,SendLen,SucessLen,sMsg);
if bRet then
begin
//获取发送返回的报文
bRet:=mClient.RecvBytes(RecvBuff,RecvLen,sMsg);
if bRet then
begin
//返回报文转16进制
bRet:=BytesToStr(RecvBuff,RecvLen,sRet,sMsg);
if bRet then
begin
RecvMemo.Text:=sRet;
//返回值格式说明
//1 事务处理标识符 Hi
//1 事务处理标识符 Lo
//2 协议标识符号
//2 长度
//1 单元标识符
//1 功能码，读寄存器
//1 字节个数
//数据节点
end
else
begin
RecvMemo.Text:='返回值转换失败:'+sMsg;
end;
end
else
begin
RecvMemo.Text:='返回值接收失败:'+sMsg;
end;
end
else
begin
StatusBar.Panels[0].Text:='接收发送失败:'+sMsg;
end;
except
on e:Exception do
begin
ShowMessage('接收异常:'+e.Message);
end;
end;
end;

-------------------------------------------------------------使用-----end---------------------------------------------------------------------------------