udeltaplc.pas

台达PLC通信用

unit UDeltaPLC;


interface
    uses RxTimer,SysUtils,DateUtils,forms;

const
    MAX_POINT_COUNT=16; //最大16个点

type
  TKmtPlc=Class
        bConn:Boolean;
        iPort:Integer;
        bOutputStat:array [1..MAX_POINT_COUNT] of Boolean;
        bInputStat:array [1..MAX_POINT_COUNT] of Boolean;
        tmReadStat:TRxTimer;              //不断的读状态
        procedure InputStat(sStr:String);
        procedure OutputStat(sStr:String);

        constructor Create(_iPort:Integer);
        destructor Destroy();override;
        procedure InitPLC();
        Procedure OnReadStatEvent(Sender:TObject);
        procedure SendData(sData:String);
        Function ReadResFromPort():String;
        procedure SetOutputStat(iIndex:Integer;bStat:Boolean);
        Function CheckConn():String;
  End;

var
    KmtPlc:TKmtPlc;

implementation

uses PComm;

Function mypower(n,m:Integer):Integer;
var
    i,iRes:Integer;
Begin
    iRes:=1;
    for i:=1 to m do
        iRes:=iRes*n;
    Result:=iRes;
End;

procedure TKmtPlc.InitPLC();
var
    i:Integer;
Begin
    for i:=1 to 16 do
    Begin
        sleep(50);
        SetOutputStat(i-1,false);
    End;
End;
constructor TKmtPlc.Create(_iPort:Integer);
var
    i:Integer;
Begin
    iPort:=_iPort;
    bConn:=True;
    tmReadStat:=TRxTimer.Create(nil);
    tmReadStat.Interval:=300;
    tmReadStat.OnTimer:=OnReadStatEvent;
    tmReadStat.Enabled:=False;
    //初始化输入输出状态
    for i:=1 to 16 do
    Begin
        bOutputStat[i]:=false;
        bInputStat[i]:=false;
    End;
End;

destructor TKmtPlc.Destroy();
Begin
    tmReadStat.Enabled:=false;
    tmReadStat.Destroy;
//    inherited;
End;

Function HexToInt(Hex : string) : Integer;
const cHex = '0123456789ABCDEF';
    var mult,i,loop : integer;
begin
    result := 0;
    mult := 1;
    for loop := length(Hex) downto 1 do
    begin
        i := pos(Hex[loop],cHex)-1;
        if (i < 0) then i := 0;
            inc(result,(i*mult));
        mult := mult * 16;
    end;
end;

Function LRC(str :String) :String;
var
	c,l:Integer;
	c_Data:String;
    d_lrc:integer;
    h_lrc:String;
Begin
    c := 0;
    l := Length(str) div 2 ;
    d_lrc:=0;
    For c := 1 To l  do
	Begin
         c_data := Copy(str, c*2-1, 2)   ;
         d_lrc := d_lrc + HexToInt(c_data);
    End;
    If d_lrc > 255 Then
	Begin
        d_lrc := d_lrc Mod 256;
    End;
    h_lrc := IntToHex(256 - d_lrc,4);
    If Length(h_lrc) > 2 Then
	Begin
        h_lrc := Copy(h_lrc, Length(h_lrc) - 1, 2)
    End;
    LRC := h_lrc;
end;

procedure TKmtPlc.SendData(sData:String);
var
    buffer : Array[1..255] of char;
    i,iLen:Integer;
    sStr,sLRC:String;
begin
    sLRC:=LRC(sData);
    sStr:=':'+sData+sLRC+#13+#10;
    iLen:=length(sStr);
    if iLen>255 then Exit;
    for i:=1 to iLen do
        buffer[i]:=sStr[i];
    sio_write(iPort,@buffer,iLen);
end;
Function TKmtPlc.CheckConn():String;
var
    iLen:integer;
	sSave:String;
Begin
    sSave:='';
    iLen:=sio_getch(iPort);
    while iLen>=0 do  //包含Asc为０的字符
    begin
        if iLen>=0 then
        begin
            sSave:=sSave+Chr(iLen);
        end
        else
        Begin
            break;
        End;
        iLen:=sio_getch(iPort);
    end;
    Result:=sSave;
End;
Function TKmtPlc.ReadResFromPort():String;
var
    iLen:integer;
	sSave:String;
    dtInTime:TDateTime;
    iTime:Integer;
Begin
    dtInTime:=Now();
    sSave:='';
    repeat
        iLen:=sio_getch(iPort);
        if iLen>=0 then
        begin
            bConn:=True;
            sSave:=sSave+Chr(iLen);
        end;
        if Length(sSave)>3 then
        Begin
           if Copy(sSave,Length(sSave)-1,2)=#13#10 then
           Begin
               break;
           End;
        End;
        iTime:=SecondsBetween(now(),dtInTime);
        if iTime>=3 then
        Begin
            bConn:=false;
            Break;
        End;
    until false;

    Result:=sSave;
End;

procedure TKmtPlc.SetOutputStat(iIndex:Integer;bStat:Boolean);
var
   sCmd:String;
begin
    tmReadStat.Enabled:=false;
    if bStat then
    Begin
        sCMD:='010505'+IntToHex(iIndex-1,2)+'FF00';
    End
    else
    Begin
        sCMD:='010505'+IntToHex(iIndex-1,2)+'0000';
    End;
        SendData(sCMD);
        ReadResFromPort();
    tmReadStat.Enabled:=true;
end;

procedure TKmtPlc.InputStat(sStr:String);
var
    sStat:String;
    iStat:Integer;
    i:Integer;
Begin
//输入状态：:0102020000FB
    sStat:=Copy(sStr,8,2);
    iStat:=HexToInt(sStat);
    for i:=1 to 8 do
    Begin
        if ((iStat and mypower(2,i-1))<>0) then
            bInputStat[i]:=True
        Else
            bInputStat[i]:=False;
    end;
    sStat:=Copy(sStr,10,2);
    iStat:=HexToInt(sStat);
    for i:=1 to 8 do
    Begin
        if ((iStat and mypower(2,i-1))<>0) then
            bInputStat[i+8]:=True
        Else
            bInputStat[i+8]:=False;
    end;
End;

procedure TKmtPlc.OutputStat(sStr:String);
var
    sStat:String;
    iStat:Integer;
    i:Integer;
Begin
    sStat:=Copy(sStr,8,2);
    iStat:=HexToInt(sStat);
    for i:=1 to 8 do
    Begin
        if ((iStat and mypower(2,i-1))<>0) then
            bOutputStat[i]:=True
        Else
            bOutputStat[i]:=False;
    end;
    sStat:=Copy(sStr,10,2);
    iStat:=HexToInt(sStat);
    for i:=1 to 8 do
    Begin
        if ((iStat and mypower(2,i-1))<>0) then
            bOutputStat[i+8]:=True
        Else
            bOutputStat[i+8]:=False;
    end;
End;

Procedure TKmtPlc.OnReadStatEvent(Sender:TObject);           //时钟事件
var
    sStr:String;
begin
    SendData('010205000008');   //取输出状态
        sStr:=ReadResFromPort();
        if sStr<>'' then
        Begin
            OutputStat(sStr);
        End;
    SendData('010204000010');   //取输入状态
        sStr:=ReadResFromPort();
        if sStr<>'' then
        Begin
            InputStat(sStr);
        End;
end;

end.