» Delphi: tcp клиент в потоке

Всем привет.

уже неделю мучаю простейшую задачу, но не выходит каменный цветочек.. направьте на путь истинный...

задача: иметь класс, которому можно было бы отдать набор байт, но бы их отпрпавил по tcp, получил ответ и вернул его отправителю.

таких классов-tcp клиентов одновременно может работать много, поэтому решил реализовать этот класс наследником от потока с использование TIdTCPClient...
вроде бы даже работает, НО, совершеннно не ясно как сделать метод, вида:
client.Send(out: string; var response: string);

т.е. чтобы из вне вызвав этот меток вызывающий дождался ответа?

если быть точным, этот класс должен быть modbus-tcp клиентов, чтобы опрашивать железяки...

вот как то так...

Пусть он имеет признак того, что готов отдать ответ. Тогда в цикле нужно периодически опрашивать эти признаки потоков и если этот флаг выставлен - то читать соответственный response. Часто практикуют создание потока для выполнения какой-то функции и после этого он сразу уничтожается. Тогда, чтобы определить момент завершения тоже в цикле проверяют флаг типа IsAlive, Active и т. д. (для разных классов-оберток потоков).
Но это общие рассуждения. Я думаю, что не понял вопроса. Если тому потоку, в котором идет строчка вызова client.Send() нужно ждать завершения метода - то зачем в client начинается новый поток? Метод может пройти в потоке, который его вызывает.

правильно поняли..
сейчас сделал так:

в execute потока сделал так

Код: while not Terminated do
begin
if (fState in [skNone, skIdle]) and (fSendCmd <> '') and (not fBusy) then
begin
packageToSend := fSendCmd;
fSendCmd := '';
fBusy := true;
Inc(fTCPSecID);

// выставляем уникальный номер запроса
packageToSend[1] := AnsiChar(HiByte(fTCPSecID));
packageToSend[2] := AnsiChar(LoByte(fTCPSecID));

fRecieveAns := '';
fReadTCPPackage := 0;

fTCPClient.Write(packageToSend);

SetState(skWaitingAnswer);
fBusy := false;
sleep(50);
Continue;
end;
if fState = skWaitingAnswer then
begin
if fReadTCPPackage = 0 then
begin
S := fTCPClient.ReadString(6);
fRecieveAns := S;
fReadTCPPackage := (Ord(fRecieveAns[5]) shl 8 or Ord(fRecieveAns[6]));
end
else
begin
S := fTCPClient.ReadString(fReadTCPPackage);
fRecieveAns := fRecieveAns + S;

//tcp_bytes := (Ord(fRecieveAns[5]) shl 8 or Ord(fRecieveAns[6]));
tcp_full := Length(fRecieveAns) = (fReadTCPPackage + 6);
if tcp_full then
begin
// смотрим чтобы уникальный номер запроса и протокол совпали в запросе и ответе
if (copy(fRecieveAns, 1, 4) = copy(packageToSend, 1, 4)) and
(copy(fRecieveAns, 7, 2) = copy(packageToSend, 7, 2)) then
begin
fRecieveAns := copy(fRecieveAns, 7, tcp_bytes); // всё отлично!
tcp_ok:=true;
end
else
begin
fRecieveAns := 'Recieved response doesn''t match request!!!';
SetState(skError);
sendError := true;
//continue;
end;
end; // tcp_full

if not tcp_full then
begin
fRecieveAns := 'Package recieved not fully!';
SetState(skError);
sendError := true;
//continue;
end;

if tcp_ok then
begin
fBusy := false;
SetState(skSuccess);
break
end;
end; // len = 6
end;

Sleep(10);
end;
end;

Код:
SetState(Value: TStateKind);
begin
fState := Value;

if (fState in [skDisconnected, skSuccess, skError]) and (not fBusy) then
begin
Suspend;
SetEvent(fDoneEventHandle); // эта строчка не выполнится в первом такте (первой посылке)
end;

вообщем победил! )

Код: unit ModbusTCP;

interface
uses
SysUtils,
Dialogs,
Windows,
Winsock, Classes;

type
TBufer = array[0..32768] of byte;
TModbusBuf = array[0..255] of byte;

TModbusTcpGate = class
private
fAnswerBuff: TModbusBuf;
FBufer: TBufer;
fbytesToReceive: Integer;
fbytesToSend: Integer;
fCS: TRTLCriticalSection;
fSockAddr: TSockAddr;
fSockConnected: Boolean;
fSocket: TSocket;
initialized: boolean;
iPort: integer;
sIP: string;
vWSAData: TWSAData;
public
constructor Create(ip: string; port: integer = 502);
destructor Destroy; override;
strict private
function Communicate: Boolean;
private
procedure DeInitLib;
function InitLib: boolean;
procedure Lock;
function SockConnect: Boolean;
procedure SockDisconnect;
procedure Unlock;
public
function ReadDiscreteInputs(StartingAddress, NumberOfInputs: Integer): Boolean;
function ReadMultiplyCoils(StartingAddress, NumberOfCoils: Integer): Boolean;
function ReadMultiplyRegisters(StartingAddress, NumberOfRegisters: Integer):
Boolean;
function WriteSingleCoil(Coil: Integer; NewValue: Boolean = true): Boolean;
function WriteSingleRegister(RegisterNumber, NewValue: Integer): Boolean;
property Buffer: TModbusBuf read fAnswerBuff write fAnswerBuff;
end;

var
ModbusGateway: TModbusTcpGate = nil;

implementation

{ TModbusTcpGate }

constructor TModbusTcpGate.Create(ip: string; port: integer);
begin
sIP := ip;
iPort := port;
initialized := InitLib;
InitializeCriticalSection(fCS);
end;

destructor TModbusTcpGate.Destroy;
begin
DeInitLib;
DeleteCriticalSection(fCS);
inherited;
end;

function TModbusTcpGate.Communicate: Boolean;
var
res: Integer;
begin
Lock;
Result := false;
try
if not initialized then
if not InitLib then
Exit;
if not fSockConnected then
if not SockConnect then
Exit;
res := send(fSocket, FBufer, fbytesToSend, 0);
if res = SOCKET_ERROR then
begin
SockDisconnect;
//EPrint('Ошибка отправки сообщения');
SockConnect;
Exit;
end;
res := recv(fSocket, FBufer, fbytesToReceive, 0);
if (res > 0) and (res <> fbytesToReceive) then
begin
//EPrint('Контроллер вернул ошибку');
Exit;
end;
if res <= 0 then
begin
SockDisconnect;
//EPrint('Ошибка получения ответа');
SockConnect;
Exit;
end;
Result := true;
Unlock;
except on E: Exception do
begin
//EPrint(E.Message);
Unlock;
end;
end;
end;

procedure TModbusTcpGate.DeInitLib;
begin
SockDisconnect;
if initialized then
WSACleanup;
initialized := false;
end;

function TModbusTcpGate.InitLib: boolean;
begin
Result := true;
if WSAStartup($202, vWSAData) <> 0 then
begin
//EPrint('ModbusTCPDrv. Ошибка инициализации сокетов');
Result := false;
end;
end;

procedure TModbusTcpGate.Lock;
begin
EnterCriticalSection(fCS);
end;

function TModbusTcpGate.ReadDiscreteInputs(StartingAddress, NumberOfInputs:
Integer): Boolean;
var
i: Integer;
begin
FBufer[0] := 0; //2 байта - идентификатор передачи (любые)
FBufer[1] := 0; //сервер скопирует в ответ
FBufer[2] := 0; //2 байта - идентификатор протокола(всегда 0)
FBufer[3] := 0;
FBufer[4] := 0; //2 байта - количество последующих байт
FBufer[5] := 6;
FBufer[6] := 1; //1 байт - идентификатор узла
FBufer[7] := 2; //1 байт - идентификатор команды
FBufer[8] := Hi(StartingAddress); //2 байта - начальный адрес чтения
FBufer[9] := Lo(StartingAddress);
FBufer[10] := Hi(NumberOfInputs); //2 байта - количество элементов для чтения
FBufer[11] := Lo(NumberOfInputs);
fbytesToReceive := 9 + (NumberOfInputs) div 8;
if NumberOfInputs mod 8 <> 0 then
fbytesToReceive := fbytesToReceive + 1;
fbytesToSend := 12;
Result := Communicate;
if Result then
for i := 0 to NumberOfInputs - 1 do
begin
fAnswerBuff[i] := 1 and (FBufer[9 + i div 8] shr (i mod 8));
end;
end;

function TModbusTcpGate.ReadMultiplyCoils(StartingAddress, NumberOfCoils: Integer): Boolean;
var
i: Integer;
begin
FBufer[0] := 0; //2 байта - идентификатор передачи (любые)
FBufer[1] := 0; //сервер скопирует в ответ
FBufer[2] := 0; //2 байта - идентификатор протокола(всегда 0)
FBufer[3] := 0;
FBufer[4] := 0; //2 байта - количество последующих байт
FBufer[5] := 6;
FBufer[6] := 1; //1 байт - идентификатор узла
FBufer[7] := 1; //1 байт - идентификатор команды
FBufer[8] := Hi(StartingAddress); //2 байта - начальный адрес чтения
FBufer[9] := Lo(StartingAddress);
FBufer[10] := Hi(NumberOfCoils); //2 байта - количество элементов для чтения
FBufer[11] := Lo(NumberOfCoils);
fbytesToReceive := 9 + (NumberOfCoils) div 8;
if NumberOfCoils mod 8 <> 0 then
fbytesToReceive := fbytesToReceive + 1;
fbytesToSend := 12;
Result := Communicate;
if Result then
for i := 0 to NumberOfCoils - 1 do
begin
fAnswerBuff[i] := 1 and (FBufer[9 + i div 8] shr (i mod 8));
end;
end;

function TModbusTcpGate.ReadMultiplyRegisters(StartingAddress,
NumberOfRegisters: Integer): Boolean;
var
i: Integer;
begin
FBufer[0] := 0; //2 байта - идентификатор передачи (любые)
FBufer[1] := 0; //сервер скопирует в ответ
FBufer[2] := 0; //2 байта - идентификатор протокола(всегда 0)
FBufer[3] := 0;
FBufer[4] := 0; //2 байта - количество последующих байт
FBufer[5] := 6;
FBufer[6] := 1; //1 байт - идентификатор узла
FBufer[7] := 3; //1 байт - идентификатор команды
FBufer[8] := Hi(StartingAddress); //2 байта - начальный адрес чтения
FBufer[9] := Lo(StartingAddress);
FBufer[10] := Hi(NumberOfRegisters); //2 байта - количество элементов для чтения
FBufer[11] := Lo(NumberOfRegisters);
fbytesToReceive := 9 + NumberOfRegisters * 2;
fbytesToSend := 12;
Result := Communicate;
if Result then
for i := 0 to NumberOfRegisters * 2 - 1 do
begin
fAnswerBuff[i] := FBufer[9 + i];
end;
end;

function TModbusTcpGate.SockConnect: Boolean;
var
von: Integer;
vlen: Integer;
begin
Result := false;
fSockConnected := true;
fSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
if fSocket = INVALID_SOCKET then
begin
fSockConnected := false;
//EPrint('Ошибка создания сокета');
Exit;
end;
von := 500;
vlen := SizeOf(von);
setsockopt(fSocket, SOL_SOCKET, SO_SNDTIMEO, @von, vlen);
setsockopt(fSocket, SOL_SOCKET, SO_RCVTIMEO, @von, vlen);
FillChar(fSockAddr, sizeof(TSockAddr), 0);
fSockAddr.sin_family := AF_INET;
fSockAddr.sin_port := htons(iPort);
fSockAddr.sin_addr.S_addr := inet_addr(PAnsiChar(sIP));
if connect(fSocket, fSockAddr, sizeof(TSockAddr)) = SOCKET_ERROR then
begin
fSockConnected := false;
//EPrint('Ошибка подключения');
Exit;
end;
//MPrint('Успешно подключено к сокету:' + IntToStr(iPort) + ' по адресу: ' + sIP);
Result := true;
end;

procedure TModbusTcpGate.SockDisconnect;
begin
if fSockConnected then
begin
closesocket(fSocket);
fSockConnected := false;
end;
end;

procedure TModbusTcpGate.Unlock;
begin
LeaveCriticalSection(fCS);
end;

function TModbusTcpGate.WriteSingleCoil(Coil: Integer; NewValue: Boolean = true): Boolean;
begin
FBufer[0] := 0; //2 байта - идентификатор передачи (любые)
FBufer[1] := 0; //сервер скопирует в ответ
FBufer[2] := 0; //2 байта - идентификатор протокола(всегда 0)
FBufer[3] := 0;
FBufer[4] := 0; //2 байта - количество последующих байт
FBufer[5] := 6;
FBufer[6] := 1; //1 байт - идентификатор узла
FBufer[7] := 5; //1 байт - идентификатор команды
FBufer[8] := Hi(Coil); //2 байта - адрес записи
FBufer[9] := Lo(Coil);
if NewValue then //2 байта - значение 0xFF00 - включить 0x0000 - выключить
FBufer[10] := $FF else
FBufer[10] := 0;
FBufer[11] := 0;
fbytesToReceive := 12;
fbytesToSend := 12;
Result := Communicate;
end;

function TModbusTcpGate.WriteSingleRegister(RegisterNumber, NewValue: Integer):
Boolean;
begin
FBufer[0] := 0; //2 байта - идентификатор передачи (любые)
FBufer[1] := 0; //сервер скопирует в ответ
FBufer[2] := 0; //2 байта - идентификатор протокола(всегда 0)
FBufer[3] := 0;
FBufer[4] := 0; //2 байта - количество последующих байт
FBufer[5] := 6;
FBufer[6] := 1; //1 байт - идентификатор узла
FBufer[7] := 6; //1 байт - идентификатор команды
FBufer[8] := Hi(RegisterNumber); //2 байта - адрес записи
FBufer[9] := Lo(RegisterNumber);
FBufer[10] := Hi(NewValue);
FBufer[11] := Lo(NewValue);
fbytesToReceive := 12;
fbytesToSend := 12;
Result := Communicate;
end;

end.

Rudia
спасибо за исходники, может когда нибудь пригодятся, если моя реализация в бою себя покажет плохо

А реализация modbus протокола в режиме RTU/ASCII есть примеры? Буду благодарен!