Program PasModCli;
{$mode objfpc}{$H+}
uses
sysutils,
ssockets;
type TMBHeader = packed record
MsgID: word;
ProtocolIdent: word;
Len: word;
UnitIdent: byte;
end;
type TMBRequest = packed record
FunCode: byte;
StartAdr: word;
Amount: word;
end;
type TMBResponse = packed record
FunCode: byte;
StartAdr: word;
Data: array of byte;
end;
const
Server = '192.168.1.30';
// Server = '127.0.0.1';
// Port = 502;
Port = 4100;
FC1 = 1; // Read coils
FC2 = 2; // Read discrete inputs
FC3 = 3; // Read registers
FC4 = 4; // Read input registers
FC5 = 5; // Write single coil
FC6 = 6; // Write single register
FC15 = 15; // Write multiple coils
FC16 = 16; // Write multiple registers
FC69 = 69; // Shutdown command
var
i: integer;
sent: string = '';
rec: String = '';
MBHeader: TMBHeader;
MBRequest: TMBRequest;
MBMsg: array of byte;
Buffer: array of byte;
Count: longint;
s: string = '0';
looper: integer = 1;
ValueAmount: integer;
tempdata: word;
j: integer = 1;
ReqData: array of byte;
BitCount: integer = 0;
byter: byte = 0;
begin
writeln('Welcome to PasModCli (Pascal Modbus Client/Command line interface)');
with MBRequest do begin
writeln;
writeln('Enter Function Code (FC):');
writeln('FC1 = 1: Read coils');
writeln('FC2 = 2: Read discrete inputs');
writeln('FC3 = 3: Read registers');
writeln('FC4 = 4: Read input registers');
writeln('FC5 = 5: Write single coil');
writeln('FC6 = 6: Write single register');
writeln('FC15 = 15: Write multiple coils');
writeln('FC16 = 16: Write multiple registers');
writeln('FC69 = 69: Shutdown command');
readln(s);
FunCode := strtoint(s);
case FunCode of
1..6, 15..16, 69:;
else begin
writeln('Function Code not supported!');
writeln('Exiting');
FunCode := 0;
end;
end;
if (FunCode <> 0) and (FunCode <> 69) then begin
writeln;
writeln('Enter register number:');
readln(s);
StartAdr := swap(word(strtoint(s)));
writeln;
case FunCode of
1..4,69: writeln('Enter amount to read');
5..6: writeln('Enter value to write');
15..16: writeln('Enter amount to write');
end;
readln(s);
if (FunCode = 5) and (s <> '0') then begin
Amount := $00FF;
end else begin
Amount := swap(word(strtoint(s)));
end;
ValueAmount := strtoint(s);
if FunCode = 16 then begin
setlength(ReqData, ValueAmount*2 + 1);
ReqData[0] := ValueAmount*2;
repeat
writeln('Enter value number ' + inttostr(looper) + '/' + inttostr(ValueAmount));
readln(s);
tempdata := swap(word(strtoint(s)));
move(tempdata, ReqData[j], 2);
inc(j,2);
inc(looper);
until looper = ValueAmount+1;
end;
if FunCode = 15 then begin
if (ValueAmount mod 8) > 0 then begin
setlength(ReqData, round(ValueAmount/8) + 2);
ReqData[0] := round(ValueAmount/8) + 1;
end else begin
setlength(ReqData, round(ValueAmount/8) + 1);
ReqData[0] := round(ValueAmount/8);
end;
repeat
writeln('Enter value number ' + inttostr(looper) + '/' + inttostr(ValueAmount));
readln(s);
byter := strtoint(s);
ReqData[j] := ReqData[j] or (byter shl BitCount);
inc(looper);
inc(BitCount);
if (looper mod 9) = 0 then begin
inc(j);
BitCount := 0;
end;
until looper = ValueAmount+1;
end;
end;
end;
with MBHeader do begin
MsgID := swap(1);
ProtocolIdent := swap(0); //0 for ModbusTCP
Len := swap(word(1 + sizeof(MBRequest) + length(ReqData)));
UnitIdent := 255;
end;
setlength(MBMsg, sizeof(MBHeader) + sizeof(MBRequest) + length(ReqData));
move(MBHeader, MBMsg[0], sizeof(MBHeader));
move(MBRequest, MBMsg[sizeof(MBHeader)], sizeof(MBRequest));
if length(ReqData) >0 then begin
move(ReqData[0], MBMsg[sizeof(MBHeader)+sizeof(MBRequest)], length(ReqData));
end;
if MBRequest.FunCode <> 0 then begin
with TInetSocket.Create(Server, Port, StrToIntDef(ParamStr(1),0)) do begin
Write(MBMsg[0], Length(MBMsg));
SetLength(Buffer, 260);
Count := Read(Buffer[0], length(Buffer));
SetLength(Buffer, Count);
Free;
end;
for i := low(MBMsg) to high(MBMsg) do begin
sent += inttostr(MBMsg[i]) + ' ';
end;
for i := low(Buffer) to high(Buffer) do begin
rec += inttostr(Buffer[i]) + ' ';
end;
writeln;
writeln('sent: ', sent);
writeln(' rec: ', rec);
end;
end.
WIKI Timeout issues
