Files
2026-05-07 20:25:34 +08:00

440 lines
14 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit uPLCDevice;
interface
uses System.Win.ScktComp,uSafeLog,uErrorInfo,System.SysUtils,FMX.Types,
System.StrUtils,System.Classes,WinSock,WinSock2,Winapi.Windows;
type
TPlcWorkEvent = procedure(Sender: TObject;sValue:string) of object;
TPlcOpenEvent = procedure(Sender: TObject;sValue:string) of object;
//500000FFFF0300 0C00 010001040000 7A0000 A8 0100
//500000FFFF0300 0e00 010001140000 7A0000 A8 0100 c9 00
TMelsec=class //三棱plc
private
bIsDestory:boolean;
FTimer: TTimer;
FOnWork:TPlcWorkEvent;
FOnShowState:TPlcWorkEvent;
FOnOpen: TPlcOpenEvent;
FSocket:TClientSocket;
FNum:Integer; //编号
procedure TimerTimer(Sender: TObject); //判断连接状态,断开的话,自动重连
procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket); //读缓存数据
procedure SocketError(Sender: TObject; Socket: TCustomWinSocket; //出错代码处理
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure SocketDisConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure SocketConnecting(Sender: TObject; Socket: TCustomWinSocket);
public
property Num:Integer read FNum write FNum;
constructor Create(sIp:string;iPort:integer);
destructor Destroy; override;
procedure Close();
procedure Connect();
procedure DisConnect();
procedure Open(Sender: TObject;sValue: string);
property OnWork: TPlcWorkEvent read FOnWork write FOnWork;//业务处理事件
property OnShowState:TPlcWorkEvent read FOnShowState write FOnShowState;//显示连接断开提示
property OnOpen: TPlcOpenEvent read FOnOpen write FOnOpen;//提交协议plc处理事件
end;
TOmron=class //欧姆龙plc
private
bIsDestory:boolean;
FTimer: TTimer;
FOnWork:TPlcWorkEvent;
FOnShowState:TPlcWorkEvent;
FOnOpen: TPlcOpenEvent;
FSocket:TClientSocket;
FNum:Integer; //编号
procedure TimerTimer(Sender: TObject); //判断连接状态,断开的话,自动重连
procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket); //读缓存数据
procedure SocketError(Sender: TObject; Socket: TCustomWinSocket; //出错代码处理
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure SocketDisConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure SocketConnecting(Sender: TObject; Socket: TCustomWinSocket);
public
property Num:Integer read FNum write FNum;
constructor Create(sIp:string;iPort:integer);
destructor Destroy; override;
procedure Open();
procedure Close();
procedure Connect();
procedure DisConnect();
property OnWork: TPlcWorkEvent read FOnWork write FOnWork;//业务处理事件
property OnShowState:TPlcWorkEvent read FOnShowState write FOnShowState;//显示连接断开提示
property OnOpen: TPlcOpenEvent read FOnOpen write FOnOpen;//提交协议plc处理事件
end;
implementation
{ TMelsec }
///////////////////////////////////////////////////////////////////////////////
constructor TMelsec.Create(sIp:string;iPort:integer); //参数固定
begin
inherited Create;
bIsDestory:=false;
FNum:=1;
WorkLog.Debug('创建Melsec读头');
FSocket:=TClientSocket.Create(nil);
FSocket.OnRead:=SocketRead;
FSocket.OnError:=SocketError;
FSocket.OnConnect:=SocketConnect;
FSocket.OnDisconnect:=SocketDisConnect;
FSocket.OnConnecting:=SocketConnecting;
FSocket.Address:=sIp;
FSocket.Port:=iPort;
FTimer:=TTimer.Create(nil);
FTimer.OnTimer:=TimerTimer;
FTimer.Enabled:=false;
end;
procedure TMelsec.Connect();
var
tmp:string;
begin
tmp:=Format('连接Melsec读头%d:%s,%d',[FNum,FSocket.Address,FSocket.Port]);
WorkLog.Debug(tmp);
if Assigned(FOnShowState) then FOnShowState(self,tmp);
FSocket.Active:=true;
end;
procedure TMelsec.DisConnect();
begin
FSocket.Close;
FTimer.Enabled:=false;
end;
procedure TMelsec.SocketConnecting(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Melsec读头%d连接中...',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self,Format('Melsec读头%d连接中...',[FNum]));
end;
destructor TMelsec.Destroy;
begin
bIsDestory:=true;
FSocket.Close;
FTimer.Enabled:=false;
WorkLog.Debug('销毁Melsec读头');
FSocket.Free;
FTimer.Free;
inherited Destroy;
end;
procedure TMelsec.SocketDisConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Melsec读头%d连接断开',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self,Format('Melsec读头%d连接断开',[FNum]));
end;
//procedure TMelsec.SetKeepAlive(Socket: TCustomWinSocket);
//var
// opt:DWORD;
// klive, outKlive: TTCP_KEEPALIVE;
// i,j:integer;
// // OptVal: DWORD;
//begin
// opt := 1;
// if setsockopt(Socket.SocketHandle,SOL_SOCKET, SO_KEEPALIVE, PAnsiChar(@opt), SizeOf(opt)) = SOCKET_ERROR then
// begin
// //showInfo(Format('WinSock Error %d', [WSAGetLastError()]));
// end;
// klive.onoff := 1;
// klive.keepalivetime := 5000;
// klive.keepaliveinterval := 1;
//
// if WSAIoctl(Socket.SocketHandle, SIO_KEEPALIVE_VALS, PAnsiChar(@klive),
// SizeOf(TTCP_KEEPALIVE), PAnsiChar(@outKlive),
// SizeOf(TTCP_KEEPALIVE), opt,0,nil) = SOCKET_ERROR then
// begin
// //showInfo(Format('WinSock Error %d', [WSAGetLastError()]));
// end;
//
//end;
procedure TMelsec.TimerTimer(Sender: TObject);
begin
if FTimer.Enabled then
begin
FTimer.Enabled:=false;
FSocket.Close;
FSocket.Open;
end;
end;
procedure TMelsec.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
buf:array[0..1024] of byte;
sHexString:string;
i:Integer;
sData:string;
function ByteToString(const Value:PByte;iLen:Integer): String;
var
I: integer;
S : String;
begin
S := '';
for I := 0 to iLen-1 do
begin
if Value[i]=$0D then break;
S := S+Chr(Value[I]);
end;
Result := S;
end;
begin
if bIsDestory then Exit;
sHexString:='';
for i:= 0 to Socket.ReceiveBuf(buf,1024) do
begin
sHexString:=sHexString+buf[i].ToHexString;
end;
WorkLog.Debug('Melsec读头%d读到数据:%s',[FNum,sHexString]);
sData:=ByteToString(@buf[0],Length(sHexString)div 2);
if Assigned(FOnWork) then FOnWork(self,sData);
end;
procedure TMelsec.SocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
tmpError:string;
begin
if (ErrorCode=10060) OR (ErrorCode=10065) then
begin
tmpError:=Format('Melsec读头%d连接出错(%d):%s',[FNum,ErrorCode,SysErrorMessage(ErrorCode)]);
if Assigned(FOnShowState) then FOnShowState(self,Format('Melsec读头%d连接失败,重新连接',[FNum]));
end
else
begin
tmpError:=Format('Melsec读头%d连接出错(%d):%s',[FNum,ErrorCode,SysErrorMessage(ErrorCode)]);
if Assigned(FOnShowState) then FOnShowState(self,'Melsec读头连接出错:'+SysErrorMessage(ErrorCode));
end;
workLog.Error(tmpError);
ErrorCode:=0;
if bIsDestory then Exit;
FTimer.Enabled:=true;
end;
procedure TMelsec.SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Melsec读头%d连接成功',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self, Format('Melsec读头%d连接成功',[FNum]));
end;
procedure TMelsec.Close; //4C4F46460D
VAR
bBtye:array[0..4] of byte;
begin
bBtye[0]:=$4C;bBtye[1]:=$4F;bBtye[2]:=$46;
bBtye[3]:=$46;bBtye[4]:=$0D;
fSocket.Socket.SendBuf(bBtye[0],5);
WorkLog.Debug(Format('Melsec读头%d关闭',[FNum]));
end;
{
* 50 00 00 FF FF 03 00 0C 00 10 00 01 04 00 00 64 00 00 A8 14 0050 00 00 FF FF 03 00 0C 00 10 00 01 04 00 00 64 00 00 A8 14 00
*
* 电脑读命令: 50 00(命令) :表示发起指令,固定50 00;
00(网路编号) :上位访问下位,固定00;
FF(PLC编号) : 上位访问下位,固定FF;
FF 03(请求目标模块IO编号) : 值要从小到大看,也就是反过来看,三菱所有的协值都是这样,所以这里是03FF,十进制是1023; 也是固定的;
00(请求目标模块站编号) : 上位访问下位,固定00;
0C 00 (应答数据物理长度): 也要反过来,值是000C,也就是12;表示后面的报文内容的长度是12(手工数一下,后面报文长度真的是12)
10 00 (cpu监视定时器) 表示等待PLC响应的timeout时间;这里 值是0010,十进制是16 ;相当与最大等待时间250ms*16=4秒;实际上PLC一般2,3个毫秒内就响应了;
01 04 (命令) : 值是0401(所有值都要反过来看,再说就啰嗦了,后面不说了);表示批量读取;如果是1401就是随机读取;
00 00 (子命令) : 值是0表示按字读取(1个字=16位),如果值是1就按位读取;
64 00 00(首地址):地址因为跨度比较大,所以用了3个字节;这里的值是000064,十进制就是100
A8 (软元件) : 表示读取PLC寄存器的类型: 这里的A8表示D点;其他常见的有: 90-M点;9C-X点;9D-Y点;B0-ZR外部存储卡
14 00(读取长度) :值是0014,十进制就是20;
}
procedure TMelsec.Open(Sender: TObject;sValue: string); //4C4F4E0d
VAR
bBtye:array[0..4] of byte;
begin
if bIsDestory then Exit;
bBtye[0]:=$4C;bBtye[1]:=$4F;bBtye[2]:=$4E;
bBtye[3]:=$0D;
fSocket.Socket.SendBuf(bBtye[0],4);
WorkLog.Debug(Format('Melsec读头%d打开',[FNum]));
end;
{ TOmron }
///////////////////////////////////////////////////////////////////////////////
constructor TOmron.Create(sIp:string;iPort:integer); //参数固定
begin
inherited Create;
bIsDestory:=false;
FNum:=1;
WorkLog.Debug('创建Omron_plc读头');
FSocket:=TClientSocket.Create(nil);
FSocket.OnRead:=SocketRead;
FSocket.OnError:=SocketError;
FSocket.OnConnect:=SocketConnect;
FSocket.OnDisconnect:=SocketDisConnect;
FSocket.OnConnecting:=SocketConnecting;
FSocket.Address:=sIp;
FSocket.Port:=iPort;
FTimer:=TTimer.Create(nil);
FTimer.OnTimer:=TimerTimer;
FTimer.Enabled:=false;
end;
procedure TOmron.Connect();
var
tmp:string;
begin
tmp:=Format('连接Omron_plc读头%d:%s,%d',[FNum,FSocket.Address,FSocket.Port]);
WorkLog.Debug(tmp);
if Assigned(FOnShowState) then FOnShowState(self, tmp);
FSocket.Active:=true;
end;
procedure TOmron.DisConnect();
begin
FSocket.Close;
FTimer.Enabled:=false;
end;
procedure TOmron.SocketConnecting(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Omron_plc读头%d连接中...',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self,Format('Omron_plc读头%d连接中...',[FNum]));
end;
destructor TOmron.Destroy;
begin
bIsDestory:=true;
FSocket.Close;
FTimer.Enabled:=false;
WorkLog.Debug('销毁Omron_plc读头');
FSocket.Free;
FTimer.Free;
inherited Destroy;
end;
procedure TOmron.SocketDisConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Omron_plc读头%d连接断开',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self, Format('Omron_plc读头%d连接断开',[FNum]));
end;
procedure TOmron.TimerTimer(Sender: TObject);
begin
if FTimer.Enabled then
begin
FTimer.Enabled:=false;
FSocket.Close;
FSocket.Open;
end;
end;
procedure TOmron.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
buf:array[0..1024] of byte;
sHexString:string;
i:Integer;
sData:string;
function ByteToString(const Value:PByte;iLen:Integer): String;
var
I: integer;
S : String;
begin
S := '';
for I := 0 to iLen-1 do
begin
if Value[i]=$0D then break;
S := S+Chr(Value[I]);
end;
Result := S;
end;
begin
if bIsDestory then Exit;
sHexString:='';
for i:= 0 to Socket.ReceiveBuf(buf,1024) do
begin
sHexString:=sHexString+buf[i].ToHexString;
end;
WorkLog.Debug('Omron_plc读头%d读到数据:%s',[FNum,sHexString]);
sData:=ByteToString(@buf[0],Length(sHexString)div 2);
if Assigned(FOnWork) then FOnWork(self, sData);
end;
procedure TOmron.SocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
tmpError:string;
begin
if (ErrorCode=10060) OR (ErrorCode=10065) then
begin
tmpError:=Format('Omron_plc读头%d连接出错(%d):%s',[FNum,ErrorCode,SysErrorMessage(ErrorCode)]);
if Assigned(FOnShowState) then FOnShowState(self, Format('Omron_plc读头%d连接失败,重新连接',[FNum]));
end
else
begin
tmpError:=Format('Omron_plc读头%d连接出错(%d):%s',[FNum,ErrorCode,SysErrorMessage(ErrorCode)]);
if Assigned(FOnShowState) then FOnShowState(self, 'Omron_plc读头连接出错:'+SysErrorMessage(ErrorCode));
end;
workLog.Error(tmpError);
ErrorCode:=0;
if bIsDestory then Exit;
FTimer.Enabled:=true;
end;
procedure TOmron.SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
WorkLog.Debug(Format('Omron_plc读头%d连接成功',[FNum]));
if Assigned(FOnShowState) then FOnShowState(self, Format('Omron_plc读头%d连接成功',[FNum]));
end;
procedure TOmron.Close; //4C4F46460D
Var
bBtye:array[0..4] of byte;
begin
bBtye[0]:=$4C;bBtye[1]:=$4F;bBtye[2]:=$46;
bBtye[3]:=$46;bBtye[4]:=$0D;
fSocket.Socket.SendBuf(bBtye[0],5);
WorkLog.Debug(Format('Omron_plc读头%d关闭',[FNum]));
end;
{*
* 头标识 46494E53 即为ASCII码:FINS
长度 0000000C 后续字节长度=12
命令码 00000000 为0
错误代码 00000000 为0
客户端节点地址 00000000 to 000000FE 0到254,为0服务端会自动分配节点号
*
* 服务端接收到连接请求后,返回帧格式如下:
名称 内容 说明
头标识 46494E53 ASCII:FINS
长度 00000010 从命令码开始的数据长度
命令码 00000001 固定值00000001
错误码 4个字节错误信息 参考错误信息码表
客户端节点地址 00000001 to 000000FE 1到254
服务端节点地址 00000001 to 000000FE 1到254
46 49 4E 53 00 00 00 10 00 00 00 01 00 00 00 00 00 00 00 71 00 00 00 0A
*}
procedure TOmron.Open; //4C4F4E0d
VAR
bBtye:array[0..4] of byte;
begin
if bIsDestory then Exit;
bBtye[0]:=$4C;bBtye[1]:=$4F;bBtye[2]:=$4E;
bBtye[3]:=$0D;
fSocket.Socket.SendBuf(bBtye[0],4);
WorkLog.Debug(Format('Omron_plc读头%d打开',[FNum]));
end;
end.