diff --git a/fhem/FHEM/44_S7.pm b/fhem/FHEM/44_S7.pm new file mode 100644 index 000000000..1017b98f3 --- /dev/null +++ b/fhem/FHEM/44_S7.pm @@ -0,0 +1,1143 @@ +# $Id$ +#################################################### + +package main; + +use strict; +use warnings; +#use Devel::NYTProf; #profiler + + +require "44_S7_Client.pm"; + +my %gets = ( + "S7TCPClientVersion" => "", + "PLCTime" => "" +); + +my @areasconfig = ( + "ReadInputs-Config", "ReadOutputs-Config", + "ReadFlags-Config", "ReadDB-Config", + "WriteInputs-Config", "WriteOutputs-Config", + "WriteFlags-Config", "WriteDB-Config" +); +my @s7areas = ( + &S7Client::S7AreaPE, &S7Client::S7AreaPA, &S7Client::S7AreaMK, + &S7Client::S7AreaDB, &S7Client::S7AreaPE, &S7Client::S7AreaPA, + &S7Client::S7AreaMK, &S7Client::S7AreaDB +); +my @areaname = + ( "inputs", "outputs", "flags", "db", "inputs", "outputs", "flags", "db" ); + +##################################### +sub S7_Initialize($) { + my $hash = shift @_; + + # Provider + $hash->{Clients} = ":S7_DRead:S7_ARead:S7_AWrite:S7_DWrite:"; + my %matchList = ( + "1:S7_DRead" => "^DR", + "2:S7_DWrite" => "^DW", + "3:S7_ARead" => "^AR", + "4:S7_AWrite" => "^AW" + ); + + $hash->{MatchList} = \%matchList; + + # Consumer + $hash->{DefFn} = "S7_Define"; + $hash->{UndefFn} = "S7_Undef"; + $hash->{GetFn} = "S7_Get"; + $hash->{AttrFn} = "S7_Attr"; + $hash->{AttrList} = "MaxMessageLength " . $readingFnAttributes; + + # $hash->{AttrList} = join( " ", @areasconfig )." PLCTime"; +} + +##################################### +sub S7_connect($) { + my $hash = shift @_; + + my $name = $hash->{NAME}; + + if ( $hash->{STATE} eq "connected to PLC" ) { + Log3 $name, 2, "$name S7_connect: allready connected!"; + return; + } + + Log3 $name, 4, + "S7: $name connect ip_address=" + . $hash->{ipAddress} + . ", LocalTSAP=" + . $hash->{LocalTSAP} + . ", RemoteTSAP=" + . $hash->{RemoteTSAP} . " "; + + + if ( !defined( $hash->{S7TCPClient} ) ) { + S7_reconnect($hash); + return; + } + + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + + $hash->{S7TCPClient} + ->SetConnectionParams( $hash->{ipAddress}, $hash->{LocalTSAP}, + $hash->{RemoteTSAP} ); + + my $res; + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + Log3 $hash, 0, "S7_connect: $s"; + $res = -1; + }; + $res = $hash->{S7TCPClient}->Connect(); + }; + + if ($res) { + Log3 $name, 2, "S7_connect: $name Could not connect to PLC ($res)"; + return; + } + + my $PDUlength = $hash->{S7TCPClient}->{PDULength}; + $hash->{maxPDUlength} = $PDUlength; + + Log3 $name, 3, + "$name S7_connect: connect to PLC with maxPDUlength=$PDUlength"; + + $hash->{STATE} = "connected to PLC"; + main::readingsSingleUpdate( $hash, "state", "connected to PLC", 1 ); + + + return undef; + +} + +##################################### +sub S7_disconnect($) { + my $hash = shift @_; + my ( $ph, $res, $di); + my $name = $hash->{NAME}; + my $error = ""; + + $hash->{S7TCPClient}->Disconnect() if ( defined( $hash->{S7TCPClient} ) ); + $hash->{S7TCPClient} = undef; #TCP Client freigeben + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + + Log3 $name, 2, "$name S7 disconnected"; + +} + +##################################### +sub S7_reconnect($) { + my $hash = shift @_; + S7_disconnect($hash) if ( defined( $hash->{S7TCPClient} ) ); + + $hash->{S7TCPClient} = S7Client->new(); + InternalTimer( gettimeofday() + 3, "S7_connect", $hash, 1 ) + ; #wait 3 seconds for reconnect +} + +##################################### +sub S7_Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $ip_address, $LocalTSAP, $RemoteTSAP, $res, $PDUlength, $rack, + $slot ); + + $name = $a[0]; + + if ( uc $a[2] eq "LOGO7" || uc $a[2] eq "LOGO8" ) { + $ip_address = $a[3]; + $LocalTSAP = 0x0100; + $RemoteTSAP = 0x0200; + $hash->{Interval} = 1; + if ( uc $a[2] eq "LOGO7" ) { + $hash->{S7TYPE} = "LOGO7"; + } + else { + $hash->{S7TYPE} = "LOGO8"; + } + $PDUlength = 240; + + } + else { + + $ip_address = $a[2]; + + $rack = int( $a[3] ); + return "invalid rack parameter (0 - 15)" + if ( $rack < 0 || $rack > 15 ); + + $slot = int( $a[4] ); + return "invalid slot parameter (0 - 15)" + if ( $slot < 0 || $slot > 15 ); + + $hash->{Interval} = 1; + if ( int(@a) == 6 ) { + $hash->{Interval} = int( $a[5] ); + return "invalid intervall parameter (1 - 86400)" + if ( $hash->{Interval} < 1 || $hash->{Interval} > 86400 ); + } + $LocalTSAP = 0x0100; + $RemoteTSAP = ( &S7Client::S7_PG << 8 ) + ( $rack * 0x20 ) + $slot; + + $PDUlength = 0x3c0; + + $hash->{S7TYPE} = "NATIVE"; + } + + $hash->{ipAddress} = $ip_address; + $hash->{LocalTSAP} = $LocalTSAP; + $hash->{RemoteTSAP} = $RemoteTSAP; + $hash->{maxPDUlength} = $PDUlength; #initial PDU length + + Log3 $name, 4, +"S7: define $name ip_address=$ip_address,LocalTSAP=$LocalTSAP, RemoteTSAP=$RemoteTSAP "; + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + + S7_connect($hash); + + InternalTimer( gettimeofday() + $hash->{Interval}, + "S7_GetUpdate", $hash, 0 ); + + return undef; +} + +##################################### +sub S7_Undef($) { + my $hash = shift; + + RemoveInternalTimer($hash); + + S7_disconnect($hash); + + delete( $modules{S7}{defptr} ); + + return undef; +} + +##################################### +sub S7_Get($@) { + my ( $hash, @a ) = @_; + return "Need at least one parameters" if ( @a < 2 ); + return "Unknown argument $a[1], choose one of " + . join( " ", sort keys %gets ) + if ( !defined( $gets{ $a[1] } ) ); + my $name = shift @a; + my $cmd = shift @a; + + ARGUMENT_HANDLER: { + $cmd eq "S7TCPClientVersion" and do { + + return $hash->{S7TCPClient}->version(); + last; + }; + $cmd eq "PLCTime" and do { + return $hash->{S7TCPClient}->getPLCDateTime(); + last; + }; + } + +} + +##################################### +sub S7_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + my $hash = $defs{$name}; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + + if ( $cmd eq "set" ) { + if ( $aName eq "MaxMessageLength" ) { + + if ( $aVal < $hash->{S7TCPClient}->{MaxReadLength} ) { + + $hash->{S7TCPClient}->{MaxReadLength} = $aVal; + + Log3 $name, 3, "$name S7_Attr: setting MaxReadLength= $aVal"; + } + } + ########### + + if ( $aName eq "WriteInputs-Config" + || $aName eq "WriteOutputs-Config" + || $aName eq "WriteFlags-Config" + || $aName eq "WriteDB-Config" ) + { + my $PDUlength = $hash->{maxPDUlength}; + + my @a = split( "[ \t][ \t]*", $aVal ); + if ( int(@a) % 3 != 0 || int(@a) == 0 ) { + Log3 $name, 3, + "S7: Invalid $aName in attr $name $aName $aVal: $@"; + return +"Invalid $aName $aVal \n Format: [ ]"; + } + else { + + for ( my $i = 0 ; $i < int(@a) ; $i++ ) { + if ( $a[$i] ne int( $a[$i] ) ) { + my $s = $a[$i]; + Log3 $name, 3, +"S7: Invalid $aName in attr $name $aName $aVal ($s is not a number): $@"; + return "Invalid $aName $aVal: $s is not a number"; + } + if ( $i % 3 == 0 && ( $a[$i] < 0 || $a[$i] > 1024 ) ) { + Log3 $name, 3, + "S7: Invalid $aName db. valid db 0 - 1024: $@"; + return + "Invalid $aName length: $aVal db: valid db 0 - 1024"; + + } + if ( $i % 3 == 1 && ( $a[$i] < 0 || $a[$i] > 32768 ) ) { + Log3 $name, 3, +"S7: Invalid $aName startposition. valid startposition 0 - 32768: $@"; + return +"Invalid $aName startposition: $aVal db: valid startposition 0 - 32768"; + + } + if ( $i % 3 == 2 + && ( $a[$i] < 1 || $a[$i] > $PDUlength ) ) + { + Log3 $name, 3, +"S7: Invalid $aName length. valid length 1 - $PDUlength: $@"; + return +"Invalid $aName lenght: $aVal: valid length 1 - $PDUlength"; + } + + } + + return undef if ( $hash->{STATE} ne "connected to PLC" ); + + #we need to fill-up the internal buffer from current PLC values + my $hash = $defs{$name}; + + my $res = + S7_getAllWritingBuffersFromPLC( $hash, $aName, $aVal ); + if ( int($res) != 0 ) { + + #quit because of error + return $res; + } + + } + } + } + return undef; +} + +##################################### + +sub S7_getAreaIndex4AreaName($) { + my ($aName) = @_; + + my $AreaIndex = -1; + for ( my $j = 0 ; $j < int(@areaname) ; $j++ ) { + if ( $aName eq $areasconfig[$j] || $aName eq $areaname[$j] ) { + $AreaIndex = $j; + last; + } + } + if ( $AreaIndex < 0 ) { + Log3 undef, 2, "S7_Attr: Internal error invalid WriteAreaIndex"; + return "Internal error invalid WriteAreaIndex"; + } + return $AreaIndex; + +} + +##################################### +sub S7_WriteToPLC($$$$$$) { + my ( $hash, $areaIndex, $dbNr, $startByte, $WordLen, $dataBlock ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + + my $res = -1; + my $Bufferlength = length($dataBlock); + + if ( $Bufferlength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + my $bss = join( ", ", unpack( "H2" x $Bufferlength, $dataBlock ) ); + Log3 $name, 5, +"$name S7_WriteToPLC: Write Bytes to PLC: $areaIndex, $dbNr,$startByte , $Bufferlength, $bss"; + + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3 $hash, 0, "DIE:$s"; + $res = -2; + }; + + $res = + $hash->{S7TCPClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $startByte, + $Bufferlength, $WordLen, $dataBlock ); + + }; + if ( $res != 0 ) { + my $error = $hash->{S7TCPClient}->getErrorStr($res); + + my $msg = "$name S7_WriteToPLC WriteArea error: $res=$error"; + Log3 $name, 3, $msg; + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + } + else { + my $msg = "$name S7_WriteToPLC: PLC is not connected "; + + Log3 $name, 3, $msg; + + S7_reconnect($hash); #lets try a reconnect + + return ( -2, $msg ); + } + + } + else { + my $msg = +"S7_WriteToPLC: wrong block length $Bufferlength (max length $PDUlength)"; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } +} +##################################### +sub S7_WriteBitToPLC($$$$$) { + my ( $hash, $areaIndex, $dbNr, $bitPosition, $bitValue ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + + my $res = -1; + my $Bufferlength = 1; + + if ( $Bufferlength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + my $bss = join( ", ", unpack( "H2" x $Bufferlength, $bitValue ) ); + Log3 $name, 5, +"$name S7_WriteBitToPLC: Write Bytes to PLC: $areaIndex, $dbNr, $bitPosition , $Bufferlength, $bitValue"; + + + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3 $hash, 0, "DIE:$s"; + $res = -2; + }; + + $res = + $hash->{S7TCPClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $bitPosition, + $Bufferlength, &S7Client::S7WLBit, chr($bitValue) ); + + + }; + if ( $res != 0 ) { + my $error = $hash->{S7TCPClient}->getErrorStr($res); + + my $msg = "$name S7_WriteBitToPLC WriteArea error: $res=$error"; + Log3 $name, 3, $msg; + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + } + else { + my $msg = "$name S7_WriteBitToPLC: PLC is not connected "; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } + + } + else { + my $msg = +"S7_WriteBitToPLC: wrong block length $Bufferlength (max length $PDUlength)"; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } +} + +##################################### +#sub S7_WriteBlockToPLC($$$$$) { +# my ( $hash, $areaIndex, $dbNr, $startByte, $dataBlock ) = @_; +# +# +# return S7_WriteToPLC($hash, $areaIndex, $dbNr, $startByte, &S7Client::S7WLByte, $dataBlock); +# +#} +##################################### + +sub S7_ReadBlockFromPLC($$$$$) { + my ( $hash, $areaIndex, $dbNr, $startByte, $requestedLength ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + my $readbuffer = ""; + my $res = -1; + + if ( $requestedLength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3 $hash, 0, "DIE:$s"; + $res = -2; + }; + + ( $res, $readbuffer ) = + $hash->{S7TCPClient}->ReadArea( $s7areas[$areaIndex], $dbNr, $startByte, + $requestedLength, &S7Client::S7WLByte ); + }; + + + if ( $res != 0 ) { + + my $error = $hash->{S7TCPClient}->getErrorStr($res); + my $msg = + "$name S7_ReadBlockFromPLC ReadArea error: $res=$error"; + Log3 $name, 3, $msg; + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + else { + + #reading was OK + return ( 0, $readbuffer ); + } + } + else { + my $msg = "$name S7_ReadBlockFromPLC: PLC is not connected "; + Log3 $name, 3, $msg; + return ( -1, $msg ); + + } + } + else { + my $msg = +"$name S7_ReadBlockFromPLC: wrong block length (max length $PDUlength)"; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } +} + +##################################### + +sub S7_setBitInBuffer($$$) { + my ( $bitPosition, $buffer, $newValue ) = @_; + + my $Bufferlength = ( length($buffer) + 1 ) / 3; + my $bytePosition = int( $bitPosition / 8 ); + +# Log3 undef, 3, "S7_setBitInBuffer in: ".length($buffer)." , $Bufferlength , $bytePosition , $bitPosition"; + + if ( $bytePosition < 0 || $bytePosition > $Bufferlength - 1 ) { + + #out off buffer request !!!!! + # Log3 undef, 3, "S7_setBitInBuffer out -1 : ".length($buffer); + + return ( -1, undef ); + } + + my @Writebuffer = unpack( "C" x $Bufferlength, + pack( "H2" x $Bufferlength, split( ",", $buffer ) ) ); + + #my $intrestingByte = $Writebuffer[$bytePosition]; + my $intrestingBit = $bitPosition % 8; + + if ( $newValue eq "on" || $newValue eq "trigger" ) { + $Writebuffer[$bytePosition] |= ( 1 << $intrestingBit ); + } + else { + $Writebuffer[$bytePosition] &= ( ( ~( 1 << $intrestingBit ) ) & 0xff ); + } + + my $resultBuffer = join( + ",", + unpack( + "H2" x $Bufferlength, + pack( "C" x $Bufferlength, @Writebuffer ) + ) + ); + + $Bufferlength = length($resultBuffer); + + # Log3 undef, 3, "S7_setBitInBuffer out: $Bufferlength"; + + return ( 0, $resultBuffer ); +} + +##################################### +sub S7_getBitFromBuffer($$) { + my ( $bitPosition, $buffer ) = @_; + + my $Bufferlength = ( length($buffer) * 3 ) - 1; + my $bytePosition = int( $bitPosition / 8 ); + if ( $bytePosition < 0 || $bytePosition > length($Bufferlength) ) { + + #out off buffer request !!!!! + return "unknown"; + } + my @Writebuffer = unpack( "C" x $Bufferlength, + pack( "H2" x $Bufferlength, split( ",", $buffer ) ) ); + + my $intrestingByte = $Writebuffer[$bytePosition]; + my $intrestingBit = $bitPosition % 8; + + if ( ( $intrestingByte & ( 1 << $intrestingBit ) ) != 0 ) { + + return "on"; + } + else { + return "off"; + } + +} + +##################################### +sub S7_getAllWritingBuffersFromPLC($$$) { + + #$hash ... from S7 physical modul + #$writerConfig ... writer Config + #$aName ... area name + + my ( $hash, $aName, $writerConfig ) = @_; + + Log3 $aName, 4, "S7: getAllWritingBuffersFromPLC called"; + + my @a = split( "[ \t][ \t]*", $writerConfig ); + + my $PDUlength = $hash->{maxPDUlength}; + + my @writingBuffers = (); + my $readbuffer; + + my $writeAreaIndex = S7_getAreaIndex4AreaName($aName); + return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) ); + + my $nr = int(@a); + + # Log3 undef, 4, "S7: getAllWritingBuffersFromPLC $nr"; + + my $res; + for ( my $i = 0 ; $i < int(@a) ; $i = $i + 3 ) { + my $readbuffer; + my $res; + + my $dbnr = $a[$i]; + my $startByte = $a[ $i + 1 ]; + my $requestedLength = $a[ $i + 2 ]; + + ( $res, $readbuffer ) = + S7_ReadBlockFromPLC( $hash, $writeAreaIndex, $dbnr, $startByte, + $requestedLength ); + if ( $res == 0 ) { #reading was OK + my $hexbuffer = + join( ",", unpack( "H2" x length($readbuffer), $readbuffer ) ); + push( @writingBuffers, $hexbuffer ); + } + else { + + #error in reading so just return the error MSG + return $readbuffer; + } + } + + if ( int(@writingBuffers) > 0 ) { + $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} = + join( " ", @writingBuffers ); + } + else { + $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} = undef; + } + return 0; +} + +##################################### +sub S7_GetUpdate($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + Log3 $name, 4, "S7: $name GetUpdate called ..."; + + my $res = S7_readFromPLC($hash); + + if ( $res == 0 ) { + InternalTimer( gettimeofday() + $hash->{Interval}, + "S7_GetUpdate", $hash, 1 ); + } + else { + + #an error has occoured --> 10sec break + InternalTimer( gettimeofday() + 10, "S7_GetUpdate", $hash, 1 ); + } + +} + +##################################### +sub S7_dispatchMsg($$$$$$$$) { + my ( $hash, $msgprefix, $areaIndex, $dbNr, $startByte, $hexbuffer,$length, $clientsNames ) = @_; + + my $name = $hash->{NAME}; + my $dmsg = + $msgprefix . " " + . $areaname[$areaIndex] . " " + . $dbNr . " " + . $startByte . " " + . $length . " " + . $name . " " + . $hexbuffer. " " + . $clientsNames + ; + + + Log3 $name, 5, $name . " S7_dispatchMsg " . $dmsg; + + Dispatch( $hash, $dmsg, {} ); + +} +##################################### +sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { + my ( + $hash, $area, $dbnr, + $blockstartpos, $blocklength, $hasAnalogReading, + $hasDigitalReading, $hasAnalogWriting, $hasDigitalWriting, $clientsNames + ) = @_; + + my $name = $hash->{NAME}; + my $state = $hash->{STATE}; + my $areaIndex = S7_getAreaIndex4AreaName($area); + + + Log3 $name, 4, + $name + . " READ Block AREA=" + . $area + . ", DB =" + . $dbnr + . ", ADDRESS=" + . $blockstartpos + . ", LENGTH=" + . $blocklength; + + if ( $state ne "connected to PLC" ) { + Log3 $name, 3, "$name is disconnected ? --> reconnect"; + S7_reconnect($hash); #lets try a reconnect + #@nextreadings[ $i / 4 ] = $now + 10; #retry in 10s + return -2; + } + + my $res; + my $readbuffer; + + ( $res, $readbuffer ) = + S7_ReadBlockFromPLC( $hash, $areaIndex, $dbnr, $blockstartpos, + $blocklength ); + + if ( $res == 0 ) { + + #reading was OK + my $length = length($readbuffer); + my $hexbuffer = join( ",", unpack( "H2" x $length, $readbuffer ) ); + + #dispatch to reader + S7_dispatchMsg( $hash, "AR", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer,$length,$clientsNames ) + if ( $hasAnalogReading > 0 ); + S7_dispatchMsg( $hash, "DR", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer,$length,$clientsNames ) + if ( $hasDigitalReading > 0 ); + + #dispatch to writer + S7_dispatchMsg( $hash, "AW", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer,$length,$clientsNames ) + if ( $hasAnalogWriting > 0 ); + S7_dispatchMsg( $hash, "DW", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer,$length,$clientsNames ) + if ( $hasDigitalWriting > 0 ); + return 0; + } + else { + + #reading failed + return -1; + } + +} +##################################### +sub S7_getReadingsList($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + + my @readings; + + # Jetzt suchen wir alle Readings + my @mykeys; + my %logoClients; + + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ && $defs{$_}{IODev}{NAME} eq $hash->{NAME}, + keys(%defs); + @logoClients{@mykeys} = @defs{@mykeys};#jetzt haben wir alle clients in logoClients + + #we need to find out the unique areas + my %tmphash = map { $logoClients{$_}{AREA} => 1 } keys %logoClients; + my @uniqueArea = keys %tmphash; + + foreach my $Area (@uniqueArea) { + my %logoClientsArea; + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ + && $defs{$_}{IODev}{NAME} eq $hash->{NAME} + && $defs{$_}{AREA} eq $Area, keys(%defs); + @logoClientsArea{@mykeys} = @defs{@mykeys}; + + #now we findout which DBs are used (unique) + %tmphash = map { $logoClientsArea{$_}{DB} => 1 } keys %logoClientsArea; + my @uniqueDB = keys %tmphash; + + foreach my $DBNr (@uniqueDB) { + + #now we filter all readinfy by DB! + my %logoClientsDB; + + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ + && $defs{$_}{IODev}{NAME} eq $hash->{NAME} + && $defs{$_}{AREA} eq $Area + && $defs{$_}{DB} == $DBNr, keys(%defs); + @logoClientsDB{@mykeys} = @defs{@mykeys}; + + #next step is, sorting all clients by ADDRESS + my @positioned = sort { + $logoClientsDB{$a}{ADDRESS} <=> $logoClientsDB{$b}{ADDRESS} + } keys %logoClientsDB; + + my $blockstartpos = -1; + my $blocklength = 0; + + my $hasAnalogReading = 0; + my $hasDigitalReading = 0; + my $hasAnalogWriting = 0; + my $hasDigitalWriting = 0; + my $clientsName = ""; + + for ( my $i = 0 ; $i < int(@positioned) ; $i++ ) { + if ( $blockstartpos < 0 ) { + + #we start a new block + $blockstartpos = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ); + $blocklength = $logoClientsDB{ $positioned[$i] }{LENGTH}; + + $hasAnalogReading++ + if ( + $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_ARead" ); + $hasDigitalReading++ + if ( + $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; + + } + else { + + if ( $logoClientsDB{ $positioned[$i] }{ADDRESS} + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos <= + $hash->{S7TCPClient}->{MaxReadLength} ) + { + + #extend existing block + if ( + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ) + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos > $blocklength ) + { + $blocklength = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ) + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos; + + $hasAnalogReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_ARead" ); + $hasDigitalReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + + + } + $clientsName .= "," .$logoClientsDB{ $positioned[$i] }{NAME}; + } + else { + + #block would exeed MaxReadLength + + #read and dispatch block from PLC + #block in liste speichern + push( + @readings, + [ + $logoClientsDB{ $positioned[$i] }{AREA}, + $logoClientsDB{ $positioned[$i] }{DB}, + $blockstartpos, + $blocklength, + $hasAnalogReading, + $hasDigitalReading, + $hasAnalogWriting, + $hasDigitalWriting, + $clientsName + ] + ); + + $hasAnalogReading = 0; + $hasDigitalReading = 0; + $hasAnalogWriting = 0; + $hasDigitalWriting = 0; + + #start new block new time + $blockstartpos = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ); + $blocklength = + $logoClientsDB{ $positioned[$i] }{LENGTH}; + + $hasAnalogReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_ARead" ); + $hasDigitalReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; + } + + } + + } + if ( $blockstartpos >= 0 ) { + + #read and dispatch block from PLC + + push( + @readings, + [ + $logoClientsDB{ $positioned[ int(@positioned) - 1 ] } + {AREA}, + $logoClientsDB{ $positioned[ int(@positioned) - 1 ] } + {DB}, + $blockstartpos, + $blocklength, + $hasAnalogReading, + $hasDigitalReading, + $hasAnalogWriting, + $hasDigitalWriting, + $clientsName + ] + ); + + } + } + } + @{ $hash->{ReadingList} } = @readings; + return 0; + +} + +##################################### +sub S7_readFromPLC($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + my $res; + + if ( ( !defined( $hash->{dirty} ) ) || $hash->{dirty} == 1 ) { + S7_getReadingsList($hash); + $hash->{dirty} = 0; + } + + my @readingList = @{ $hash->{ReadingList} }; + + for ( my $i = 0 ; $i < int(@readingList) ; $i++ ) { + my @readingSet = @{ $readingList[$i] }; + $res = S7_readAndDispatchBlockFromPLC( + $hash, $readingSet[0], $readingSet[1], + $readingSet[2], $readingSet[3], $readingSet[4], + $readingSet[5], $readingSet[6], $readingSet[7], $readingSet[8] + ); + + return $res if ( $res != 0 ); + } + return 0; +} + + + +1; + +=pod +=begin html + + +

S7

+
    + This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). The TCP communication module is based on settimino (http://settimino.sourceforge.net) You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
    +
    + For the communication the following modules have been implemented: +
      +
    • S7 … sets up the communication channel to the PLC
    • +
    • S7_ARead … Is used for reading integer Values from the PLC
    • +
    • S7_AWrite … Is used for write integer Values to the PLC
    • +
    • S7_DRead … Is used for read bits
    • +
    • S7_DWrite … Is used for writing bits.
    • +
    +
    +
    + Reading work flow:
    +
    + The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. Writing work flow:
    +
    + At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
    + (Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
    + Note: The S7 module will send always the whole data block to the PLC. When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
    +
    + Define + +
      +
    • define <name> S7 <ip_address> <rack> <slot> [<Interval>]
      +
      + define logo S7 10.0.0.241 2 0 + +
        +
      • ip_address … IP address of the PLC
      • +
      • rack … rack of the PLC
      • +
      • slot … slot of the PLC
      • +
      • Interval … Intervall how often the modul should check if a reading is required
      • +
      +
      + Note: For Siemens logo you should use a alternative (more simply configuration method):
      + define logo S7 LOGO7 10.0.0.241
    • +
    +
    +
    + Attr
    + The following attributes are supported:
    +
    +   +
      +
    • MaxMessageLength
    • +
      +
    • MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
    • +
    +
+ +=end html + +=begin html_DE + + + +

S7

+
    + This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). The TCP communication module is based on settimino (http://settimino.sourceforge.net) You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
    +
    + For the communication the following modules have been implemented: +
      +
    • S7 … sets up the communication channel to the PLC
    • +
    • S7_ARead … Is used for reading integer Values from the PLC
    • +
    • S7_AWrite … Is used for write integer Values to the PLC
    • +
    • S7_DRead … Is used for read bits
    • +
    • S7_DWrite … Is used for writing bits.
    • +
    +
    +
    + Reading work flow:
    +
    + The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. Writing work flow:
    +
    + At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
    + (Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
    + Note: The S7 module will send always the whole data block to the PLC. When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
    +
    + Define + +
      +
    • define <name> S7 <ip_address> <rack> <slot> [<Interval>]
      +
      + define logo S7 10.0.0.241 2 0 + +
        +
      • ip_address … IP address of the PLC
      • +
      • rack … rack of the PLC
      • +
      • slot … slot of the PLC
      • +
      • Interval … Intervall how often the modul should check if a reading is required
      • +
      +
      + Note: For Siemens logo you should use a alternative (more simply configuration method):
      + define logo S7 LOGO7 10.0.0.241
    • +
    +
    +
    + Attr
    + The following attributes are supported:
    +
    +   +
      +
    • MaxMessageLength
    • +
      +
    • MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
    • +
    +
+ + +=end html_DE + +=cut diff --git a/fhem/FHEM/44_S7_ARead.pm b/fhem/FHEM/44_S7_ARead.pm new file mode 100644 index 000000000..7c103957c --- /dev/null +++ b/fhem/FHEM/44_S7_ARead.pm @@ -0,0 +1,448 @@ +# $Id$ +############################################## +package main; + +use strict; +use warnings; + +#use Switch; +require "44_S7_Client.pm"; + +my %gets = ( + + # "libnodaveversion" => "" +); + +sub _isfloat { + my $val = shift; + + # return $val =~ m/^\d+.\d+$/; + return $val =~ m/^[-+]?\d*\.?\d*$/; + + #[-+]?[0-9]*\.?[0-9]* +} + +##################################### +sub S7_ARead_Initialize($) { + my $hash = shift @_; + + # Provider + + # Consumer + $hash->{Match} = "^AR"; + + $hash->{DefFn} = "S7_ARead_Define"; + $hash->{UndefFn} = "S7_ARead_Undef"; + $hash->{ParseFn} = "S7_ARead_Parse"; + + $hash->{AttrFn} = "S7_ARead_Attr"; + + $hash->{AttrList} = "IODev offset multiplicator " . $readingFnAttributes; + + main::LoadModule("S7"); +} + +##################################### +sub S7_ARead_Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $area, $DB, $start, $datatype ); + + $name = $a[0]; + $area = lc $a[2]; + $DB = $a[3]; + $start = $a[4]; + $datatype = lc $a[5]; + + if ( $area ne "inputs" + && $area ne "outputs" + && $area ne "flags" + && $area ne "db" ) + { + my $msg = +"wrong syntax: define S7_ARead {inputs|outputs|flags|db} {u8|s8|u16|s16|u32|s32|float}"; + + Log3 undef, 2, $msg; + return $msg; + } + + if ( $datatype ne "u8" + && $datatype ne "s8" + && $datatype ne "u16" + && $datatype ne "s16" + && $datatype ne "u32" + && $datatype ne "s32" + && $datatype ne "float" ) + { + my $msg = +"wrong syntax: define S7_ARead {inputs|outputs|flags|db} {u8|s8|u16|s16|u32|s32|float}"; + + Log3 undef, 2, $msg; + return $msg; + } + + $hash->{AREA} = $area; + $hash->{DB} = $DB; + $hash->{ADDRESS} = $start; + $hash->{DATATYPE} = $datatype; + + if ( $datatype eq "u16" || $datatype eq "s16" ) { + $hash->{LENGTH} = 2; + } + elsif ( $datatype eq "u32" || $datatype eq "s32" || $datatype eq "float" ) { + $hash->{LENGTH} = 4; + } + else { + $hash->{LENGTH} = 1; + } + + my $ID = "$area $DB"; + + if ( !defined( $modules{S7_ARead}{defptr}{$ID} ) ) { + my @b = (); + push( @b, $hash ); + $modules{S7_ARead}{defptr}{$ID} = \@b; + + } + else { + push( @{ $modules{S7_ARead}{defptr}{$ID} }, $hash ); + } + + AssignIoPort($hash); # logisches modul an physikalisches binden !!! + + $hash->{IODev}{dirty} = 1; + Log3 $name, 4, + "S7_ARead (" . $hash->{IODev}{NAME} . "): define $name Adress:$start"; + + return undef; +} +##################################### +sub S7_ARead_Undef($$) { + my ( $hash, $name ) = @_; + + Log3 $name, 4, + "S7_ARead (" + . $hash->{IODev}{NAME} + . "): undef " + . $hash->{NAME} + . " Adress:" + . $hash->{ADDRESS}; + delete( $modules{S7_ARead}{defptr} ); + + return undef; +} + +##################################### +sub S7_ARead_Parse($$) { + my ( $hash, $rmsg ) = @_; + my $name = $hash->{NAME}; + + my @a = split( "[ \t][ \t]*", $rmsg ); + my @list; + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, + $clientNames ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + $clientNames = $a[7]; + + my $ID = "$area $DB"; + + Log3 $name, 5, "$name S7_ARead_Parse $rmsg"; + + my @clientList = split( ",", $clientNames ); + + if ( int(@clientList) > 0 ) { + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + + #my $b = pack( "C" x $length, @Writebuffer ); + foreach my $clientName (@clientList) { + + my $h = $defs{$clientName}; + + if ( $h->{TYPE} eq "S7_ARead" + && $start <= $h->{ADDRESS} + && $start + $length >= $h->{ADDRESS} + $h->{LENGTH} ) + { + + my $n = $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + my $s = $h->{ADDRESS} - $start; + my $myI; + + if ( $h->{DATATYPE} eq "u8" ) { + $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s8" ) { + $myI = $hash->{S7TCPClient}->ShortAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u16" ) { + $myI = $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s16" ) { + $myI = $hash->{S7TCPClient}->IntegerAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u32" ) { + $myI = $hash->{S7TCPClient}->DWordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s32" ) { + $myI = $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "float" ) { + $myI = $hash->{S7TCPClient}->FloatAt( \@Writebuffer, $s ); + } + else { + Log3 $name, 3, + "$name S7_ARead: Parse unknown type : (" + . $h->{DATATYPE} . ")"; + } + + #now we need to correct the analog value by the parameters attribute and offset + my $offset = 0; + if ( defined( $main::attr{$n}{offset} ) ) { + $offset = $main::attr{$n}{offset}; + } + + my $multi = 1; + if ( defined( $main::attr{$n}{multiplicator} ) ) { + $multi = $main::attr{$n}{multiplicator}; + } + + $myI = $myI * $multi + $offset; + + #my $myResult; + + main::readingsSingleUpdate( $h, "state", $myI, 1 ); + + # main::readingsSingleUpdate($h,"value",$myResult, 1); + } + + } + } + else { + + Log3 $name, 3, "$name S7_ARead_Parse going the save way "; + if ( defined( $modules{S7_ARead}{defptr}{$ID} ) ) { + + foreach my $h ( @{ $modules{S7_ARead}{defptr}{$ID} } ) { + if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + && $main::attr{ $h->{NAME} }{IODev} eq $name ) + { + if ( $start <= $h->{ADDRESS} + && $start + $length >= $h->{ADDRESS} + $h->{LENGTH} ) + { + + my $n = + $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + my $s = $h->{ADDRESS} - $start; + + #my $b = pack( "C" x $length, @Writebuffer ); + my $myI; + + if ( $h->{DATATYPE} eq "u8" ) { + $myI = + $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s8" ) { + $myI = + $hash->{S7TCPClient} + ->ShortAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u16" ) { + $myI = + $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s16" ) { + $myI = + $hash->{S7TCPClient} + ->IntegerAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u32" ) { + $myI = + $hash->{S7TCPClient} + ->DWordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s32" ) { + $myI = + $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "float" ) { + $myI = + $hash->{S7TCPClient} + ->FloatAt( \@Writebuffer, $s ); + } + else { + Log3 $name, 3, + "$name S7_ARead: Parse unknown type : (" + . $h->{DATATYPE} . ")"; + } + + #now we need to correct the analog value by the parameters attribute and offset + my $offset = 0; + if ( defined( $main::attr{$n}{offset} ) ) { + $offset = $main::attr{$n}{offset}; + } + + my $multi = 1; + if ( defined( $main::attr{$n}{multiplicator} ) ) { + $multi = $main::attr{$n}{multiplicator}; + } + + $myI = $myI * $multi + $offset; + + #my $myResult; + + main::readingsSingleUpdate( $h, "state", $myI, 1 ); + + # main::readingsSingleUpdate($h,"value",$myResult, 1); + } + } + } + } + + } + + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_ARead: Parse no client found ($name) ..."; + push( @list, "" ); + } + + return @list; + +} + +##################################### + +sub S7_ARead_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + my $hash = $defs{$name}; + if ( $cmd eq "set" ) { + if ( $aName eq "offset" || $aName eq "multiplicator" ) { + + if ( !_isfloat($aVal) ) { + + Log3 $name, 3, +"S7_ARead: Invalid $aName in attr $name $aName $aVal ($aVal is not a number): $@"; + return "Invalid $aName $aVal: $aVal is not a number"; + } + + } + elsif ( $aName eq "IODev" ) { + if ( defined( $hash->{IODev} ) ) { #set old master device dirty + $hash->{IODev}{dirty} = 1; + } + if ( defined( $defs{$aVal} ) ) { #set new master device dirty + $defs{$aVal}{dirty} = 1; + } + Log3 $name, 4, "S7_ARead: IODev for $name is $aVal"; + + } + + } + return undef; +} + +1; + +=pod +=begin html + + +

S7_ARead

+
    + This module is a logical module of the physical module S7.
    + This module provides analog data (signed / unsigned integer Values).
    + Note: you have to configure a PLC reading at the physical module (S7) first.
    +
    +
    + Define
    + define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32}
    +   +
      +
    • inputs|outputs|flags|db … defines where to read.
    • +
    • DB … Number of the DB
    • +
    • start … start byte of the reading
    • +
    • {u8|s8|u16|s16|u32|s32} … defines the datatype: +
        +
      • u8 …. unsigned 8 Bit integer
      • +
      • s8 …. signed 8 Bit integer
      • +
      • u16 …. unsigned 16 Bit integer
      • +
      • s16 …. signed 16 Bit integer
      • +
      • u32 …. unsigned 32 Bit integer
      • +
      • s32 …. signed 32 Bit integer
      • +
      +
    • +
    • Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module.
    • +
    +
    + Attr
    + The following parameters are used to scale every reading +
      +
    • multiplicator
    • +
    • offset
    • +
    + newValue = <multiplicator> * Value + <offset> +
+=end html + +=begin html_DE + + +

S7_ARead

+
    + This module is a logical module of the physical module S7.
    + This module provides analog data (signed / unsigned integer Values).
    + Note: you have to configure a PLC reading at the physical module (S7) first.
    +
    +
    + Define
    + define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32}
    +   +
      +
    • inputs|outputs|flags|db … defines where to read.
    • +
    • DB … Number of the DB
    • +
    • start … start byte of the reading
    • +
    • {u8|s8|u16|s16|u32|s32} … defines the datatype: +
        +
      • u8 …. unsigned 8 Bit integer
      • +
      • s8 …. signed 8 Bit integer
      • +
      • u16 …. unsigned 16 Bit integer
      • +
      • s16 …. signed 16 Bit integer
      • +
      • u32 …. unsigned 32 Bit integer
      • +
      • s32 …. signed 32 Bit integer
      • +
      • float …. 4 byte float
      • +
      +
    • +
    • Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module.
    • +
    + Attr
    + The following parameters are used to scale every reading +
      +
    • multiplicator
    • +
    • offset
    • +
    + newValue = <multiplicator> * Value + <offset> +
+=end html_DE + +=cut + diff --git a/fhem/FHEM/44_S7_AWrite.pm b/fhem/FHEM/44_S7_AWrite.pm new file mode 100644 index 000000000..7c5d70bab --- /dev/null +++ b/fhem/FHEM/44_S7_AWrite.pm @@ -0,0 +1,571 @@ +# $Id$ +############################################## +package main; + +use strict; +use warnings; + +#use Switch; +require "44_S7_Client.pm"; + +my %gets = ( + "reading" => "", + "STATE" => "" +); + +##################################### +sub S7_AWrite_Initialize($) { + my $hash = shift @_; + + # Consumer + $hash->{Match} = "^AW"; + + $hash->{DefFn} = "S7_AWrite_Define"; + $hash->{UndefFn} = "S7_AWrite_Undef"; + + # $hash->{GetFn} = "S7_AWrite_Get"; + $hash->{SetFn} = "S7_AWrite_Set"; + $hash->{ParseFn} = "S7_AWrite_Parse"; + + $hash->{AttrFn} = "S7_AWrite_Attr"; + $hash->{AttrList} = "IODev " . $readingFnAttributes; + + main::LoadModule("S7"); +} + +##################################### +sub S7_AWrite_Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $area, $DB, $start, $datatype, $length ); + + $name = $a[0]; + $area = lc $a[2]; + $DB = $a[3]; + $start = $a[4]; + $datatype = lc $a[5]; + + Log3 $name, 5, "$name S7_AWrite_Define called"; + + if ( $area ne "inputs" + && $area ne "outputs" + && $area ne "flags" + && $area ne "db" ) + { + my $msg = +"$name wrong syntax: define S7_AWrite {inputs|outputs|flags|db} {u8|s8|u16|s16|u32|s32|float}"; + + Log3 $name, 2, $msg; + return $msg; + } + + if ( $datatype ne "u8" + && $datatype ne "s8" + && $datatype ne "u16" + && $datatype ne "s16" + && $datatype ne "u32" + && $datatype ne "s32" + && $datatype ne "float" ) + { + my $msg = +"$name wrong syntax: define S7_AWrite {inputs|outputs|flags|db} {u8|s8|u16|s16|u32|s32|float}"; + + Log3 $name, 2, $msg; + return $msg; + } + + AssignIoPort($hash); # logisches modul an physikalisches binden !!! + + my $sname = $hash->{IODev}{NAME}; + + if ( $datatype eq "u16" || $datatype eq "s16" ) { + $length = 2; + } + elsif ( $datatype eq "u32" || $datatype eq "s32" || $datatype eq "float" ) { + $length = 4; + } + else { + $length = 1; + } + + $hash->{AREA} = $area; + $hash->{DB} = $DB; + $hash->{ADDRESS} = $start; + $hash->{DATATYPE} = $datatype; + $hash->{LENGTH} = $length; + + my $ID = "$area $DB"; + + if ( !defined( $modules{S7_AWrite}{defptr}{$ID} ) ) { + my @b = (); + push( @b, $hash ); + $modules{S7_AWrite}{defptr}{$ID} = \@b; + + } + else { + push( @{ $modules{S7_AWrite}{defptr}{$ID} }, $hash ); + } + + Log3 $name, 4, + "S7_AWrite (" . $hash->{IODev}{NAME} . "): define $name Adress:$start"; + + $hash->{IODev}{dirty} = 1; + return undef; +} + +##################################### + +sub S7_AWrite_Undef($$) { + my ( $hash, $name ) = @_; + + Log3 $name, 4, + "S7_AWrite (" + . $hash->{IODev}{NAME} + . "): undef " + . $hash->{NAME} + . " Adress:" + . $hash->{ADDRESS}; + delete( $modules{S7_AWrite}{defptr} ); + + return undef; +} + +##################################### + +sub S7_AWrite_Set($@) { + my ( $hash, @a ) = @_; + my $name = $hash->{NAME}; + + Log3 $name, 5, "$name S7_AWrite_Set"; + + my $minValue; + my $maxValue; + + my $datatype = $hash->{DATATYPE}; + +#note I have used a SIEMENS Logo for testing here just the following range was supported. +# $minValue = 0; +# $maxValue = 32767; + + if ( $datatype eq "u16" ) { + $minValue = 0; + $maxValue = 65535; + } + elsif ( $datatype eq "s16" ) { + $minValue = -32768; + $maxValue = 32767; + } + elsif ( $datatype eq "u32" ) { + $minValue = 0; + $maxValue = 4294967295; + } + elsif ( $datatype eq "s32" ) { + $minValue = -2147483648; + $maxValue = 2147483647; + } + elsif ( $datatype eq "float" ) { + $minValue = -3.402823e38; + $maxValue = 3.402823e38; + } + elsif ( $datatype eq "u8" ) { + $minValue = 0; + $maxValue = 255; + } + elsif ( $datatype eq "s8" ) { + $minValue = -128; + $maxValue = 127; + } + else { #should never happen + $minValue = -1; + $maxValue = 0; + } + + return "$name Need at least one parameter" if ( int(@a) < 2 ); + return " : " if ( $a[1] eq "?" ); + + if ( $a[1] ne int( $a[1] ) && $datatype ne "float" ) { + return "$name You have to enter a numeric value: $minValue - $maxValue"; + } + + my $newValue; + if ( $datatype ne "float" ) { + $newValue = int( $a[1] ); + } + else { + $newValue = $a[1]; + } + + if ( $newValue < $minValue || $newValue > $maxValue ) { + return "$name Out of range: $minValue - $maxValue"; + } + + my $sname = $hash->{IODev}{NAME}; + + #find the rigth config + my $area = $hash->{AREA}; + + my $length = $hash->{LENGTH}; + my $start = $hash->{ADDRESS}; + my $dbNR = $hash->{DB}; + my $shash = $defs{$sname}; + + if ( !defined( $shash->{S7TCPClient} ) ) { + my $err = "$name S7_AWrite_Set: not connected to PLC "; + Log3 $name, 3, $err; + return $err; + } + + if ( $shash->{STATE} ne "connected to PLC" ) { + my $err = "$name S7_AWrite_Set: not connected to PLC"; + Log3 $name, 3, $err; + return $err; + } + + my $b; + + my $WordLen; + + if ( $datatype eq "u8" ) { + $b = $shash->{S7TCPClient}->setByteAt( "X", 0, $newValue ); + $WordLen = &S7Client::S7WLByte; + } + elsif ( $datatype eq "s8" ) { + $b = $shash->{S7TCPClient}->setShortAt( "X", 0, $newValue ); + $WordLen = &S7Client::S7WLByte; + } + elsif ( $datatype eq "u16" ) { + $b = $shash->{S7TCPClient}->setWordAt( "XX", 0, $newValue ); + $WordLen = &S7Client::S7WLInt; + + # $WordLen = &S7Client::S7WLWord; + } + elsif ( $datatype eq "s16" ) { + $b = $shash->{S7TCPClient}->setIntegerAt( "XX", 0, $newValue ); + $WordLen = &S7Client::S7WLInt; + + # $WordLen = &S7Client::S7WLWord; + } + elsif ( $datatype eq "u32" ) { + $b = $shash->{S7TCPClient}->setDWordAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLDInt; + + # $WordLen = &S7Client::S7WLDWord; + } + elsif ( $datatype eq "s32" ) { + $b = $shash->{S7TCPClient}->setDintAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLDInt; + + # $WordLen = &S7Client::S7WLDWord; + } + elsif ( $datatype eq "float" ) { + $b = $shash->{S7TCPClient}->setFloatAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLReal; + } + else { + my $err = "$name S7_AWrite: Parse unknown type : (" . $datatype . ")"; + Log3 $name, 3, $err; + return $err; + } + + my $bss = join( ", ", unpack( "H2" x $length, $b ) ); + Log3 $name, 5, "$name S7_AWrite_Set: Write Bytes to PLC: $bss"; + + my $writeAreaIndex = S7_getAreaIndex4AreaName($area); + return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) ); + + # my $res = S7_WriteBlockToPLC($shash,$writeAreaIndex,$dbNR,$start,$b); + + my $res = + S7_WriteToPLC( $shash, $writeAreaIndex, $dbNR, $start, $WordLen, $b ); + + if ( $res == 0 ) { + main::readingsSingleUpdate( $hash, "state", $newValue, 1 ); + + } + else { + main::readingsSingleUpdate( $hash, "state", "", 1 ); + + } + + return undef; + +} + +##################################### +sub S7_AWrite_Parse($$) { + my ( $hash, $rmsg ) = @_; + my $name = $hash->{NAME}; + my @list; + my @a = split( "[ \t][ \t]*", $rmsg ); + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, + $clientNames ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + $clientNames = $a[7]; + + my $ID = "$area $DB"; + + Log3 $name, 6, "$name S7_AWrite_Parse $rmsg"; + my @clientList = split( ",", $clientNames ); + + if ( int(@clientList) > 0 ) { + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + + #my $b = pack( "C" x $length, @Writebuffer ); + foreach my $clientName (@clientList) { + + my $h = $defs{$clientName}; + + if ( $h->{TYPE} eq "S7_AWrite" + && $start <= $h->{ADDRESS} + && $start + $length >= $h->{ADDRESS} + $h->{LENGTH} ) + { + + my $n = $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #Aktualisierung des wertes + + my $s = $h->{ADDRESS} - $start; + my $myI; + + if ( $h->{DATATYPE} eq "u8" ) { + $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s8" ) { + $myI = $hash->{S7TCPClient}->ShortAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u16" ) { + $myI = $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s16" ) { + $myI = $hash->{S7TCPClient}->IntegerAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u32" ) { + $myI = $hash->{S7TCPClient}->DWordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s32" ) { + $myI = $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "float" ) { + $myI = $hash->{S7TCPClient}->FloatAt( \@Writebuffer, $s ); + } + else { + Log3 $name, 3, "$name S7_AWrite: Parse unknown type : (" + . $h->{DATATYPE} . ")"; + } + + main::readingsSingleUpdate( $h, "state", $myI, 1 ); + } + } + } + else { + + Log3 $name, 3, "$name S7_AWrite_Parse going the save way "; + if ( defined( $modules{S7_AWrite}{defptr}{$ID} ) ) { + + foreach my $h ( @{ $modules{S7_AWrite}{defptr}{$ID} } ) { + if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + && $main::attr{ $h->{NAME} }{IODev} eq $name ) + { + if ( $start <= $h->{ADDRESS} + && $start + $length >= $h->{ADDRESS} + $h->{LENGTH} ) + { + + my $n = + $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #Aktualisierung des wertes + + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + my $s = $h->{ADDRESS} - $start; + + # my $b = pack( "C" x $length, @Writebuffer ); + my $myI; + + if ( $h->{DATATYPE} eq "u8" ) { + $myI = + $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s8" ) { + $myI = + $hash->{S7TCPClient} + ->ShortAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u16" ) { + $myI = + $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s16" ) { + $myI = + $hash->{S7TCPClient} + ->IntegerAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "u32" ) { + $myI = + $hash->{S7TCPClient} + ->DWordAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "s32" ) { + $myI = + $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + } + elsif ( $h->{DATATYPE} eq "float" ) { + $myI = + $hash->{S7TCPClient} + ->FloatAt( \@Writebuffer, $s ); + } + else { + Log3 $name, 3, + "$name S7_AWrite: Parse unknown type : (" + . $h->{DATATYPE} . ")"; + } + + main::readingsSingleUpdate( $h, "state", $myI, 1 ); + } + } + + } + } + } + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_AWrite: Parse no client found ($name) ..."; + push( @list, "" ); + + # return undef; + } + + return @list; + +} + +##################################### + sub S7_AWrite_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + my $hash = $defs{$name}; + if ( $cmd eq "set" ) { + + if ( $aName eq "IODev" ) { + if ( defined( $hash->{IODev} ) ) { #set old master device dirty + $hash->{IODev}{dirty} = 1; + } + if ( defined( $defs{$aVal} ) ) { #set new master device dirty + $defs{$aVal}{dirty} = 1; + } + Log3 $name, 4, "S7_AWrite: IODev for $name is $aVal"; + } + + } + return undef; + } + + 1; + +=pod +=begin html + + +

S7_AWrite

+
    + This module is a logical module of the physical module S7.
    + This module provides sending analog data (unsigned integer Values) to the PLC.
    + Note: you have to configure a PLC writing at the physical modul (S7) first.
    +
    + Define + +
      +
    • define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}
      +   +
        +
      • db … defines where to read. Note currently only writing in to DB are supported.
      • +
      • DB … Number of the DB
      • +
      • start … start byte of the reading
      • +
      • {u8|s8|u16|s16|u32|s32} … defines the datatype: +
          +
        • u8 …. unsigned 8 Bit integer
        • +
        • s8 …. signed 8 Bit integer
        • +
        • u16 …. unsigned 16 Bit integer
        • +
        • s16 …. signed 16 Bit integer
        • +
        • u32 …. unsigned 32 Bit integer
        • +
        • s32 …. signed 32 Bit integer
        • +
        • float …. 4 byte float
        • +
        +
      • +
      + Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
    • +
    + Set
    +   +
      +
    • set <name> S7_AWrite <value> + +
        +
      • value … an numeric value
      • +
      +
    • +
    +
+=end html + +=begin html_DE + + +

S7_AWrite

+
    + This module is a logical module of the physical module S7.
    + This module provides sending analog data (unsigned integer Values) to the PLC.
    + Note: you have to configure a PLC writing at the physical modul (S7) first.
    +
    + Define + +
      +
    • define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}
      +   +
        +
      • db … defines where to read. Note currently only writing in to DB are supported.
      • +
      • DB … Number of the DB
      • +
      • start … start byte of the reading
      • +
      • {u8|s8|u16|s16|u32|s32} … defines the datatype: +
          +
        • u8 …. unsigned 8 Bit integer
        • +
        • s8 …. signed 8 Bit integer
        • +
        • u16 …. unsigned 16 Bit integer
        • +
        • s16 …. signed 16 Bit integer
        • +
        • u32 …. unsigned 32 Bit integer
        • +
        • s32 …. signed 32 Bit integer
        • +
        • float …. 4 byte float
        • +
        +
      • +
      + Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
    • +
    + Set
    +   +
      +
    • set <name> S7_AWrite <value> + +
        +
      • value … an numeric value
      • +
      +
    • +
    + +
+ +=end html_DE + +=cut diff --git a/fhem/FHEM/44_S7_Client.pm b/fhem/FHEM/44_S7_Client.pm new file mode 100644 index 000000000..c9315781c --- /dev/null +++ b/fhem/FHEM/44_S7_Client.pm @@ -0,0 +1,1795 @@ +# $Id$ +############################################## + +use strict; +use warnings; +require Exporter; +use Config; +use AutoLoader; + +#use Socket; +use IO::Socket::INET; +use IO::Select; + +# vars in der main (*global*) +#use vars qw($Config); + +#doto + +#fehler in settimino: +#function :WriteArea & ReadArea +#bit shift opteratin in wrong direction +# PDU.H[23]=NumElements<<8; --> PDU.H[23]=NumElements>>8; +# PDU.H[24]=NumElements; + +#todo fix timeout in ms + +our @ISA = qw(Exporter); + +our %EXPORT_TAGS = ( + 'all' => [ + qw( + errTCPConnectionFailed + errTCPConnectionReset + errTCPDataRecvTout + errTCPDataSend + errTCPDataRecv + errISOConnectionFailed + errISONegotiatingPDU + errISOInvalidPDU + errS7InvalidPDU + errS7SendingPDU + errS7DataRead + errS7DataWrite + errS7Function + errBufferTooSmall + Code7Ok + Code7AddressOutOfRange + Code7InvalidTransportSize + Code7WriteDataSizeMismatch + Code7ResItemNotAvailable + Code7ResItemNotAvailable1 + Code7InvalidValue + Code7NeedPassword + Code7InvalidPassword + Code7NoPasswordToClear + Code7NoPasswordToSet + Code7FunNotAvailable + Code7DataOverPDU + S7_PG + S7_OP + S7_Basic + ISOSize + isotcp + MinPduSize + MaxPduSize + CC + S7Shift + S7AreaPE + S7AreaPA + S7AreaMK + S7AreaDB + S7AreaCT + S7AreaTM + S7WLBit + S7WLByte + S7WLWord + S7WLDWord + S7WLReal + S7WLCounter + S7WLTimer + S7CpuStatusUnknown + S7CpuStatusRun + S7CpuStatusStop + RxOffset + Size_RD + Size_WR + Size_DT + ) + ] +); + +our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +our @EXPORT = qw( + errTCPConnectionFailed + errTCPConnectionReset + errTCPDataRecvTout + errTCPDataSend + errTCPDataRecv + errISOConnectionFailed + errISONegotiatingPDU + errISOInvalidPDU + errS7InvalidPDU + errS7SendingPDU + errS7DataRead + errS7DataWrite + errS7Function + errBufferTooSmall + Code7Ok + Code7AddressOutOfRange + Code7InvalidTransportSize + Code7WriteDataSizeMismatch + Code7ResItemNotAvailable + Code7ResItemNotAvailable1 + Code7InvalidValue + Code7NeedPassword + Code7InvalidPassword + Code7NoPasswordToClear + Code7NoPasswordToSet + Code7FunNotAvailable + Code7DataOverPDU + S7_PG + S7_OP + S7_Basic + ISOSize + isotcp + MinPduSize + MaxPduSize + CC + S7Shift + S7AreaPE + S7AreaPA + S7AreaMK + S7AreaDB + S7AreaCT + S7AreaTM + S7WLBit + S7WLByte + S7WLWord + S7WLDWord + S7WLReal + S7WLCounter + S7WLTimer + S7CpuStatusUnknown + S7CpuStatusRun + S7CpuStatusStop + RxOffset + Size_RD + Size_WR + Size_DT +); + +package S7Client; + +# Error Codes +# from 0x0001 up to 0x00FF are severe errors, the Client should be disconnected +# from 0x0100 are S7 Errors such as DB not found or address beyond the limit etc.. +# For Arduino Due the error code is a 32 bit integer but this doesn't change the constants use. + +use constant errTCPConnectionFailed => 0x0001; +use constant errTCPConnectionReset => 0x0002; +use constant errTCPDataRecvTout => 0x0003; +use constant errTCPDataSend => 0x0004; +use constant errTCPDataRecv => 0x0005; +use constant errISOConnectionFailed => 0x0006; +use constant errISONegotiatingPDU => 0x0007; +use constant errISOInvalidPDU => 0x0008; + +use constant errS7InvalidPDU => 0x0100; +use constant errS7SendingPDU => 0x0200; +use constant errS7DataRead => 0x0300; +use constant errS7DataWrite => 0x0400; +use constant errS7Function => 0x0500; + +use constant errBufferTooSmall => 0x0600; + +#CPU Errors + +# S7 outcoming Error code +use constant Code7Ok => 0x0000; +use constant Code7AddressOutOfRange => 0x0005; +use constant Code7InvalidTransportSize => 0x0006; +use constant Code7WriteDataSizeMismatch => 0x0007; +use constant Code7ResItemNotAvailable => 0x000A; +use constant Code7ResItemNotAvailable1 => 0xD209; +use constant Code7InvalidValue => 0xDC01; +use constant Code7NeedPassword => 0xD241; +use constant Code7InvalidPassword => 0xD602; +use constant Code7NoPasswordToClear => 0xD604; +use constant Code7NoPasswordToSet => 0xD605; +use constant Code7FunNotAvailable => 0x8104; +use constant Code7DataOverPDU => 0x8500; + +# Connection Type +use constant S7_PG => 0x01; +use constant S7_OP => 0x02; +use constant S7_Basic => 0x03; + +# ISO and PDU related constants +use constant ISOSize => 7; # Size of TPKT + COTP Header +use constant isotcp => 102; # ISOTCP Port +use constant MinPduSize => 16; # Minimum S7 valid telegram size +use constant MaxPduSize => + 247; # Maximum S7 valid telegram size (we negotiate 240 bytes + ISOSize) +use constant CC => 0xD0; # Connection confirm +use constant S7Shift => + 17; # We receive data 17 bytes above to align with PDU.DATA[] + +# S7 ID Area (Area that we want to read/write) +use constant S7AreaPE => 0x81; +use constant S7AreaPA => 0x82; +use constant S7AreaMK => 0x83; +use constant S7AreaDB => 0x84; +use constant S7AreaCT => 0x1C; +use constant S7AreaTM => 0x1D; + +# WordLength +use constant S7WLBit => 0x01; +use constant S7WLByte => 0x02; +use constant S7WLChar => 0x03; +use constant S7WLWord => 0x04; +use constant S7WLInt => 0x05; +use constant S7WLDWord => 0x06; +use constant S7WLDInt => 0x07; +use constant S7WLReal => 0x08; +use constant S7WLCounter => 0x1C; +use constant S7WLTimer => 0x1D; + +# Result transport size +use constant TS_ResBit => 0x03; +use constant TS_ResByte => 0x04; +use constant TS_ResInt => 0x05; +use constant TS_ResReal => 0x07; +use constant TS_ResOctet => 0x09; + +use constant S7CpuStatusUnknown => 0x00; +use constant S7CpuStatusRun => 0x08; +use constant S7CpuStatusStop => 0x04; + +use constant RxOffset => 18; +use constant Size_DT => 25; +use constant Size_RD => 31; +use constant Size_WR => 35; + +sub new { + my $class = shift; + my $self = { + + # Default TSAP values for connectiong as PG to a S7300 (Rack 0, Slot 2) + LocalTSAP_HI => 0x01, + LocalTSAP_LO => 0x00, + RemoteTSAP_HI => 0x01, + RemoteTSAP_LO => 0x02, + ConnType => &S7_PG, + Connected => 0, # = false + LastError => 0, + PDULength => 0, + MaxReadLength => 0, + RecvTimeout => 500, # 500 ms + LastPDUType => 0, + Peer => "", + ISO_CR => "", + S7_PN => "", + S7_RW => "", + PDU => {}, + cntword => 0, + }; + + #ISO Connection Request telegram (contains also ISO Header and COTP Header) + $self->{ISO_CR} = pack( + "C22", + + # TPKT (RFC1006 Header) + 0x03, # RFC 1006 ID (3) + 0x00, # Reserved, always 0 + 0x00 + , # High part of packet length (entire frame, payload and TPDU included) + 0x16 + , # Low part of packet length (entire frame, payload and TPDU included) + # COTP (ISO 8073 Header) + 0x11, # PDU Size Length + 0xE0, # CR - Connection Request ID + 0x00, # Dst Reference HI + 0x00, # Dst Reference LO + 0x00, # Src Reference HI + 0x01, # Src Reference LO + 0x00, # Class + Options Flags + 0xC0, # PDU Max Length ID + 0x01, # PDU Max Length HI + + 0x0A, # PDU Max Length LO # snap7 value Bytes 1024 + + # 0x09, # PDU Max Length LO # libnodave value Bytes 512 + + 0xC1, # Src TSAP Identifier + 0x02, # Src TSAP Length (2 bytes) + 0x01, # Src TSAP HI (will be overwritten by ISOConnect()) + 0x00, # Src TSAP LO (will be overwritten by ISOConnect()) + 0xC2, # Dst TSAP Identifier + 0x02, # Dst TSAP Length (2 bytes) + 0x01, # Dst TSAP HI (will be overwritten by ISOConnect()) + 0x02 # Dst TSAP LO (will be overwritten by ISOConnect()) + ); + + # S7 PDU Negotiation Telegram (contains also ISO Header and COTP Header) + $self->{S7_PN} = pack( + "C25", + 0x03, 0x00, 0x00, 0x19, 0x02, 0xf0, + 0x80, # TPKT + COTP (see above for info) + 0x32, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, #snap7 trace + 0x00, 0xf0, 0x00, 0x00, 0x01, 0x00, 0x01, + + # 0x00, 0xf0 # PDU Length Requested = HI-LO 240 bytes + # 0x01, 0xe0 # PDU Length Requested = HI-LO 480 bytes + 0x03, 0xc0 # PDU Length Requested = HI-LO 960 bytes + ); + + # S7 Read/Write Request Header (contains also ISO Header and COTP Header) + $self->{S7_RW} = pack( + "C35", # 31-35 bytes + 0x03, 0x00, + 0x00, 0x1f, # Telegram Length (Data Size + 31 or 35) + 0x02, 0xf0, 0x80, # COTP (see above for info) + 0x32, # S7 Protocol ID + 0x01, # Job Type + 0x00, 0x00, # Redundancy identification (AB_EX) + 0x05, 0x00, # PDU Reference #snap7 (increment by every read/write) + 0x00, 0x0e, # Parameters Length + 0x00, 0x00, # Data Length = Size(bytes) + 4 + 0x04, # Function 4 Read Var, 5 Write Var + #reqest param head + 0x01, # Items count + 0x12, # Var spec. + 0x0a, # Length of remaining bytes + 0x10, # Syntax ID + &S7WLByte, # Transport Size + 0x00, 0x00, # Num Elements + 0x00, 0x00, # DB Number (if any, else 0) + 0x84, # Area Type + 0x00, 0x00, 0x00, # Area Offset + # WR area + 0x00, # Reserved + 0x04, # Transport size + 0x00, 0x00, # Data Length * 8 (if not timer or counter) + ); + + $self->{PDU}->{H} = pack( "C35", + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ); + $self->{PDU}->{DATA} = ""; + + # print "New S7 Client created\n"; + return bless $self, $class; +} + +#----------------------------------------------------------------------------- +sub DESTROY { + my $self = shift; + $self->Disconnect(); +} + +#----------------------------------------------------------------------------- +sub GetNextWord { + my $self = shift; + $self->{cntword} = 0 if ( $self->{cntword} == 0xFFFF ); + return $self->{cntword}++; +} + +#----------------------------------------------------------------------------- +sub SetLastError { + my ( $self, $Error ) = @_; + $self->{LastError} = $Error; + return $Error; +} + +#----------------------------------------------------------------------------- +#sub WaitForData_XXX { +# my ($self, $Size, $Timeout) = @_; +# my $BytesReady; + +# $Timeout = $Timeout / 1000; +## $Timeout = 1 if ($Timeout < 1); #deactivated in V2.9 +# +# +# my @ready = $self->{TCPClientSel}->can_read($Timeout); +# +# if (scalar(@ready)) { +# return $self->SetLastError(0); +# } +# +# # Here we are in timeout zone, if there's something into the buffer, it must be discarded. +# $self->Purge(); +# +# if (!$self->{TCPClient}->connected()) { +# return $self->SetLastError(&errTCPConnectionReset); +# } +# +# return $self->SetLastError(&errTCPDataRecvTout); +#} + +sub WaitForData { + my ( $self, $Size, $Timeout ) = @_; + my $BytesReady; + + $Timeout = $Timeout / 1000; + + # $Timeout = 1 if ($Timeout < 1); #deactivated in V2.9 + my @ready = $self->{TCPClientSel}->can_read($Timeout); + + if ( scalar(@ready) ) { + return $self->SetLastError(0); + } + +# Here we are in timeout zone, if there's something into the buffer, it must be discarded. + $self->{TCPClient}->flush(); + if ( !$self->{TCPClient}->connected() ) { + return $self->SetLastError(&errTCPConnectionReset); + } + + return $self->SetLastError(&errTCPDataRecvTout); +} + +#----------------------------------------------------------------------------- +sub IsoPduSize { + my ($self) = @_; + + my @buffer = unpack( "C" x 4, $self->{PDU}->{H} ); + my $Size = $buffer[2]; + return ( $Size << 8 ) + $buffer[3]; + +} + +#----------------------------------------------------------------------------- +sub RecvPacket { + my ( $self, $Size ) = @_; + my $buf; + + $self->WaitForData( $Size, $self->{RecvTimeout} ); + if ( $self->{LastError} != 0 ) { + + return $self->{LastError}; + } + + # + # recv($self->{TCPClient}, $buf, $Size , &MSG_NOSIGNAL); + # if (defined ($buf) && length($buf) == $Size ) + # { + # return ($self->SetLastError(0),$buf); + # } else { + # main::Log3 undef, 3,"TCPClient RecvPacket error (IP= ".$self->{Peer}.")."; + # return $self->SetLastError(&errTCPConnectionReset,$buf); + # } + + my $res = $self->{TCPClient}->recv( $buf, $Size ); + + if ( defined($buf) && length($buf) == $Size ) { + return ( $self->SetLastError(0), $buf ); + } + else { + + if ( defined($buf) ) { + + if ( $main::attr{global}{verbose} <= 3 ) { + my $b = join( ", ", unpack( "H2 " x length($buf), $buf ) ); + main::Log3 undef, 3, + "TCPClient RecvPacket error (IP= " + . $self->{Peer} . "): " + . $b; + } + } + else { + main::Log3 undef, 3, + "TCPClient RecvPacket error (IP= " . $self->{Peer} . ")."; + } + return $self->SetLastError( &errTCPConnectionReset, $buf ); + } + + # if ( !defined($res) ) #todo fix error handling for RecvPacket + # { + + # main::Log3 undef, 3,"TCPClient RecvPacket error."; + # # print "RecvPacket recv error, Size $Size, $buf \n"; + # return $self->SetLastError(&errTCPConnectionReset,$buf); + # } elsif ($res != 0) { + # main::Log3 undef, 3,"TCPClient RecvPacket error : $res"; + # return $self->SetLastError(&errTCPConnectionReset,$buf); + # } + # return ($self->SetLastError(0),$buf); + +} + +#----------------------------------------------------------------------------- +sub SetConnectionParams { + + my ( $self, $Address, $LocalTSAP, $RemoteTSAP ) = @_; + + $self->{Peer} = $Address; + $self->{LocalTSAP_HI} = $LocalTSAP >> 8; + $self->{LocalTSAP_LO} = $LocalTSAP & 0x00FF; + $self->{RemoteTSAP_HI} = $RemoteTSAP >> 8; + $self->{RemoteTSAP_LO} = $RemoteTSAP & 0x00FF; +} + +#----------------------------------------------------------------------------- +sub SetConnectionType { + my ( $self, $ConnectionType ) = @_; + + $self->{ConnType} = $ConnectionType; +} + +#----------------------------------------------------------------------------- +sub ConnectTo { + my ( $self, $Address, $Rack, $Slot ) = @_; + + $self->SetConnectionParams( $Address, 0x0100, + ( $self->{ConnType} << 8 ) + ( $Rack * 0x20 ) + $Slot ); + + return $self->Connect(); +} + +#----------------------------------------------------------------------------- + +sub Connect { + my ($self) = @_; + $self->{LastError} = 0; + if ( !$self->{Connected} ) { + $self->TCPConnect(); + if ( $self->{LastError} == 0 ) # First stage : TCP Connection + { + $self->ISOConnect(); + if ( $self->{LastError} == + 0 ) # Second stage : ISOTCP (ISO 8073) Connection + { + $self->{LastError} = $self->NegotiatePduLength() + ; # Third stage : S7 PDU negotiation + } + } + } + + if ( $self->{LastError} == 0 ) { + $self->{Connected} = 1; + } + else { + $self->{Connected} = 0; + } + return $self->{LastError}; +} + +#----------------------------------------------------------------------------- +sub Disconnect { + my ($self) = @_; + if ( $self->{Connected} ) { + + $self->{TCPClientSel} = undef; + +# Purge() if (shutdown($self->{TCPClient}, &SD_SEND)==0);#Anmerkung SD_SEND = 1 +# close($self->{TCPClient}); + + if ( defined( $self->{TCPClient} ) ) { + my $res = shutdown( $self->{TCPClient}, 1 ); + if ( defined($res) ) { + $self->{TCPClient}->flush() if ( $res == 0 ); + } + $self->{TCPClient}->close(); + + $self->{TCPClient} = undef; + } + $self->{Connected} = 0; + $self->{PDULength} = 0; + $self->{MaxReadLength} = 0; + $self->{LastError} = 0; + } +} + +#----------------------------------------------------------------------------- +sub TCPConnect { + my ($self) = @_; + + # # 1. create a socket handle (descriptor) + # my($sock); + # socket($sock, AF_INET, SOCK_STREAM, IPPROTO_TCP);#TCP_NODELAY, + # + # or die "ERROR in Socket Creation: $!"; + # + # # 2. connect to remote server + # my $remote = $self->{Peer}; + # + # my $iaddr = inet_aton($remote) or die "Unable to resolve hostname : $remote"; + # my $paddr = sockaddr_in(&isotcp, $iaddr); #socket address structure + # + # connect($sock , $paddr) or die "connect to $remote failed : $!"; + # $self->{TCPClient} = $sock; + # return $self->SetLastError(0); + # + # $self->{TCPClientSel} = new IO::Select($self->{TCPClient}); + + $self->{TCPClient} = new IO::Socket::INET( + PeerAddr => $self->{Peer}, + + # PeerHost => $self->{Peer}, + PeerPort => &isotcp, + Type => Socket::SOCK_STREAM, # probably needed on some systems + + Proto => 'tcp', + ) or die "ERROR in Socket Creation: $!"; + + $self->{TCPClient}->sockopt( &Socket::TCP_NODELAY, 1 ); + + $self->{TCPClient}->autoflush(1); + + $self->{TCPClientSel} = new IO::Select( $self->{TCPClient} ); + + return $self->SetLastError(0); + +} + +#----------------------------------------------------------------------------- + +sub RecvISOPacket { + + my ($self) = @_; + my $Size; + + my $Done = 0; + my $pdubuffer = ""; + my $res; + + $self->{LastError} = 0; + while ( ( $self->{LastError} == 0 ) && !$Done ) { + + # Get TPKT (4 bytes) + ( $res, $pdubuffer ) = $self->RecvPacket(4); + if ( $self->{LastError} == 0 ) { + + my $b = join( ", ", unpack( "H2 " x 4, $pdubuffer ) ); + + $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 4 ); + $Size = $self->IsoPduSize(); + main::Log3 undef, 5, + "TCPClient RecvISOPacket Expected Size = $Size"; + + # Check 0 bytes Data Packet (only TPKT+COTP - 7 bytes) + if ( $Size == 7 ) { + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket(3); + + $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 3 ); + + } + else { + my $maxlen = $self->{PDULength} + &ISOSize; + if ( $maxlen <= &MinPduSize ) { + $maxlen = &MaxPduSize; + } + + # if (($Size > &MaxPduSize) || ($Size < &MinPduSize)) { + if ( ( $Size > $maxlen ) || ( $Size < &MinPduSize ) ) { + main::Log3 undef, 3, + "TCPClient RecvISOPacket PDU overflow (IP= " + . $self->{Peer} + . "): size = $Size , maxPDULength = " + . $self->{PDULength}; + $self->{LastError} = &errISOInvalidPDU; + } + else { + $Done = 1; # a valid Length !=7 && >16 && <247 + } + } + } + } + if ( $self->{LastError} == 0 ) { + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket(3); + + $self->{PDU}->{H} = $pdubuffer + . substr( $self->{PDU}->{H}, 3 ); # Skip remaining 3 COTP bytes + + my @mypdu = unpack( "C2", $self->{PDU}->{H} ); + + $self->{LastPDUType} = $mypdu[1]; # Stores PDU Type, we need it + $Size -= &ISOSize; + + # We need to align with PDU.DATA + + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket($Size); + + if ( $main::attr{global}{verbose} <= 5 ) { + my $b = join( ", ", unpack( "H2 " x $Size, $pdubuffer ) ); + main::Log3 undef, 5, + "TCPClient RecvISOPacket (IP= " . $self->{Peer} . "): $b"; + } + + #we write the data starting at position 17 (shift) into the PDU.H + if ( $self->{LastError} == 0 ) { + + if ( $Size > &Size_WR - &S7Shift ) { + my $headerSize = &Size_WR - &S7Shift; + + $self->{PDU}->{H} = + substr( $self->{PDU}->{H}, 0, &S7Shift ) + . substr( $pdubuffer, 0, $headerSize ); + + $self->{PDU}->{DATA} = substr( $pdubuffer, $headerSize ); + + } + else { + + $self->{PDU}->{H} = + substr( $self->{PDU}->{H}, 0, &S7Shift ) + . $pdubuffer + . substr( $self->{PDU}->{H}, &Size_WR - &S7Shift - $Size ); + } + } + + } + if ( $self->{LastError} != 0 ) { + $self->{TCPClient}->flush(); + } + return ( $self->{LastError}, $Size ); +} + +#----------------------------------------------------------------------------- + +#sub Purge()#flushed tcpbuffer +#{ +# my ($self) = @_; +# # small buffer to empty the socket +# my $Trash; +# +# my $Read; +# +# if ($self->{LastError}!= WSAECONNRESET) +# { +# if (CanRead(0)) { +# do +# { +# recv($self->{TCPClient}, $Trash, 512, &MSG_NOSIGNAL ); +# } while( defined ($Trash) && length($Trash)==512); +# } +# } +#} + +#----------------------------------------------------------------------------- + +sub ISOConnect { + my ($self) = @_; + + my $Done = 0; + my $myLength = 0; + my $res; + + # Setup TSAPs + my @myISO_CR = unpack( "C22", $self->{ISO_CR} ); + $myISO_CR[16] = $self->{LocalTSAP_HI}; + $myISO_CR[17] = $self->{LocalTSAP_LO}; + $myISO_CR[20] = $self->{RemoteTSAP_HI}; + $myISO_CR[21] = $self->{RemoteTSAP_LO}; + $self->{ISO_CR} = pack( "C22", @myISO_CR ); + + my $b = join( ", ", unpack( "H2 " x 22, $self->{ISO_CR} ) ); + + if ( $self->{TCPClient}->send( $self->{ISO_CR} ) == 22 ) + + # if (send($self->{TCPClient}, $self->{ISO_CR}, &MSG_NOSIGNAL)==22) + { + ( $res, $myLength ) = $self->RecvISOPacket(); + + if ( ( $self->{LastError} == 0 ) + && ( $myLength == 15 ) + ) # 15 = 22 (sizeof CC telegram) - 7 (sizeof Header) + { + if ( $self->{LastPDUType} == &CC ) { #Connection confirm + return 0; + } + else { + return $self->SetLastError(&errISOInvalidPDU); + } + } + else { + return $self->{LastError}; + } + } + else { + return $self->SetLastError(&errISOConnectionFailed); + } +} + +#----------------------------------------------------------------------------- +sub NegotiatePduLength { + my ($self) = @_; + + my $myLength; + my $res; + + # Setup TSAPs + my @myS7_PN = unpack( "C25", $self->{S7_PN} ); + my $myPDUID = $self->GetNextWord(); + $myS7_PN[11] = $myPDUID % 256; + $myS7_PN[12] = ( $myPDUID >> 8 ) % 256; + $self->{S7_PN} = pack( "C25", @myS7_PN ); + + if ( $self->{TCPClient}->send( $self->{S7_PN} ) == 25 ) + + # if (send($self->{TCPClient}, $self->{S7_PN}, &MSG_NOSIGNAL)==25) + { + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + + # check S7 Error + my @myPDUheader = unpack( "C35", $self->{PDU}->{H} ); + + if ( ( $myLength == 20 ) + && ( $myPDUheader[27] == 0 ) + && ( $myPDUheader[28] == 0 ) ) # 20 = size of Negotiate Answer + { + my @myPDUdata = unpack( "C2", $self->{PDU}->{DATA} ); + + $self->{PDULength} = $myPDUdata[0]; + $self->{PDULength} = + ( $self->{PDULength} << 8 ) + + $myPDUdata[1]; # Value negotiated + + $self->{MaxReadLength} = ( $self->{PDULength} - 18 ); + + if ( $self->{PDULength} > 0 ) { + return 0; + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } + } + else { + return $self->{LastError}; + } + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } +} + +sub getPDULength() { + my ($self) = @_; + + if ( $self->{Connected} ) { + return $self->{PDULength}; + } + + return -1; +} + +#----------------------------------------------------------------------------- +sub ReadArea () { + + my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen ) = @_; + + my $ptrData = ""; + + my $Address; + my $NumElements; + my $MaxElements; + my $TotElements; + my $SizeRequested; + my $myLength; + my $res; + + my $WordSize = 1; + + $self->{LastError} = 0; + + # If we are addressing Timers or counters the element size is 2 + $WordSize = 2 if ( ( $Area == &S7AreaCT ) || ( $Area == &S7AreaTM ) ); + + $MaxElements = + ( $self->{PDULength} - 18 ) / $WordSize; # 18 = Reply telegram header + $TotElements = $Amount; + + while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { + $NumElements = $TotElements; + $NumElements = $MaxElements if ( $NumElements > $MaxElements ); + + $SizeRequested = $NumElements * $WordSize; + + # Setup the telegram + my @myPDU = + unpack( "C" x &Size_RD, substr( $self->{S7_RW}, 0, &Size_RD ) ); + + #my $b = join( ", ", unpack("H2 " x &Size_RD,$self->{S7_RW})); + # print "ReadArea: S7_RW :".$b."\n"; + + #set PDU Ref + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = $myPDUID % 256; + $myPDU[12] = ( $myPDUID >> 8 ) % 256; + + $myPDU[20] = 0x0a; # Length of remaining bytes + $myPDU[21] = 0x10; # syntag ID + + # Set DB Number + $myPDU[27] = $Area; + if ( $Area == &S7AreaDB ) { + $myPDU[25] = ( $DBNumber >> 8 ) % 256; + $myPDU[26] = $DBNumber % 256; + } + else { + $myPDU[25] = 0x00; + $myPDU[26] = 0x00; + } + + # Adjusts Start + if ( ( $WordLen == &S7WLBit ) + || ( $WordLen == &S7WLCounter ) + || ( $WordLen == &S7WLTimer ) ) + { + $Address = $Start; + } + else { + $Address = $Start << 3; + } + + #set word length + $myPDU[22] = $WordLen; + + # Num elements + $myPDU[23] = ( $NumElements >> 8 ) + % 256; # hier ist denke ich ein fehler in der settimino.cpp + + $myPDU[24] = ($NumElements) % 256; + + # Address into the PLC + $myPDU[30] = ($Address) % 256; + $Address = $Address >> 8; + $myPDU[29] = ($Address) % 256; + $Address = $Address >> 8; + $myPDU[28] = ($Address) % 256; + + $self->{PDU}->{H} = + pack( "C" x &Size_RD, @myPDU ) + . substr( $self->{PDU}->{H}, &Size_RD ); + + if ( $main::attr{global}{verbose} <= 5 ) { + $b = join( ", ", unpack( "H2 " x &Size_RD, $self->{PDU}->{H} ) ); + main::Log3 undef, 5, + "TCPClient ReadArea (IP= " . $self->{Peer} . "): $b"; + } + + $b = substr( $self->{PDU}->{H}, 0, &Size_RD ); + if ( $self->{TCPClient}->send($b) == &Size_RD ) + { #Achtung PDU.H ist größer als &Size_RD + +# if (send($self->{TCPClient}, $b, &MSG_NOSIGNAL)== &Size_RD) #Achtung PDU.H ist größer als &Size_RD + + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + if ( $myLength >= 18 ) { + + @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); + + if ( ( $myLength - 18 == $SizeRequested ) ) { + + #response was OK + $ptrData = + substr( $self->{PDU}->{DATA}, 0, $SizeRequested ) + ; # Copies in the user's buffer + } + else { # PLC reports an error + if ( $myPDU[31] == 0xFF ) { + + my $b = join( + ", ", + unpack( + "H2 " x $myLength, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 undef, 3, + "TCPClient ReadArea error (IP= " + . $self->{Peer} + . ") returned data not expected size: $b"; + } + else { + my $b = join( + ", ", + unpack( + "H2 " x ( + length( $self->{PDU}->{H} ) + + length( $self->{PDU}->{DATA} ) + ), + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 undef, 3, + "TCPClient ReadArea error (IP= " + . $self->{Peer} + . ") returned data not OK: $b"; + } + $self->{LastError} = &errS7DataRead; + } + } + else { + $self->{LastError} = &errS7InvalidPDU; + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + } + + $TotElements -= $NumElements; + $Start += $NumElements * $WordSize; + } + return ( $self->{LastError}, $ptrData ); +} + +#----------------------------------------------------------------------------- + +sub WriteArea { + my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen, $ptrData ) = @_; + + my $Address; + my $NumElements; + my $MaxElements; + my $TotElements; + my $DataSize; + my $IsoSize; + my $myLength; + + my $Offset = 0; + my $WordSize = 1; + my $res; + + $self->{LastError} = 0; + + # If we are addressing Timers or counters the element size is 2 + $WordSize = 2 if ( ( $Area == &S7AreaCT ) || ( $Area == &S7AreaTM ) ); + + $MaxElements = + ( $self->{PDULength} - 35 ) / $WordSize; # 35 = Write telegram header + $TotElements = $Amount; + + while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { + $NumElements = $TotElements; + if ( $NumElements > $MaxElements ) { + $NumElements = $MaxElements; + } + + #If we use the internal buffer only, we cannot exced the PDU limit + $DataSize = + $NumElements * $WordSize; #<------ Fehler Datasize sollte in Byte sein + $IsoSize = &Size_WR + $DataSize; + + # Setup the telegram + my @myPDU = + unpack( "C" x &Size_WR, substr( $self->{S7_RW}, 0, &Size_WR ) ); + + # Whole telegram Size + # PDU Length + $myPDU[2] = ( $IsoSize >> 8 ) % 256; + $myPDU[3] = $IsoSize % 256; + + #set PDU Ref + + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = $myPDUID % 256; + $myPDU[12] = ( $myPDUID >> 8 ) % 256; + + # Data Length + $myLength = $DataSize + 4; + $myPDU[15] = ( $myLength >> 8 ) % 256; + $myPDU[16] = $myLength % 256; + + # Function + $myPDU[17] = 0x05; + + $myPDU[20] = 0x0a; # Length of remaining bytes + $myPDU[21] = 0x10; # syntag ID + + # Set DB Number + $myPDU[27] = $Area; + if ( $Area == &S7AreaDB ) { + $myPDU[25] = ( $DBNumber >> 8 ) % 256; + $myPDU[26] = $DBNumber % 256; + } + + # Adjusts Start + if ( ( $WordLen == &S7WLBit ) + || ( $WordLen == &S7WLCounter ) + || ( $WordLen == &S7WLTimer ) ) + { + $Address = $Start; + } + else { + $Address = $Start << 3; + } + + # Address into the PLC + $myPDU[30] = $Address % 256; + $Address = $Address >> 8; + $myPDU[29] = $Address % 256; + $Address = $Address >> 8; + $myPDU[28] = $Address % 256; + + #transport size + my $bytesProElement; + + if ( $WordLen == &S7WLBit ) { + $myPDU[32] = &TS_ResBit; + $bytesProElement = 1; + } + + # elsif ($WordLen == &S7WLWord) { #V2.8 will be send as Bytes! + # $myPDU[32] = &TS_ResInt; + # $bytesProElement = 2; + # } + # elsif ($WordLen == &S7WLDWord) { + # $myPDU[32] = &TS_ResInt; + # $bytesProElement = 4; + # } + elsif ( $WordLen == &S7WLInt ) { + $myPDU[32] = &TS_ResInt; + $bytesProElement = 2; + } + elsif ( $WordLen == &S7WLDInt ) { + $myPDU[32] = &TS_ResInt; + $bytesProElement = 4; + } + elsif ( $WordLen == &S7WLReal ) { + $myPDU[32] = &TS_ResReal; + $bytesProElement = 4; + } + elsif ( $WordLen == &S7WLChar ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 1; + } + elsif ( $WordLen == &S7WLCounter ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 2; + } + elsif ( $WordLen == &S7WLTimer ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 2; + } + else { + $myPDU[32] = &TS_ResByte; + $bytesProElement = 1; + } + + if ( ( $myPDU[32] != &TS_ResOctet ) + && ( $myPDU[32] != &TS_ResReal ) + && ( $myPDU[32] != &TS_ResBit ) ) + { + $myLength = $DataSize << 3; + + } + else { + $myLength = $DataSize; + } + + # Num elements + my $nElements = int( $NumElements / $bytesProElement ); + $myPDU[23] = ( $nElements >> 8 ) % 256; + $myPDU[24] = ($nElements) % 256; + + #set word length + $myPDU[22] = $WordLen; + + # Length + $myPDU[33] = ( $myLength >> 8 ) % 256; + $myPDU[34] = $myLength % 256; + $self->{PDU}->{H} = pack( "C" x &Size_WR, @myPDU ); + + # Copy data + $self->{PDU}->{DATA} = substr( $ptrData, $Offset, $DataSize ); + + if ( $main::attr{global}{verbose} <= 5 ) { + my $b = join( + ", ", + unpack( + "H2 " x $IsoSize, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 undef, 5, + "TCPClient WriteArea (IP= " . $self->{Peer} . "): $b"; + } + if ( + $self->{TCPClient}->send( $self->{PDU}->{H} . $self->{PDU}->{DATA} ) + == $IsoSize ) + { + +# if (send($self->{TCPClient}, $self->{PDU}->{H}.$self->{PDU}->{DATA}, &MSG_NOSIGNAL)== $IsoSize) + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + + if ( $myLength == 15 ) { + @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); + + if ( ( $myPDU[27] != 0x00 ) + || ( $myPDU[28] != 0x00 ) + || ( $myPDU[31] != 0xFF ) ) + { + $self->{LastError} = &errS7DataWrite; + + #CPU has sent an Error? + my $cpuErrorCode = $myPDU[31]; + my $error = $self->getCPUErrorStr($cpuErrorCode); + + my $msg = + "TCPClient WriteArea error: $cpuErrorCode = $error"; + main::Log3 undef, 3, $msg; + + } + + } + else { + $self->{LastError} = &errS7InvalidPDU; + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + } + + $Offset += $DataSize; + $TotElements -= $NumElements; + $Start += $NumElements * $WordSize; + } + return $self->{LastError}; +} + +#----------------------------------------------------------------------------- +sub getPLCDateTime() { + my ($self) = @_; + my $IsoSize; + my $res; + my $TotElements; + + main::Log3 undef, 3, "TCPClient getPLCDateTime:"; + + # Setup the telegram + my @myPDU = unpack( "C" x &Size_DT, substr( $self->{S7_RW}, 0, &Size_DT ) ); + + # Whole telegram Size + # PDU Length + $IsoSize = &Size_DT; + + $myPDU[2] = ( $IsoSize >> 8 ) % 256; + $myPDU[3] = $IsoSize % 256; + + $myPDU[8] = 0x07; #job type = userdata + + $myPDU[9] = 0x00; # Redundancy identification + $myPDU[10] = 0x00; + + #set PDU Ref + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = ( $myPDUID >> 8 ) % 256; + $myPDU[12] = $myPDUID % 256; + + #parameter length + $myPDU[13] = 0x00; + $myPDU[14] = 0x08; + + # Data Length + my $myLength = 4; + $myPDU[15] = ( $myLength >> 8 ) % 256; + $myPDU[16] = $myLength % 256; + + # Function + $myPDU[17] = 0x04; #read + + #set parameter heads + $myPDU[18] = 0x01; # Items count + $myPDU[19] = 0x12; # Var spec. + $myPDU[20] = 0x04; # Length of remaining bytes + $myPDU[21] = 0x11; # uk + $myPDU[22] = 0x47; # tg = grClock + $myPDU[23] = 0x01; #subfunction: Read Clock (Date and Time) + $myPDU[24] = 0x00; #Seq + + $self->{PDU}->{H} = + pack( "C" x &Size_DT, @myPDU ) . substr( $self->{PDU}->{H}, &Size_DT ); + + my $b = join( ", ", unpack( "H2 " x &Size_DT, $self->{PDU}->{H} ) ); + main::Log3 undef, 3, + "TCPClient getPLCDateTime (IP= " . $self->{Peer} . "): $b"; + + $b = substr( $self->{PDU}->{H}, 0, &Size_DT ); + if ( $self->{TCPClient}->send($b) == &Size_DT ) { + + # main::Log3 undef, 3,"TCPClient getPLCDateTime request sent"; + ( $res, $myLength ) = $self->RecvISOPacket(); + main::Log3 undef, 3, "TCPClient getPLCDateTime RecvISOPacket $res"; + if ( $self->{LastError} == 0 ) { + if ( $myLength >= 18 ) { + + @myPDU = unpack( "C" x $myLength, $self->{PDU}->{H} ); + my $b = join( + ", ", + unpack( + "H2 " x $myLength, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 undef, 3, + "TCPClient getPLCDateTime getPLCTime Result (IP= " + . $self->{Peer} . "): $b"; + + } + else { + $self->{LastError} = &errS7InvalidPDU; + main::Log3 undef, 3, + "TCPClient getPLCDateTime errS7InvalidPDU length $myLength"; + + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + main::Log3 undef, 3, "TCPClient getPLCDateTime errTCPDataSend"; + } + + # $TotElements -= $NumElements; + # $Start += $NumElements * $WordSize; + # } + # return ($self->{LastError},$ptrData); + return ( $self->{LastError}, 0 ); + +# IsoSize=sizeof(TS7ReqHeader)+sizeof(TReqFunDateTime)+sizeof(TReqDataGetDateTime); +# Result=isoExchangeBuffer(0,IsoSize); + + # Get Data + # if (Result==0) + # { + # if (ResParams->Err==0) + # { + # if (ResData->RetVal==0xFF) // <-- 0xFF means Result OK + # { + # // Decode Plc Date and Time + # AYear=BCDtoByte(ResData->Time[0]); + # if (AYear<90) + # AYear=AYear+100; + # DateTime->tm_year=AYear; + # DateTime->tm_mon =BCDtoByte(ResData->Time[1])-1; + # DateTime->tm_mday=BCDtoByte(ResData->Time[2]); + # DateTime->tm_hour=BCDtoByte(ResData->Time[3]); + # DateTime->tm_min =BCDtoByte(ResData->Time[4]); + # DateTime->tm_sec =BCDtoByte(ResData->Time[5]); + # DateTime->tm_wday=(ResData->Time[7] & 0x0F)-1; + # } + # else + # Result=CpuError(ResData->RetVal); + # } + # else + # Result=CpuError(ResData->RetVal); + # } + # return Result; + # +} + +#----------------------------------------------------------------------------- +sub BitAt { + + my ( $self, $Buffer, $ByteIndex, $BitIndex ) = @_; + + return 0 if ( $BitIndex > 7 ); + + my @mask = ( 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80 ); + + my @myBuffer = unpack( "C" x $ByteIndex + 1, $Buffer ); + + return 1 if ( ( $myBuffer[$ByteIndex] & $mask[$BitIndex] ) != 0 ); + return 0; + +} + +#----------------------------------------------------------------------------- + +sub ByteAt { + my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + return $myBuffer[$index]; +} + +#----------------------------------------------------------------------------- +sub WordAt { + + my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + my $hi = $myBuffer[$index] << 8; + + return ( $hi + $myBuffer[ $index + 1 ] ); +} + +#----------------------------------------------------------------------------- + +sub DWordAt { + my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + my $dw1; + + $dw1 = $myBuffer[$index] << 8; + + $dw1 = ( $dw1 + $myBuffer[ $index + 1 ] ) << 8; + + $dw1 = ( $dw1 + $myBuffer[ $index + 2 ] ) << 8; + + $dw1 = ( $dw1 + $myBuffer[ $index + 3 ] ); + + return $dw1; +} + +#----------------------------------------------------------------------------- +sub FloatAt { + my @myBuffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + my @bytes = ( + $myBuffer[$index], + $myBuffer[ $index + 1 ], + $myBuffer[ $index + 2 ], + $myBuffer[ $index + 3 ] + ); + + if ( $Config::Config{byteorder} =~ /^1/ ) + { #take care of the machines byte order + return unpack( 'f', pack( 'C4', reverse @bytes ) ); + } + return unpack( 'f', pack( 'C4', @bytes ) ); +} + +#----------------------------------------------------------------------------- +sub ShortAt { + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + # my ( $self, $Buffer, $index ) = @_; + + my $b = $self->ByteAt( \@Buffer, $index ); + + if ( ( $b & 0x80 ) != 0 ) { + + return -( ( ~$b & 0xff ) + 1 ); + } + return $b; +} + +#----------------------------------------------------------------------------- + +sub IntegerAt { + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + # my ( $self, $Buffer, $index ) = @_; + # my $w = $self->WordAt( $Buffer, $index ); + + my $w = $self->WordAt( \@Buffer, $index ); + + return ( $w & 0x8000 ) ? -( ( ( ~$w ) & 0xffff ) + 1 ) : $w; + +} + +#----------------------------------------------------------------------------- +sub DintAt { + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + + my $dw = $self->DWordAt( \@Buffer, $index ); + + # my ( $self, $Buffer, $index ) = @_; + + # my $dw = $self->DWordAt( $Buffer, $index ); + + return ( $dw & 0x80000000 ) ? -( ( ~$dw & 0xffffffff ) + 1 ) : $dw; +} + +#----------------------------------------------------------------------------- +sub GetU8from { + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->ByteAt( \@Buffer, $index ); + + # my ( $self, $Buffer, $index ) = @_; + # return $self->ByteAt( $Buffer, $index ); +} + +#----------------------------------------------------------------------------- + +sub GetS8from { + + # my ( $self, $Buffer, $index ) = @_; + # return ShortAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->ShortAt( \@Buffer, $index ); +} + +#----------------------------------------------------------------------------- +sub GetU16from { + + # my ( $self, $Buffer, $index ) = @_; + # return $self->WordAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->WordAt( \@Buffer, $index ); +} + +#----------------------------------------------------------------------------- + +sub GetS16from { + + # my ( $self, $Buffer, $index ) = @_; + # return $self->IntegerAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->IntegerAt( \@Buffer, $index ); +} + +#----------------------------------------------------------------------------- + +sub GetU32from { + + # my ( $self, $Buffer, $index ) = @_; + # return $self->DWordAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->DWordAt( \@Buffer, $index ); + +} + +#----------------------------------------------------------------------------- +sub GetS32from { + + # my ( $self, $Buffer, $index ) = @_; + # return $self->DintAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->DintAt( \@Buffer, $index ); + +} + +#----------------------------------------------------------------------------- + +sub GetFloatfrom { + + # my ( $self, $Buffer, $index ) = @_; + # return $self->FloatAt( $Buffer, $index ); + my $self = $_[0]; + my @Buffer = @{ $_[1] }; # ersten Parameter dereferenzieren + my $index = $_[2]; + return $self->FloatAt( \@Buffer, $index ); + +} + +#----------------------------------------------------------------------------- + +sub setByteAt { + my ( $self, $Buffer, $index, $value ) = @_; + my @myBuffer = unpack( "C" x length($Buffer), $Buffer ); + + $myBuffer[$index] = $value % 256; + + return pack( "C" x length($Buffer), @myBuffer ); +} + +#----------------------------------------------------------------------------- +sub setWordAt { + my ( $self, $Buffer, $index, $value ) = @_; + my @myBuffer = unpack( "C" x length($Buffer), $Buffer ); + + $myBuffer[$index] = $value >> 8; + $myBuffer[ $index + 1 ] = $value % 256; + + return pack( "C" x length($Buffer), @myBuffer ); +} + +#----------------------------------------------------------------------------- + +sub setDWordAt { + my ( $self, $Buffer, $index, $value ) = @_; + my @myBuffer = unpack( "C" x length($Buffer), $Buffer ); + + $myBuffer[ $index + 3 ] = $value % 256; + $value = $value >> 8; + $myBuffer[ $index + 2 ] = $value % 256; + $value = $value >> 8; + $myBuffer[ $index + 1 ] = $value % 256; + $value = $value >> 8; + $myBuffer[$index] = $value % 256; + + return pack( "C" x length($Buffer), @myBuffer ); +} + +#----------------------------------------------------------------------------- +sub setFloatAt { + my ( $self, $Buffer, $index, $value ) = @_; + my @myBuffer = unpack( "C" x length($Buffer), $Buffer ); + + my @bytes = unpack( 'C4', pack( 'f', $value ) ); + if ( $Config::Config{byteorder} =~ /^1/ ) + { #take care of the machines byte order + $myBuffer[$index] = $bytes[3]; + $myBuffer[ $index + 1 ] = $bytes[2]; + $myBuffer[ $index + 2 ] = $bytes[1]; + $myBuffer[ $index + 3 ] = $bytes[0]; + } + else { + $myBuffer[$index] = $bytes[0]; + $myBuffer[ $index + 1 ] = $bytes[1]; + $myBuffer[ $index + 2 ] = $bytes[2]; + $myBuffer[ $index + 3 ] = $bytes[3]; + } + + return pack( "C" x length($Buffer), @myBuffer ); + +} + +#----------------------------------------------------------------------------- +sub setShortAt { + my ( $self, $Buffer, $index, $value ) = @_; + $value = ( ( ~( -$value ) ) & 0xff ) + 1 if ( $value < 0 ); + return $self->setByteAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- + +sub setIntegerAt { + + my ( $self, $Buffer, $index, $value ) = @_; + $value = ( ( ~( -$value ) ) & 0xffff ) + 1 if ( $value < 0 ); + return $self->setWordAt( $Buffer, $index, $value ); + +} + +#----------------------------------------------------------------------------- +sub setDintAt { + my ( $self, $Buffer, $index, $value ) = @_; + $value = ( ( ~( -$value ) ) & 0xffffffff ) + 1 if ( $value < 0 ); + return $self->setDWordAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- + +sub Put8At { + my ( $self, $Buffer, $index, $value ) = @_; + return $self->setByteAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- +sub Put16At { + my ( $self, $Buffer, $index, $value ) = @_; + return $self->setIntegerAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- +sub Put32At { + my ( $self, $Buffer, $index, $value ) = @_; + return $self->setDintAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- + +sub PutFloatAt { + my ( $self, $Buffer, $index, $value ) = @_; + return $self->setFloatAt( $Buffer, $index, $value ); +} + +#----------------------------------------------------------------------------- + +sub version { + return "1.0"; +} + +#----------------------------------------------------------------------------- + +sub getErrorStr { + my ( $self, $errorCode ) = @_; + + if ( $errorCode == &errTCPConnectionFailed ) { + return "TCP Connection error"; + } + elsif ( $errorCode == &errTCPConnectionReset ) { + return "Connection reset by the peer"; + } + elsif ( $errorCode == &errTCPDataRecvTout ) { + return "A timeout occurred waiting a reply."; + } + elsif ( $errorCode == &errTCPDataSend ) { + return "Ethernet driver returned an error sending the data"; + } + elsif ( $errorCode == &errTCPDataRecv ) { + return "Ethernet driver returned an error receiving the data."; + } + elsif ( $errorCode == &errISOConnectionFailed ) { + return "ISO connection failed."; + } + elsif ( $errorCode == &errISONegotiatingPDU ) { + return "ISO PDU negotiation failed"; + } + elsif ( $errorCode == &errISOInvalidPDU ) { + return "Malformed PDU supplied."; + } + elsif ( $errorCode == &errS7InvalidPDU ) { return "Invalid PDU received."; } + elsif ( $errorCode == &errS7SendingPDU ) { return "Error sending a PDU."; } + elsif ( $errorCode == &errS7DataRead ) { return "Error during data read"; } + elsif ( $errorCode == &errS7DataWrite ) { + return "Error during data write"; + } + elsif ( $errorCode == &errS7Function ) { + return "The PLC reported an error for this function."; + } + elsif ( $errorCode == &errBufferTooSmall ) { + return "The buffer supplied is too small."; + } + else { return "unknown errorcode"; } + +} + +sub getCPUErrorStr { + my ( $self, $errorCode ) = @_; + + if ( $errorCode == &Code7Ok ) { return "CPU: OK"; } + elsif ( $errorCode == &Code7AddressOutOfRange ) { + return "CPU: AddressOutOfRange"; + } + elsif ( $errorCode == &Code7InvalidTransportSize ) { + return "CPU: Invalid Transport Size"; + } + elsif ( $errorCode == &Code7WriteDataSizeMismatch ) { + return "CPU: Write Data Size Mismatch"; + } + elsif ( $errorCode == &Code7ResItemNotAvailable ) { + return "CPU: ResItem Not Available"; + } + elsif ( $errorCode == &Code7ResItemNotAvailable1 ) { + return "CPU: ResItem Not Available1"; + } + elsif ( $errorCode == &Code7InvalidValue ) { return "CPU: Invalid Value"; } + elsif ( $errorCode == &Code7NeedPassword ) { return "CPU: Need Password"; } + elsif ( $errorCode == &Code7InvalidPassword ) { + return "CPU: Invalid Password"; + } + elsif ( $errorCode == &Code7NoPasswordToClear ) { + return "CPU: No Password To Clear"; + } + elsif ( $errorCode == &Code7NoPasswordToSet ) { + return "CPU: No Password To Set"; + } + elsif ( $errorCode == &Code7FunNotAvailable ) { + return "CPU: Fun Not Available"; + } + elsif ( $errorCode == &Code7DataOverPDU ) { return "CPU: DataOverPDU"; } + else { return "unknown errorcode"; } +} + +1; +=pod +=begin html + + +

S7_Client

+
    + part of the S7 modul +
+=end html + +=begin html_DE + + +

S7_Client

+
    + part of the S7 modul +
+ +=end html_DE + +=cut diff --git a/fhem/FHEM/44_S7_DRead.pm b/fhem/FHEM/44_S7_DRead.pm new file mode 100644 index 000000000..5ceae389c --- /dev/null +++ b/fhem/FHEM/44_S7_DRead.pm @@ -0,0 +1,508 @@ +# $Id$ +############################################## +package main; + +use strict; +use warnings; + +#use Switch; +#use 44_S7_Client; + +my %gets = ( + + # "libnodaveversion" => "" +); + +##################################### +sub S7_DRead_Initialize($) { + my $hash = shift @_; + + # Provider + + # Consumer + $hash->{Match} = "^DR"; + + $hash->{DefFn} = "S7_DRead_Define"; + $hash->{UndefFn} = "S7_DRead_Undef"; + + $hash->{ParseFn} = "S7_DRead_Parse"; + + $hash->{AttrFn} = "S7_DRead_Attr"; + $hash->{AttrList} = "IODev " . $readingFnAttributes; + + main::LoadModule("S7"); +} + +##################################### +sub S7_DRead_Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $area, $DB, $start, $position ); + + $name = $a[0]; + + AssignIoPort($hash); # logisches modul an physikalisches binden !!! + my $sname = $hash->{IODev}{NAME}; + + my $byte; + my $bit; + + if ( uc $a[2] =~ m/^[QIMN](\d*)/ ) { + my $Offset; + $area = "db"; + $DB = 0; + my $startposition; + + if ( uc $a[2] =~ m/^Q(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 942; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1064; + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + } + elsif ( uc $a[2] =~ m/^I(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 923; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1024; + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^NI(\d*)/ ) { + $startposition = 2; + if ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1246; + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^NQ(\d*)/ ) { + $startposition = 2; + if ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1390; + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^M(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 948; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1104; + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + else { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + $position = + ( $Offset * 8 ) + int( substr( $a[2], $startposition ) ) - 1; + $byte = int( $position / 8 ); + $bit = ( $position % 8 ); + + } + else { + + $area = lc $a[2]; + $DB = $a[3]; + $position = $a[4]; + + if ( $area ne "inputs" + && $area ne "outputs" + && $area ne "flags" + && $area ne "db" ) + { + my $msg = +"wrong syntax : define S7_DRead {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DRead {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + my @address = split( /\./, $position ); + if ( int(@address) == 2 ) { + $byte = $address[0]; + $bit = $address[1]; + } + else { + + $byte = int( $address[0] / 8 ); + $bit = ( $address[0] % 8 ); + } + } + + $hash->{AREA} = $area; + $hash->{DB} = $DB; + $hash->{POSITION} = ( $byte * 8 ) + $bit; + $hash->{ADDRESS} = "$byte.$bit"; + $hash->{LENGTH} = 1; + + my $ID = "$area $DB"; + + if ( !defined( $modules{S7_DRead}{defptr}{$ID} ) ) { + my @b = (); + push( @b, $hash ); + $modules{S7_DRead}{defptr}{$ID} = \@b; + + } + else { + push( @{ $modules{S7_DRead}{defptr}{$ID} }, $hash ); + } + + $hash->{IODev}{dirty} = 1; + + Log3 $name, 4, "S7_DRead ($sname): define $name Adress:$byte.$bit"; + return undef; +} + +##################################### +sub S7_DRead_Undef($$) { + my ( $hash, $name ) = @_; + + Log3 $name, 4, + "S7_DRead (" + . $hash->{IODev}{NAME} + . "): undef " + . $hash->{NAME} + . " Adress:" + . $hash->{ADDRESS}; + + delete( $modules{S7_DRead}{defptr} ); + + return undef; +} + +##################################### + +sub S7_DRead_Parse_new($$) { + my ( $hash, $rmsg ) = @_; + my $name; + + if ( defined( $hash->{NAME} ) ) { + $name = $hash->{NAME}; + } + else { + Log3 undef, 2, "S7_DRead: Error ..."; + return undef; + } + + my @a = split( "[ \t][ \t]*", $rmsg ); + + my @list; + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + my $ID = "$area $DB"; + + Log3 $name, 6, "$name S7_DRead_Parse $rmsg"; + + my @Writebuffer = + unpack( "C" x $length, pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + + # my $b = pack( "C" x $length, @Writebuffer ); + + my $clientArray = $hash->{"Clients"}; + foreach my $h ( @{$clientArray} ) { + if ( $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + + #die Nachricht ist für den client + + my $n = $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + + my $s = int( $h->{POSITION} / 8 ) - $start; + my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + + Log3 $name, 6, "$name S7_DRead_Parse update $n "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) { + main::readingsSingleUpdate( $h, "state", "on", 1 ); + } + else { + main::readingsSingleUpdate( $h, "state", "off", 1 ); + } + } + } + + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_DRead: Parse no client found ($name) ..."; + push( @list, "" ); + } + + return @list; + +} + +##################################### + +sub S7_DRead_Parse($$) { + my ( $hash, $rmsg ) = @_; + my $name; + + if ( defined( $hash->{NAME} ) ) { + $name = $hash->{NAME}; + } + else { + Log3 undef, 2, "S7_DRead: Error ..."; + return undef; + } + + my @a = split( "[ \t][ \t]*", $rmsg ); + + my @list; + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, + $clientNames ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + $clientNames = $a[7]; + my $ID = "$area $DB"; + + Log3 $name, 5, "$name S7_DRead_Parse $rmsg"; + + # main::readingsBeginUpdate($h); + # main::readingsBulkUpdate($h,"reading",$res,1); + # main::readingsEndUpdate($h, 1); + + my @clientList = split( ",", $clientNames ); + + if ( int(@clientList) > 0 ) { + + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + + foreach my $clientName (@clientList) { + + my $h = $defs{$clientName}; + + # if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + # && $main::attr{ $h->{NAME} }{IODev} eq $name ) + # { + + if ( $h->{TYPE} eq "S7_DRead" + && $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + push( @list, $clientName ) + ; #damit die werte im client gesetzt werden! + + #aktualisierung des wertes + my $s = int( $h->{POSITION} / 8 ) - $start; + + my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + + Log3 $name, 6, "$name S7_DRead_Parse update $clientName "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) { + + main::readingsSingleUpdate( $h, "state", "on", 1 ); + + } + else { + main::readingsSingleUpdate( $h, "state", "off", 1 ); + + } + } + + # } + } + } + else { + Log3 $name, 3, "$name S7_DRead_Parse going the save way "; + + if ( defined( $modules{S7_DRead}{defptr}{$ID} ) ) { + + foreach my $h ( @{ $modules{S7_DRead}{defptr}{$ID} } ) { + + if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + && $main::attr{ $h->{NAME} }{IODev} eq $name ) + { + if ( $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + + my $n = + $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + my $s = int( $h->{POSITION} / 8 ) - $start; + + #my $b = pack( "C" x $length, @Writebuffer ); + + my $myI = + $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + + Log3 $name, 6, "$name S7_DRead_Parse update $n "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > + 0 ) + { + + main::readingsSingleUpdate( $h, "state", "on", 1 ); + + } + else { + main::readingsSingleUpdate( $h, "state", "off", 1 ); + + } + } + } + + } + } + } + + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_DRead: Parse no client found ($name) ..."; + push( @list, "" ); + } + + return @list; + +} + +##################################### +sub S7_DRead_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + + my $hash = $defs{$name}; + + if ( $cmd eq "set" ) { + + if ( $aName eq "IODev" ) { + if ( defined( $hash->{IODev} ) ) { #set old master device dirty + $hash->{IODev}{dirty} = 1; + } + if ( defined( $defs{$aVal} ) ) { #set new master device dirty + $defs{$aVal}{dirty} = 1; + } + + Log3 $name, 4, "S7_DRead: IODev for $name is $aVal"; + } + + } + return undef; +} + +##################################### +1; + +=pod +=begin html + + +

S7_DRead

+
    + This module is a logical module of the physical module S7.
    + This module provides digital data (ON/OFF).
    + Note: you have to configure a PLC reading at the physical modul (S7) first.
    +
    +
    + Define + +
      +
    • define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> + +
        +
      • inputs|outputs|flags|db … defines where to read.
      • +
      • DB … Number of the DB
      • +
      • address … address you want to read. bit number to read. Example: 10.3
      • +
      + Note: the required memory area need to be with in the configured PLC reading of the physical module.
    • +
    +
+ +=end html + +=begin html_DE + + +

S7_DRead

+
    + This module is a logical module of the physical module S7.
    + This module provides digital data (ON/OFF).
    + Note: you have to configure a PLC reading at the physical modul (S7) first.
    +
    +
    + Define + +
      +
    • define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> + +
        +
      • inputs|outputs|flags|db … defines where to read.
      • +
      • DB … Number of the DB
      • +
      • address … address you want to read. bit number to read. Example: 10.3
      • +
      + Note: the required memory area need to be with in the configured PLC reading of the physical module.
    • +
    +
+ +=end html_DE + +=cut + diff --git a/fhem/FHEM/44_S7_DWrite.pm b/fhem/FHEM/44_S7_DWrite.pm new file mode 100644 index 000000000..fa1ba7f15 --- /dev/null +++ b/fhem/FHEM/44_S7_DWrite.pm @@ -0,0 +1,546 @@ +# $Id$ +############################################## +package main; + +use strict; +use warnings; + +#use Switch; + +my %sets = ( + "on" => "", + "off" => "", + "toggle" => "" +); + +my %gets = ( + "reading" => "", + "STATE" => "" +); + +##################################### +sub S7_DWrite_Initialize($) { + my $hash = shift @_; + + # Provider + + # Consumer + $hash->{Match} = "^DW"; + + $hash->{DefFn} = "S7_DWrite_Define"; + $hash->{UndefFn} = "S7_DWrite_Undef"; + $hash->{SetFn} = "S7_DWrite_Set"; + + $hash->{ParseFn} = "S7_DWrite_Parse"; + + $hash->{AttrFn} = "S7_DWrite_Attr"; + $hash->{AttrList} = "IODev trigger_length " . $readingFnAttributes; + + main::LoadModule("S7"); +} + +##################################### +sub S7_DWrite_Undef($$) { + my ( $hash, $name ) = @_; + RemoveInternalTimer($hash); + Log3 $name, 4, + "S7_DWrite (" + . $hash->{IODev}{NAME} + . "): undef " + . $hash->{NAME} + . " Adress:" + . $hash->{ADDRESS}; + + delete( $modules{S7_DWrite}{defptr} ); + + return undef; +} + +##################################### +sub S7_DWrite_Define($$) { + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $area, $DB, $position ); + my $byte; + my $bit; + + $name = $a[0]; + Log3 $name, 5, "S7_DWrite_Define called"; + + AssignIoPort($hash); # logisches modul an physikalisches binden !!! + + my $sname = $hash->{IODev}{NAME}; + + if ( uc $a[2] =~ m/^[QIMN](\d*)/ ) { + $area = "db"; + $DB = 0; + my $startposition; + my $Offset; + + if ( uc $a[2] =~ m/^Q(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 942; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1064; + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + } + elsif ( uc $a[2] =~ m/^I(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 923; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1024; + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^NI(\d*)/ ) { + $startposition = 2; + if ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1246; + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^NQ(\d*)/ ) { + $startposition = 2; + if ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1390; + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + elsif ( uc $a[2] =~ m/^M(\d*)/ ) { + $startposition = 1; + if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + $Offset = 948; + } + elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + $Offset = 1104; + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + } + else { + my $msg = +"wrong syntax : define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M|NI|NQ}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + $position = + ( $Offset * 8 ) + int( substr( $a[2], $startposition ) ) - 1; + $byte = int( $position / 8 ); + $bit = ( $position % 8 ); + + } + else { + $area = lc $a[2]; + $DB = $a[3]; + $position = $a[4]; + + if ( $area ne "inputs" + && $area ne "outputs" + && $area ne "flags" + && $area ne "db" ) + { + my $msg = +"wrong syntax: define S7_DWrite {inputs|outputs|flags|db}
\n Only for Logo7 or Logo8:\n define S7_DWrite {I|Q|M}1..24"; + + Log3 undef, 2, $msg; + return $msg; + } + + my @address = split( /\./, $position ); + if ( int(@address) == 2 ) { + $byte = $address[0]; + $bit = $address[1]; + } + else { + + $byte = int( $address[0] / 8 ); + $bit = ( $address[0] % 8 ); + } + $position = ( $byte * 8 ) + $bit; + } + + $hash->{ADDRESS} = "$byte.$bit"; + + $hash->{AREA} = $area; + $hash->{DB} = $DB; + $hash->{LENGTH} = 1; + $hash->{POSITION} = $position; + + my $ID = "$area $DB"; + + if ( !defined( $modules{S7_DWrite}{defptr}{$ID} ) ) { + my @b = (); + push( @b, $hash ); + $modules{S7_DWrite}{defptr}{$ID} = \@b; + + } + else { + push( @{ $modules{S7_DWrite}{defptr}{$ID} }, $hash ); + } + + $hash->{IODev}{dirty} = 1; + return undef; +} + +##################################### + +sub S7_DWrite_setABit($$) { + my ( $hash, $newValue ) = @_; + + my $name = $hash->{NAME}; + $newValue = lc $newValue; + Log3 $name, 4, "S7_DWrite_setABit $newValue"; + + if ( $newValue ne "on" && $newValue ne "off" && $newValue ne "trigger" ) { + return "Unknown argument $newValue, choose one of ON OFF TRIGGER"; + } + + my $sname = $hash->{IODev}{NAME}; + my $position = $hash->{POSITION}; + my $area = $hash->{AREA}; + my $dbNR = $hash->{DB}; + my $shash = $defs{$sname}; + + my $writeAreaIndex = S7_getAreaIndex4AreaName($area); + return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) ); + + my $b = 0; + + if ( $newValue eq "on" || $newValue eq "trigger" ) { + $b = 1; + } + + my $res = S7_WriteBitToPLC( $shash, $writeAreaIndex, $dbNR, $position, $b ); + + if ( $res == 0 ) { + main::readingsSingleUpdate( $hash, "state", $newValue, 1 ); + } + else { + main::readingsSingleUpdate( $hash, "state", "", 1 ); + } + + if ( $newValue eq "trigger" ) { + + my $triggerLength = 1; + if ( defined( $main::attr{$name}{trigger_length} ) ) { + $triggerLength = $main::attr{$name}{trigger_length}; + } + + InternalTimer( gettimeofday() + $triggerLength, + "S7_DWrite_SwitchOff", $hash, 1 ); + } + + return undef; + +} + +##################################### + +sub S7_DWrite_Set(@) { + my ( $hash, @a ) = @_; + + return "Need at least one parameter" if ( int(@a) < 2 ); + return S7_DWrite_setABit( $hash, $a[1] ); + +} + +##################################### + +sub S7_DWrite_SwitchOff($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + Log3 $name, 4, "S7_DWrite: GetUpdate called ..."; + + return S7_DWrite_setABit( $hash, "off" ); + +} + +##################################### + +sub S7_DWrite_Parse($$) { + my ( $hash, $rmsg ) = @_; + my $name; + + if ( defined( $hash->{NAME} ) ) { + $name = $hash->{NAME}; + } + else { + $name = "dummy"; + Log3 undef, 2, "S7_DWrite_Parse: Error ..."; + return undef; + } + + my @a = split( "[ \t][ \t]*", $rmsg ); + my @list; + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, + $clientNames ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + $clientNames = $a[7]; + + my $ID = "$area $DB"; + + Log3 $name, 6, "$name S7_DWrite_Parse $rmsg"; + my @clientList = split( ",", $clientNames ); + + if ( int(@clientList) > 0 ) { + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); +# my $b = pack( "C" x $length, @Writebuffer ); + foreach my $clientName (@clientList) { + + my $h = $defs{$clientName}; + + # if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + # && $main::attr{ $h->{NAME} }{IODev} eq $name ) + # { + + if ( $h->{TYPE} eq "S7_DWrite" + && $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + push( @list, $clientName ) + ; #damit die werte im client gesetzt werden! + + #aktualisierung des wertes + my $s = int( $h->{POSITION} / 8 ) - $start; + + my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + + Log3 $name, 5, "$name S7_DWrite_Parse update $clientName "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) { + + main::readingsSingleUpdate( $h, "state", "on", 1 ); + + } + else { + main::readingsSingleUpdate( $h, "state", "off", 1 ); + + } + } + + # } + } + } + else { + Log3 $name, 3, "$name S7_DWrite_Parse going the save way "; + + if ( defined( $modules{S7_DWrite}{defptr}{$ID} ) ) { + + foreach my $h ( @{ $modules{S7_DWrite}{defptr}{$ID} } ) { + if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + && $main::attr{ $h->{NAME} }{IODev} eq $name ) + { + if ( $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + + my $n = + $h->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + my $s = int( $h->{POSITION} / 8 ) - $start; +# my $b = pack( "C" x $length, @Writebuffer ); + + my $myI = $hash->{S7TCPClient}->ByteAt(\@Writebuffer, $s ); + + Log3 $name, 6, "$name S7_DWrite_Parse update $n "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > + 0 ) + { + + main::readingsSingleUpdate( $h, "state", "on", 1 ); + + } + else { + + main::readingsSingleUpdate( $h, "state", "off", 1 ); + + } + } + } + + } + } + } + + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_DWrite: Parse no client found ($name) ..."; + push( @list, "" ); + } + + return @list; + +} +##################################### + +sub S7_DWrite_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + my $hash = $defs{$name}; + if ( $cmd eq "set" ) { + if ( $aName eq "trigger_length" ) { + if ( $aVal ne int($aVal) ) { + Log3 $name, 3, +"S7_DWrite: Invalid $aName in attr $name $aName ($aVal is not a number): $@"; + return "Invalid $aName : $aVal is not a number"; + } + + } + elsif ( $aName eq "IODev" ) { + Log3 $name, 4, "S7_DWrite: IODev for $name is $aVal"; + $hash->{IODev}{dirty} = 1; + } + + } + return undef; +} + +1; + +=pod +=begin html + + +

S7_DWrite

+
    + This module is a logical module of the physical module S7.
    + This module is used to set/unset a Bit in ad DB of the PLC.
    + Note: you have to configure a PLC writing at the physical modul (S7) first.
    +
    + Define + +
      +
    • define <name> S7_DWrite {db} <DB> <address> + +
        +
      • db … defines where to read. Note currently only writing in to DB are supported.
      • +
      • DB … Number of the DB
      • +
      • address … address you want to write. bit number to read. Example: 10.6
      • +
      + Note: the required memory area need to be with in the configured PLC reading of the physical module. Set + +
        +
      • set <name> S7_AWrite {ON|OFF|TRIGGER};
      • +
        +   +
      •  
      • +
      •  
      • +
      + Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
    • +
    + +

    Attr
    + The following parameters are used to scale every reading

    + +
      +
    • +
        +
      • trigger_length ... sets the on-time of a trigger
      • +
      +
    • +
    +
+ +=end html + +=begin html_DE + + +

S7_DWrite

+
    + This module is a logical module of the physical module S7.
    + This module is used to set/unset a Bit in ad DB of the PLC.
    + Note: you have to configure a PLC writing at the physical modul (S7) first.
    +
    +
    + Define + +
      +
    • define <name> S7_DWrite {db} <DB> <position> + +
        +
      • db … defines where to read. Note currently only writing in to DB are supported.
      • +
      • DB … Number of the DB
      • +
      • address … address you want to write. bit number to read. Example: 10.6
      • +
      + Note: the required memory area need to be with in the configured PLC reading of the physical module.
    • +
      +
      +
      +   +
    •  
    • +
    + Set + +
      +
    • set <name> S7_AWrite {ON|OFF|TRIGGER};
      + Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
    • +
    + +

    Attr
    + The following parameters are used to scale every reading

    + +

     

    + +
      +
    • trigger_length ... sets the on-time of a trigger
    • +
    +
+ +=end html_DE + +=cut +