modbus协议的控件源码

自己写的modbus协议的控件(delphi 6) 2009-4-2编程资料 2009-04-02 14:22:50 阅读576 评论1 字号:大中小 订阅 .

unit ModBusBase;

interface

uses
Windows, Messages, SysUtils, Classes, ExtCtrls, Forms,MMSystem;

type
// arreglo de bytes que conforman el mensaje modbus y un puntero al mismo
PDataByte=^TDataByte;
TDataByte = array of byte;

TOnErrorEvent = procedure(Sender : TObject; const ErrorMsg : String) of Object;
TOnTimeSendData=procedure(Sender : TObject;Buff:PByte;BuffSize:integer) of Object;
TOnReceiveDataEnd=procedure(Sender:TObject;Address,FuncId:Byte;DataStr:PByte;DataSize:integer)of object;

// modbus基类,(1)完成延时发送(定时20毫秒发送一个读数据包,在20毫秒后再发送下一个数据包)
// (2)数据是否结束检测(接收到字符后,延时10毫秒,还没有收到字符,说明数据包接收完成)
// (3)完成数据封装和解析(从设备地址和功能码+具体从设备数据+crc校验)
// 具体设备数据的包应该由具体的设备开发单元来封装和解析

TModBusBase=class;
// modbus基类线程类
TModBusBaseThread=Class(TThread)
private
test1,test2:DWORD;
protected
procedure Execute;override;
public
m_ModBusBase:TModBusBase;
end;

TModBusBase = class(TComponent)
private
FSendDataTime:integer;
FReceiveDataTime:integer;
// 提供的事件
FOnTimeSendData:TOnTimeSendData;
FOnError:TOnErrorEvent;
FOnReceiveDataEnd:TOnReceiveDataEnd;

m_Thread:TModBusBaseThread;
m_ReceiveBuff:TDataByte;
m_ReceiveDataFlag:boolean;
m_csReceiveData:TRTLCriticalSection;
m_WriteBuff:TList;
m_csWriteBuff:TRTLCriticalSection;

procedure ClearSendBuffList;
procedure ClearReceiveBuff;

public
m_hEndThreadEvent:THandle;
m_hTimerSendDataEvent:THandle;
m_hRecevieDataEndTimerEvent:THandle;
m_hEventArray:array[0..2]of THandle;

m_hThreadHasEnd:THandle;

constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
procedure StartThread;
procedure StopThread;
procedure ReceiveChar(ch:Byte);
function GetReceiveDataFlag():boolean;
procedure SetReceiveDataFlag(Value:boolean);
procedure ReceiveDataEnd;
procedure EncodeData(DeviceAddress,FunctionId:Byte;DataStr:PByte;DataSize:integer;
PackStr:PByte;var PackSize:integer); // 封包
function DecodeData(var DeviceAddress,FunctionId:Byte;DataStr:PByte;var DataSize:integer;
PackStr:PByte;PackSize:integer):boolean; // 解包
procedure SendOneDataPack;// 从链表中发送一个数据包
// 加入一个包到发送链表中
procedure AddOneDataPack(Address,FuncId:Byte;DataStr:PByte;DataSize:integer);

published
property SendD

ataTime:integer read FSendDataTime write FSendDataTime;
property ReceiveDataTime:integer read FReceiveDataTime write FReceiveDataTime;

property OnError: TOnErrorEvent read FOnError write FOnError;
property OnTimeSendData:TOnTimeSendData read FOnTimeSendData write FOnTimeSendData;
property OnReceiveDataEnd:TOnReceiveDataEnd read FOnReceiveDataEnd write FOnReceiveDataEnd;

end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('DMSComponent', [TModBusBase]);
end;

// TModBusBaseThread 控件代码 //////////////////////////////////////////////////
// 线程执行函数
// (1)定义定时器发送数据包(2)定义定时器用于检测数据包是否结束
procedure TModBusBaseThread.Execute; //线程执行过程
var Event:DWORD;
loop:boolean;
TimerId1,TimerId2:integer;
Begin
// 生成定时发读数据的定时器
TimerId1:=timeSetEvent(self.m_ModBusBase.SendDataTime,0,TFNTimeCallBack(self.m_ModBusBase.m_hTimerSendDataEvent),
0,TIME_PERIODIC or TIME_CALLBACK_EVENT_SET);
// 生成检测数据包是否结束的定时器
TimerId2:=timeSetEvent(self.m_ModBusBase.ReceiveDataTime,0,TFNTimeCallBack(self.m_ModBusBase.m_hRecevieDataEndTimerEvent),
0,TIME_PERIODIC or TIME_CALLBACK_EVENT_SET);
Event:=0;
loop:=true;
test1:=0;
test2:=0;
While (loop) do
Begin
Event := WaitForMultipleObjects(3, @m_ModBusBase.m_hEventArray, FALSE, INFINITE);
case Event of
0: // 结束线程
begin
ResetEvent(m_ModBusBase.m_hEventArray[Event]);
loop:=false;
end;
1: // 定时发包事件
begin
ResetEvent(m_ModBusBase.m_hEventArray[Event]);
Synchronize(self.m_ModBusBase.SendOneDataPack);
end;
2: // 收到字符延时事件
begin
test2:=GetTickCount()-test1;
test2:=test2;
test1:=GetTickCount();
ResetEvent(m_ModBusBase.m_hEventArray[Event]);
if (self.m_ModBusBase.GetReceiveDataFlag()=true)then// 收到数据
self.m_ModBusBase.SetReceiveDataFlag(false)// 定时间隔结束
else // 说明接收数据模块没有刷新接收数据标志
Synchronize(self.m_ModBusBase.ReceiveDataEnd);
end;
end;
end;
timeKillEvent(TimerId1);
timeKillEvent(TimerId2);
SetEvent(self.m_ModBusBase.m_hThreadHasEnd);
end;

// TModBusBase 控件代码 /////////////////////////////////////////////////////

{

01-funci髇 ilegal
02-direcci髇 ilegal
04-error de trabajo del esclavo
05-el esclavo requiere m醩 tiempo
06-el esclavo est?ocupado y no atiende al query
07-time out
08-error de acceso a memoria del esclavo
09-error de comunicaci髇
10-controlador ocupado
11-puerto no iniciado
}



const SErrorCodes : Array[0..11] of String =
(' 00-No Hay Error',
' 01-Funci髇 ilegal',
' 02-Direcci髇 ilegal',

' ',
' 04-Error de trabajo del esclavo',
' 05-El esclavo requiere m醩 tiempo',
' 06-El esclavo est?ocupado y no atiende al query',
' 07-Time out',
' 08-Error de acceso a memoria del esclavo',
' 09-Error de comunicaci髇',
' 10-Controlador ocupado',
' 11-Puerto no iniciado' );



function CRC(BufferData : PByte;BufferSize:integer) : word;
var
Data: byte;
i,j: integer;
const
polinomio:word= $0A001;
begin
result:= $0FFFF;
for i:=0 to BufferSize-1 do
begin
data:= BufferData^;
for j:=1 to 8 do
begin
if (((data xor result) and $0001) = 1) then
result:=(result shr 1) xor polinomio
else
result:=result shr 1;
data:= data shr 1;
end;
inc(BufferData);
end;
end;

constructor TModBusBase.Create( AOwner: TComponent );
begin

inherited Create( AOwner );
m_hEndThreadEvent:=CreateEvent(nil,True,False,nil);
m_hTimerSendDataEvent:=CreateEvent(nil,True,False,nil);
m_hRecevieDataEndTimerEvent:=CreateEvent(nil,True,False,nil);
m_hThreadHasEnd:=CreateEvent(nil,True,False,nil);
m_hEventArray[0]:=m_hEndThreadEvent;
m_hEventArray[1]:=m_hTimerSendDataEvent;
m_hEventArray[2]:=m_hRecevieDataEndTimerEvent;
FSendDataTime:=50;
FReceiveDataTime:=15;
m_Thread:=nil;
InitializeCriticalSection(m_csReceiveData);
InitializeCriticalSection(m_csWriteBuff);
self.m_WriteBuff:=TList.Create;
FOnTimeSendData:=nil;
FOnError:=nil;
FOnReceiveDataEnd:=nil;
end;

destructor TModBusBase.Destroy;
var i:integer;
buff:PDataByte;
begin
if (m_Thread<>nil)then
StopThread;
CloseHandle(m_hEndThreadEvent);
CloseHandle(m_hTimerSendDataEvent);
CloseHandle(m_hRecevieDataEndTimerEvent);
CloseHandle(m_hThreadHasEnd);
DeleteCriticalSection(m_csReceiveData);
DeleteCriticalSection(m_csWriteBuff);
for i:=0 to self.m_WriteBuff.Count-1 do
begin
buff:=self.m_WriteBuff.Items[i];
Dispose(buff);
end;
self.m_WriteBuff.Free;
inherited Destroy;
end;

procedure TModBusBase.StartThread;
begin
if (m_Thread<>nil)then
exit;
SetLength(m_ReceiveBuff,0);
m_Thread:=TModBusBaseThread.Create(true);
m_Thread.m_ModBusBase:=self;
m_Thread.Resume;
end;

procedure TModBusBase.ClearSendBuffList;
var buff:PDataByte;
begin
EnterCriticalSection(m_csWriteBuff);
while (self.m_WriteBuff.Count>0)do
begin
buff:=self.m_WriteBuff.Items[0];
Dispose(buff);
self.m_WriteBuff.Delete(0);
end;
LeaveCriticalSection(m_csWriteBuff);
end;

procedure TModBusBase.ClearReceiveBuff;
begin
EnterCriticalSection(m_csReceiveData);
SetLength(self.m_ReceiveBuff,0);
LeaveCriticalSection(m_csReceiveData);
end;

procedure TModBusBase.StopThread;
var Event:DWORD;
loop:boolean;
count:integer;
begin
if (m_Thread=nil)then
exit;
SetEvent(self.m_hEndThreadEvent);
// 清除发送链表和接收缓冲区
self.ClearSendBuffList;
self.

ClearReceiveBuff;
//
loop:=true;
count:=0;
while (loop)do
begin
Event := WaitForMultipleObjects(1,@self.m_hThreadHasEnd, FALSE,50);
case Event of
0:
begin
ResetEvent(self.m_hThreadHasEnd);
loop:=false;
end;
else
begin
if (count>10)then // 500毫秒延时后线程没有结束则直接结束线程
begin
TerminateThread(self.m_Thread.Handle,0);
loop:=false;
end;
inc(count);
Application.ProcessMessages;
end;
end;
end;
if (Assigned(m_Thread))then
begin
m_Thread.Free;
m_Thread:=nil;
end;
end;

function TModBusBase.GetReceiveDataFlag():boolean;
begin
EnterCriticalSection(m_csReceiveData);
Result:=self.m_ReceiveDataFlag;
LeaveCriticalSection(m_csReceiveData);
end;

procedure TModBusBase.SetReceiveDataFlag(Value:boolean);
begin
EnterCriticalSection(m_csReceiveData);
self.m_ReceiveDataFlag:=Value;
LeaveCriticalSection(m_csReceiveData);
end;

// 通信模块调用的函数,接收到一个字符
procedure TModBusBase.ReceiveChar(ch:Byte);
begin
EnterCriticalSection(m_csReceiveData);
self.m_ReceiveDataFlag:=true;
SetLength(m_ReceiveBuff,Length(m_ReceiveBuff)+1);
m_ReceiveBuff[Length(m_ReceiveBuff)-1]:=ch;
LeaveCriticalSection(m_csReceiveData);
end;
// 收包完成(由线程调用),校验数据完整性,通知其它模块对数据包进行处理
procedure TModBusBase.ReceiveDataEnd;
var address,func:byte;
data:TDataByte;
data_len:integer;
begin
EnterCriticalSection(m_csReceiveData);
if (Length(self.m_ReceiveBuff)=0)then
begin
LeaveCriticalSection(m_csReceiveData);
exit;
end;
SetLength(data,Length(m_ReceiveBuff));
if (DecodeData(address,func,PByte(data),data_len,PByte(m_ReceiveBuff),Length(m_ReceiveBuff))=true)then
begin
if (Assigned(FOnReceiveDataEnd))then
FOnReceiveDataEnd(self,address,func,PByte(data),data_len);
end;
SetLength(m_ReceiveBuff,0);
LeaveCriticalSection(m_csReceiveData);
end;
// 封装数据包
procedure TModBusBase.EncodeData(DeviceAddress,FunctionId:Byte;DataStr:PByte;DataSize:integer;
PackStr:PByte;var PackSize:integer);
var data_crc: word;
p_data,p_pack: PByte;
i: Integer;
begin
PackSize:=4+DataSize;
p_pack:=PackStr;
p_data:=DataStr;
p_pack^:=DeviceAddress;
inc(p_pack);
p_pack^:=FunctionId;
inc(p_pack);
for i:=1 to DataSize do
begin
p_pack^:=p_data^;
inc(p_pack);
inc(p_data);
end;
data_crc:=CRC(PackStr,DataSize+2);
p_pack^:=lo(data_crc);
inc(p_pack);
p_pack^:=hi(data_crc);
end;
// 解析数据包
function TModBusBase.DecodeData(var DeviceAddress,FunctionId:Byte;DataStr:PByte;var DataSize:integer;
PackStr:PByte;PackSize:integer):boolean;
var data_crc: word;
p_data,p_pack: PByte;
i: Integer;
crc_h,cr

c_l:byte;
begin
data_crc:=CRC(PackStr,PackSize-2);
p_pack:=PackStr;
inc(p_pack,PackSize-2);
crc_l:=p_pack^;
inc(p_pack);
crc_h:=p_pack^;
if (lo(data_crc)<>crc_l)or(hi(data_crc)<>crc_h)then
begin
Result:=false;
exit;
end;
// 校验通过,解析地址、功能码和数据
p_pack:=PackStr;
DeviceAddress:=p_pack^;
inc(p_pack);
FunctionId:=p_pack^;
inc(p_pack);
p_data:=DataStr;
for i:=1 to PackSize-4 do
begin
p_data^:=p_pack^;
inc(p_pack);
inc(p_data);
end;
DataSize:=PackSize-4;
Result:=true;
end;

procedure TModBusBase.AddOneDataPack(Address,FuncId:Byte;DataStr:PByte;DataSize:integer);
var buff:PDataByte;
len:integer;
begin
EnterCriticalSection(m_csWriteBuff);
New(buff);
SetLength(buff^,DataSize+4);
self.EncodeData(Address,FuncId,DataStr,DataSize,PByte(buff^),len);
self.m_WriteBuff.Add(buff);
LeaveCriticalSection(m_csWriteBuff);
end;

procedure TModBusBase.SendOneDataPack;
var buff:PDataByte;
begin
buff:=nil;
EnterCriticalSection(m_csWriteBuff);
if (self.m_WriteBuff.Count>0)then
begin
buff:=self.m_WriteBuff.Items[0];
if (Assigned(self.FOnTimeSendData))then
begin
try
self.FOnTimeSendData(self,PByte(buff^),Length(buff^));
except
end;
end;
Dispose(buff);
self.m_WriteBuff.Delete(0);
end
else
begin
if (Assigned(self.FOnTimeSendData))then
begin
try
self.FOnTimeSendData(self,nil,0);
except
end;
end;
end;
LeaveCriticalSection(m_csWriteBuff);
end;

end.



相关文档
最新文档