Dimitry Sibiryakov,
constructor TReceiverUDP.Create(const AAdrIP: ansistring; const APort: word; const ASocketBufferSize, ALogType: integer);
begin
inherited Create(True);
Priority:= tpHighest;
FreeOnTerminate:= false;
ServerAddr.sin_family := AF_INET;
ServerAddr.sin_addr.S_addr := inet_addr(PansiChar(AAdrIP));
ServerAddr.sin_port := htons(APort);
FSocketBufferSize:= ASocketBufferSize;
FLogType:= ALogType;
//{$IFDEF DEBUG}
FPacketCount:= 0;
//{$ENDIF}
end;
procedure TReceiverUDP.DestroyUDP;
begin
try
CloseSocket(FSocket);
WSACleanup;
except
on E: exception do
begin
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) +' - (!ОШИБКА) закрытие сокетов. ' + E.message);
end;
end;
end;
procedure TReceiverUDP.Execute;
begin
if InitUDP then begin
while not Terminated do
begin
ReceiverPackage;
end;
//{$IFDEF DEBUG}
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!ИНФ) : Кол-во принятых пакетов = '+inttostr(FPacketCount));
//{$ENDIF}
end;
DestroyUDP;
end;
function TReceiverUDP.InitUDP: boolean;
var
Len:Integer;
errCode: integer;
Arg: u_long;
begin
Result:= False;
try
if WSAStartup($0101, wData) = 0 then begin
FSocket := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);
if bind(FSocket, ServerAddr, SizeOf(ServerAddr)) = Socket_Error then
begin
errCode:= WSAGetLastError();
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!ОШИБКА) bind socket вернул ошибку #'+errCode.ToString);
end
else begin
Len:= SizeOf(Integer);
if SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @FSocketBufferSize, Len) = Socket_Error then
begin
errCode:= WSAGetLastError();
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!ОШИБКА) Установка буфера приема сокета #'+errCode.ToString);
end
else begin
{если вдург широковещательный канал
EnBroad:=1;
SetSockOpt(FSocket,SOL_Socket,SO_Broadcast,PChar(@EnBroad),SizeOf(Integer));}
{ перевожу сокет в неблокирующий режим }
Arg:=1;
if IOCtlSocket(FSocket, FIONBIO, Arg) = Socket_Error then
begin
errCode:= WSAGetLastError();
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!ОШИБКА) Установка неблокируемого режима работы сокета #'+errCode.ToString);
end;
//GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, vInt);
Result:= True;
end;
end;
end;
except
on E: exception do
begin
WriteMessage(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!ОШИБКА) инициализация модуля приема UDP не выполнена' + E.message);
end;
end;
end;
procedure TReceiverUDP.ReceiverPackage;
var
sizePacket: LongInt;
Buffer: array [0..DefBufferSize-1] of byte;
begin
if SERVICE_STOP = 1 then exit;
try
sizePacket:= Recv(FSocket, Buffer, DefBufferSize, 0);
if sizePacket > 0 then
begin
//{$IFDEF DEBUG}
inc(FPacketCount);
//{$ENDIF}
end;
except
on E: exception do
begin
WriteLog(FormatDateTime('yyyy_mm_dd_hh:nn:ss', now) + ' - (!Ошибка) :' + E.message);
end;
end;
end;