Имеются 2 приложения-службы, работающие по TCP-портам 49001 и 49002 (порты настраиваются). Используется TTCPBlockSocket из пакета Synapse.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
unit uEchoSrv;
interface
uses
Windows, Messages, SysUtils, StrUtils, Variants,Classes,
StdCtrls, blcksock, uLogging, uLoggingThread;
type
TProcessingData = function(const AData: string): string of object;
TListenerThread = class(TLoggingThread)
constructor Create(ASuspended: boolean; AIP: string; APort: Integer);
destructor Destroy;override;
private
FSocket: TTCPBlockSocket;//объект сокета
FThreadList: TList; //список дескрипторов потоков для работы с клиентами
FProcessingData: TProcessingData;
FHost: string;
FPort: Integer;
function GetIsTerminated: boolean;
protected
procedure Execute;override;
procedure ServerStatus(Sender: TObject; Reason: THookSocketReason;
const Value: String);
public
property Socket: TTCPBlockSocket read FSocket;
property Host: string read FHost write FHost;
property Port: Integer read FPort write FPort;
property IsTerminated: boolean read GetIsTerminated;
property ProcessingData: TProcessingData read FProcessingData write FProcessingData;
end;
TTCPThread = class(TLoggingThread)
private
FSocket: TTCPBlockSocket;
protected
var
FProcessingData: TProcessingData;
procedure Execute;override;
public
//ASocket - дескриптор сокета из очереди подключений.
constructor Create(ASuspended: boolean; ASocket: integer);
destructor Destroy; override;
property Socket:TTCPBlockSocket read FSocket;
end;
implementation
{ TListenerThread }
constructor TListenerThread.Create(ASuspended: boolean; AIP: string; APort: Integer);
begin
FSocket:=TTCPBlockSocket.Create;
FThreadList:=TList.Create;
FHost := AIP;
FPort := APort;
FSocket.OnStatus := ServerStatus;
inherited Create(ASuspended);
LogWriter.Suffix := '_EchoServer';
end;
destructor TListenerThread.Destroy;
var T:TTCPThread;
begin
//завершаем все работающие нити
while FThreadList.Count <> 0 do
begin
T:=TTCPThread(FThreadList.Extract(FThreadList.Last));
T.Terminate;
T.WaitFor;
T.Free;
end;
//освобождаем память
FThreadList.Free;
FSocket.Free;
inherited;
end;
function TListenerThread.GetIsTerminated: boolean;
begin
Result := Terminated;
end;
procedure TListenerThread.Execute;
var T:TTCPThread;
begin
FSocket.CreateSocket;//создаем новый сокет
//связываем сокет с локальным адресом
//выбор номера порта оставляем на усмотрение Synapse
//FSocket.Bind(FSocket.LocalName,'0');
FSocket.Bind(FHost,IntToStr(FPort));
if FSocket.LastError=0 then begin //связываение с локальным адресом прошло успешно
FSocket.Listen; //переходим в режим ожидания
repeat
if FSocket.CanRead(100) then begin//можем произвести чтение
//получаем дескриптор сокета и создаем новую нить для клиента
T:=TTCPThread.Create(false,FSocket.Accept);
//определяем обработчик события ONStatus для новой нити
T.Socket.OnStatus:=FSocket.OnStatus;
T.FProcessingData := FProcessingData;
//добавляем указатель на нить в список
FThreadList.Add(pointer(T));
end;
until Terminated;//"гуляем" по циклу до тех пор, пока пользователь не остановит
end
else
Self.LogWriter.Write('Ошибка при подключении ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
end;
procedure TListenerThread.ServerStatus(Sender: TObject; Reason: THookSocketReason;
const Value: String);
begin
case Reason of
HR_Bind: begin
Self.LogWriter.Write ('Bind: '+Value);
{lblAddress.Caption:=Server.Socket.GetLocalSinIP+':'+
IntToStr(Server.Socket.GetLocalSinPort) }
end;
HR_CanRead: Self.LogWriter.Write('Готов к чтению');
HR_CanWrite: Self.LogWriter.Write('Готов к записи');
HR_Listen: Self.LogWriter.Write('Прослушивание');
HR_Accept: Self.LogWriter.Write('Подключение с адреса '+ Socket.GetRemoteSinIP);
HR_ReadCount: Self.LogWriter.Write('Прочитано символов '+Value);
HR_WriteCount: Self.LogWriter.Write('Записано символов '+Value);
HR_Wait: Self.LogWriter.Write('Ожидание');
HR_Error: Self.LogWriter.Write('Ошибка '+ Socket.LastErrorDesc, leError);
end;
end;
constructor TTCPThread.Create(ASuspended: boolean; ASocket: integer);
begin
FSocket:=TTCPBlockSocket.Create;
FSocket.Socket:=ASocket;
FSocket.GetSins;
inherited Create(ASuspended);
LogWriter.Suffix := '_EchoServer';
end;
destructor TTCPThread.Destroy;
begin
FSocket.Free;
inherited;
end;
procedure TTCPThread.Execute;
var S, S_Out:string;
begin
//работаем пока не поступит сигнал на остановку
while not Terminated do begin
try
//есть данные ожидающие чтения
if FSocket.WaitingData <> 0 then begin
S_Out := '';
//получаем данные
s:=FSocket.RecvPacket(2000);
Self.LogWriter.SuspendedWrite('Получена строка ' + s);
//ошибок при получении данных не было
if FSocket.LastError = 0 then begin
if Assigned(FProcessingData) then begin
S_Out := FProcessingData(S);
Self.LogWriter.SuspendedWrite('Ответ сервера ' + S_Out);
FSocket.SendString(S_Out);
end;
end
else
Self.LogWriter.Write('Ошибка при получении данных ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
Self.LogWriter.WriteList;
end;
except
On E:Exception do
Self.LogWriter.Write('TTCPThread.Execute ' + e.Message);
end;
sleep(10);//"спим" 10 миллисекунд
end;
end;
end.
и клиентское приложение, общающееся с этими службами через указанные порты, в том числе регистрация этих сервисов, запуск и остановка
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
unit uEchoClnt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
blcksock, StdCtrls, uLogging;
type
TEchoClient = class (TLoger)
const
cReadTimeout = 30000;
constructor Create;
destructor destroy; override;
private
FEnabled: boolean;
FSocket: TTCPBlockSocket;
FHost: string;
FPort: Integer;
public
function Connect(AData: string = ''): string;
procedure Disconnect;
function SendString(AData: string; NeedConfirm: boolean = True; CustomTimeout: Integer = cReadTimeout): string;
property Enabled_: boolean read FEnabled write FEnabled;
property Host: string read FHost write FHost;
property Port: Integer read FPort write FPort;
end;
implementation
USES uCassTypes;
constructor TEchoClient.Create;
begin
inherited;
LogWriter.Suffix := '_EchoClient';
FSocket := TTCPBlockSocket.Create;
FSocket.RaiseExcept:=True;
Host := 'localhost';
Port := 49001;
end;
destructor TEchoClient.Destroy;
begin
FreeAndNil(FSocket);
inherited Destroy;
end;
function TEchoClient.Connect(AData: string = ''): string;
var SomeStr: string;
begin
try
FSocket.Connect(FHost, IntToStr(FPort));
Self.LogWriter.SuspendedWrite(Format('Выполнено подключение к хосту %s на порт %d', [FHost, FPort]));
if AData = '' then
Self.LogWriter.WriteList;
Result := '';
except
on E:Exception do begin
if AData <> '' then
SomeStr := ' Строка ' + AData
else
SomeStr := '';
Self.LogWriter.Write(Format('Ошибка при подключении к порту %d (%s).%s',
[FPort, E.Message, SomeStr]), leError);
Enabled_ := false;
Result := E.Message;
end;
end;
end;
procedure TEchoClient.Disconnect;
begin
Self.LogWriter.Write('Отключение от хоста');
FSocket.CloseSocket;
end;
function TEchoClient.SendString(AData: string; NeedConfirm: boolean = True; CustomTimeout: Integer = cReadTimeout): string;
//NeedConfirm - если требуется ответ, например, запрос какого-либо параметра.
var Sending: boolean;
i: integer;
begin
Sending := false;
i := 0;
while (not Sending) and (i < 3) do begin
try
if NeedConfirm then begin
Disconnect;
Connect(AData);
end;
Self.LogWriter.SuspendedWrite('Передача строки ' + AData);
FSocket.SendString(AData);
if NeedConfirm then begin
Result := FSocket.RecvPacket(CustomTimeout);
Self.LogWriter.Write('Ответ сервера ' + Result);
end
else
Self.LogWriter.Write('Ожидание ответа не предусмотрено');
Sending := true;
except
ON e:Exception do begin
Result := cSendError;
Self.LogWriter.Write(Format('Ошибка при передаче %s, порт %d, строка %s', [e.Message, FPort, AData]), leError);
sleep(100);
i := i + 1;
end;
end;
end;
if not Sending then begin
Disconnect;
Connect;
end;
end;
end.
Настройками предусмотрен также вариант работы без использования сокетов (по аналогии с командой sc), но в Windows10 для управления службами необходим запуск клиентской части от имени админа, что не устраивает безопасников.
В общем, все это вполне работает, но беда в том, что к рабочему месту подключен фискальник, приложение работает с ним через COM-порт, но TCP также задействуется для работы в качестве онлайн-кассы (порт 7778). И через несколько часов работы фискальник начинает с завидным постоянством выпадать в ошибку -1 (Нет связи) именно на тех точках, где взаимодействие со службами ведется посредством TCP. Там где без TCP - проблем нет, специально менял режимы работы на одних и тех же точках. Вывод - что-то не так в приведенном коде, но что именно?
(С сокетами работаю впервые, первоначальный код был заимствован из книги о Synapse Владислава Баженова, за что ему большое спасибо)
