1
0
mirror of https://github.com/netdata-be/libnodave synced 2025-10-13 00:42:50 +08:00
libnodave/pascal/testISO_TCP.pas
2012-06-01 10:15:12 +02:00

424 lines
13 KiB
ObjectPascal
Executable File

(*
Test and demo program for Libnodave, a free communication libray for Siemens S7.
**********************************************************************
* WARNING: This and other test programs overwrite data in your PLC. *
* DO NOT use it on PLC's when anything is connected to their outputs.*
* This is alpha software. Use entirely on your own risk. *
**********************************************************************
(C) Thomas Hergenhahn (thomas.hergenhahn@web.de) 2002, 2003.
This is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
This is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Libnodave; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*)
uses nodave,tests
{$ifdef WIN32}
, windows
{$endif}
{$ifdef LINUX}
{$ifndef OLDFPC} (* I'm not shure when they changed that *)
,oldlinux
{$else}
,linux
{$endif}
{$define UNIX_STYLE}
{$endif}
;
{$ifdef CYGWIN}
{$define UNIX_STYLE}
{$endif}
procedure usage;
begin
writeln('Usage: testiso_tcp [-d] [-w] <IP address of CP>.');
writeln('-w will try to write to Flag words. It will overwrite FB0 to FB15 (MB0 to MB15) !');
writeln('-d will produce a lot of debug messages.');
writeln('-b will run benchmarks. Specify -b and -w to run write benchmarks.');
writeln('-m will run a test for multiple variable reads.');
writeln('-c will write 0 to the PLC memory used in write tests.');
writeln('-2 uses the protocol for CP243. You need to specify this, if you have such a CP.');
writeln('-s will put the CPU in STOP mode.');
writeln('-r will put the CPU in RUN mode.');
writeln('Example: testiso_tcp -w <IP address of CP>');
end;
procedure wait;
begin
writeln('Press return to continue.');
readln;
end;
//extern
var seconds,thirds:longint;
var i, a,b,c,adrPos, doWrite, doBenchmark, doMultiple, doClear, doNewfunctions,
doStop, doRun, res, saveDebug, proto: longint;
d: single;
di:pdaveInterface;
dc:pdaveConnection;
rs:daveResultSet;
fds: _daveOSserialType;
{$ifdef UNIX_STYLE}
t1,t2:timeval;
{$endif}
{$ifdef WIN32}
t1, t2:longint;
{$endif}
usec:double;
p:PDU;
pms:string;
COMname: array[0..20] of char;
begin
USEC:=0;
adrPos:=1;
doWrite:=0;
doBenchmark:=0;
doMultiple:=0;
doClear:=0;
doNewfunctions:=0;
doRun:=0;
doStop:=0;
proto:=daveProtoISOTCP;
if (paramcount<1) then begin
usage;
halt(1);
end;
writeln('1st parameter '+paramstr(1));
while (paramstr(adrPos)[1]='-') do begin
if paramstr(adrPos)='-d' then begin
(* daveDebug:=daveDebugAll; *)
daveSetDebug(daveDebugAll);
writeln('turning debug on');
end
else if paramstr(adrPos)='-w' then begin
doWrite:=1;
end
else if paramstr(adrPos)='-2' then begin
proto:=daveProtoISOTCP243;
end
else if paramstr(adrPos)='-b' then begin
doBenchmark:=1;
end
else if paramstr(adrPos)='-m' then begin
doMultiple:=1;
end
else if paramstr(adrPos)='-c' then begin
doClear:=1;
end
else if paramstr(adrPos)='-n' then begin
doNewfunctions:=1;
end else if paramstr(adrPos)='-r' then begin
doRun:=1;
end
else if paramstr(adrPos)='-s' then begin
doStop:=1;
end;
;
adrPos:=adrPos+1;
if (paramcount<adrPos) then begin
usage;
halt(1);
end;
end;
writeln('fds',sizeof(fds));
pms:=paramstr(adrPos);
move(pms[1], COMname,length(paramstr(adrPos)));
COMname[length(paramstr(adrPos))+1]:=#0;
fds.rfd:=openSocket(102,COMname);
fds.wfd:=fds.rfd;
writeln('fds.rfd ',longint(fds.rfd));
writeln('fds.wfd ',longint(fds.wfd));
if (fds.rfd>0) then begin
di :=daveNewInterface(fds, 'IF1',0,daveProtoISOTCP, daveSpeed187k);
di^.timeout:=5000000;
(*
While initAdapter() is not necessary, it does no harm to call it. When the Interface is set
to work with ISO_TCP, it results in a call to a dummy function that returns allways 0.
This leads to a uniform structure.
*)
if (daveInitAdapter(di)=0) then begin
dc :=daveNewConnection(di,2,0,2); // insert your PPI address here
if (daveConnectPLC(dc)=0) then begin
(*
// just try out what else might be readable in an S7-200 (on your own risk!):
*)
writeln('Trying to read 64 bytes (32 words) from data block 1. This is V memory of the 200.');
wait;
res:=daveReadBytes(dc,daveDB,1,0,64,nil);
if (res=0) then begin
a:=daveGetU16(dc);
writeln('VW0: ',a);
a:=daveGetU16(dc);
writeln('VW2: ',a);
end;
(* a:=daveGetU16at(dc,62);
writeln('DB1:DW32: %d',a);
*)
writeln('Trying to read 16 bytes from FW0.');
wait;
(*
* Some comments about daveReadBytes():
*
* The 200 family PLCs have the V area. This is accessed like a datablock with number 1.
* This is not a quirk or convention introduced by libnodave, but the command transmitted
* to the PLC is exactly the same that would read from DB1 of a 300 or 400.
*
* to read VD68 and VD72 use:
* daveReadBytes(dc, daveDB, 1, 68, 6, nil);
* to read VD68 and VD72 into your applications buffer appBuffer use:
* daveReadBytes(dc, daveDB, 1, 68, 6, appBuffer);
* to read VD68 and VD78 into your applications buffer appBuffer use:
* daveReadBytes(dc, daveDB, 1, 68, 14, appBuffer);
* this reads DBD68 and DBD78 and everything in between and fills the range
* appBuffer+4 to appBuffer+9 with unwanted bytes, but is much faster than:
* daveReadBytes(dc, daveDB, 1, 68, 4, appBuffer);
* daveReadBytes(dc, daveDB, 1, 78, 4, appBuffer+4);
*)
res:=daveReadBytes(dc,daveFlags,0,0,16,nil);
if (res=0) then begin
(*
* daveGetU32(dc); reads a word (2 bytes) from the current buffer position and increments
* an internal pointer by 2, so next daveGetXXX() wil read from the new position behind that
* word.
*)
a:=daveGetU32(dc);
b:=daveGetU32(dc);
c:=daveGetU32(dc);
d:=daveGetFloat(dc);
writeln('FD0: ',a);
writeln('FD4: ',b);
writeln('FD8: ',c);
writeln('FD12:',d);
(*
d:=daveGetFloatAt(dc,12);
writeln('FD12:',d);
*)
end;
if(doNewfunctions<>0) then begin
(*
// saveDebug:=daveDebug;
// daveDebug:=daveDebugAll;
*)
res:=daveReadBits(dc, daveInputs, 0, 2, 1,nil);
writeln('function result:%d:=%s', res, daveStrerror(res));
// daveDebug:=0;
res:=daveReadBits(dc, daveDB, 1, 1, 2,nil);
writeln('function result:%d:=%s', res, daveStrerror(res));
res:=daveReadBits(dc, daveDB, 1, 1, 0,nil);
writeln('function result:%d:=%s', res, daveStrerror(res));
res:=daveReadBits(dc, daveDB, 1, 1, 1,nil);
writeln('function result:%d:=%s', res, daveStrerror(res));
a:=0;
res:=daveWriteBytes(dc, daveOutputs, 0, 0, 1, @a);
// daveDebug:=daveDebugAll;
a:=1;
res:=daveWriteBits(dc, daveOutputs, 0, 5, 1, @a);
writeln('function result:', res,' = ', daveStrerror(res));
res:=daveReadBytes(dc, daveAnaOut, 0, 0, 1,nil);
writeln('function result:%d:=%s', res, daveStrerror(res));
a:=2341;
res:=daveWriteBytes(dc, daveAnaOut, 0, 0, 2,@a);
writeln('function result:%d:=%s', res, daveStrerror(res));
// daveDebug:=saveDebug;
end;
if doRun<>0 then begin
daveStart(dc);
end;
if doStop<>0 then begin
daveStop(dc);
end;
if(doMultiple<>0) then begin
writeln('Now testing read multiple variables.''This will read 1 Byte from inputs,''4 bytes from flags, 2 bytes from DB6'' and other 2 bytes from flags');
wait;
davePrepareReadRequest(dc, @p);
daveAddVarToReadRequest(@p,daveInputs,0,0,1);
daveAddVarToReadRequest(@p,daveFlags,0,0,4);
daveAddVarToReadRequest(@p,daveDB,6,20,2);
daveAddVarToReadRequest(@p,daveSysInfo,0,0,24);
daveAddVarToReadRequest(@p,daveFlags,0,12,2);
daveAddVarToReadRequest(@p,daveAnaIn,0,0,2);
daveAddVarToReadRequest(@p,daveAnaOut,0,0,2);
res:=daveExecReadRequest(dc, @p, @rs);
write('Input Byte 0: ');
res:=daveUseResult(dc, @rs, 0); // first result
if (res=0) then begin
a:=daveGetU8(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
write('Flag DWord 0: ');
res:=daveUseResult(dc, @rs, 1); // 2nd result
if (res=0) then begin
a:=daveGetS16(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
write('DB 6 Word 20 (not present in 200): ');
res:=daveUseResult(dc, @rs, 2); // 3rd result
if (res=0) then begin
a:=daveGetS16(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
write('System Information: ');
res:=daveUseResult(dc, @rs, 3); // 4th result
if (res=0) then begin
for i:=0 to 39 do begin
a:=daveGetU8(dc);
write(char(a));
end;
writeln('');
end else
writeln('*** Error: ',daveStrerror(res));
write('Flag Word 12: ');
res:=daveUseResult(dc, @rs, 4); // 5th result
if (res=0)then begin
a:=daveGetU16(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
write('non existing result (we try to use 1 more than the number of items): ');
res:=daveUseResult(dc, @rs, 4); // 5th result
if (res=0)then begin
a:=daveGetU16(dc);
writeln(a);
end else
writeln('*** Error: %s',daveStrerror(res));
write('Analog Input Word 0:');
res:=daveUseResult(dc, @rs, 5); // 6th result
if (res=0)then begin
a:=daveGetU16(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
write('Analog Output Word 0:');
res:=daveUseResult(dc, @rs, 6); // 7th result
if (res=0)then begin
a:=daveGetU16(dc);
writeln(a);
end else
writeln('*** Error: ',daveStrerror(res));
daveFreeResults(@rs);
(*
for (i:=0; i<rs.numResults;i++) begin
r2:=@(rs.results[i]);
writeln('result: %s length:%d',daveStrerror(r2->error), r2->length);
res:=daveUseResult(dc, @rs, i);
if (r2->length>0) _daveDump('bytes',r2->bytes,r2->length);
if (r2->bytes!:=nil) begin
_daveDump('bytes',r2->bytes,r2->length);
d:=daveGetFloat(dc);
writeln('FD12: %f',d);
end
end
*)
end;
if(doWrite>0) then begin
writeln('Now we write back these data after incrementing the first to by 1,2 and 3 and the first two floats by 1.1.');
wait;
(*
Attention! you need to daveSwapIed little endian variables before using them as a buffer for
daveWriteBytes() or before copying them into a buffer for daveWriteBytes()!
*)
a:=daveSwapIed_32(a+1);
daveWriteBytes(dc,daveFlags,0,0,4,@a);
b:=daveSwapIed_32(b+2);
daveWriteBytes(dc,daveFlags,0,4,4,@b);
c:=daveSwapIed_32(c+3);
daveWriteBytes(dc,daveFlags,0,8,4,@c);
d:=toPLCfloat(d+1.1);
daveWriteBytes(dc,daveFlags,0,12,4,@d);
daveReadBytes(dc,daveFlags,0,0,16,nil);
a:=daveGetU32(dc);
b:=daveGetU32(dc);
c:=daveGetU32(dc);
d:=daveGetFloat(dc);
writeln('FD0: ',a);
writeln('FD4: ',b);
writeln('FD8: ',c);
writeln('FD12:',d);
end; {doWrite}
if(doClear>0) then begin
writeln('Now writing 0 to the bytes FB0...FB15.');
wait();
a:=0;
daveWriteBytes(dc,daveFlags,0,0,4,@a);
daveWriteBytes(dc,daveFlags,0,4,4,@a);
daveWriteBytes(dc,daveFlags,0,8,4,@a);
daveWriteBytes(dc,daveFlags,0,12,4,@a);
daveReadBytes(dc,daveFlags,0,0,16,nil);
a:=daveGetU32(dc);
b:=daveGetU32(dc);
c:=daveGetU32(dc);
d:=daveGetFloat(dc);
writeln('FD0: %d',a);
writeln('FD4: %d',b);
writeln('FD8: %d',c);
writeln('FD12: %f',d);
end; { doClear}
if(doBenchmark>0) then begin
readBench(dc);
if(doWrite>0)then begin
writeBench(dc);
end; {// doWrite}
end; { // doBenchmark}
daveDisconnectPLC(dc);
daveDisconnectAdapter(di);
halt(0);
end;
end;
end else begin
writeln('Couldn''t establish connection to ',paramstr(adrPos));
halt(2);
end;
end.
(*
Changes:
07/19/04 added return values in main().
09/09/04 applied patch for variable Profibus speed from Andrew Rostovtsew.
09/09/04 removed unused include byteswap.h
09/10/04 removed SZL read, it doesn?t work on 200 family.
09/11/04 added multiple variable read example code.
01/01/05 fixed program name in usage.
01/01/13 fixed timeout, rack and slot number so it will work with standard settings.
*)