Вопрос # 6 546

Вопрос задал: GAZ (статус: Посетитель)
Вопрос отправлен: 26 июля 2014, 15:19
Состояние вопроса: открыт, ответов: 0.

zvygin1964 (статус: Посетитель), 26 июля 2014, 18:32 [#1]:

GAZ (статус: Посетитель), 26 июля 2014, 18:48 [#2]:

min@y™ (статус: Доктор наук), 27 июля 2014, 11:54 [#3]:

GAZ (статус: Посетитель), 27 июля 2014, 12:15 [#4]:

GAZ (статус: Посетитель), 27 июля 2014, 12:25 [#5]:

min@y™ (статус: Доктор наук), 27 июля 2014, 12:46 [#6]:

Цитата (GAZ):

Цитата (GAZ):

min@y™ (статус: Доктор наук), 27 июля 2014, 12:49 [#7]:

GAZ (статус: Посетитель), 27 июля 2014, 13:17 [#8]:

min@y™ (статус: Доктор наук), 27 июля 2014, 13:41 [#9]:

Цитата (GAZ):

Цитата (GAZ):

unit uUDPSocket;
 
{$WARN SYMBOL_DEPRECATED OFF}
 
interface
 
uses
  SysUtils, Winsock, Windows, Messages, ScktComp, Forms;
 
type
  TReceiveMessageEvent = procedure (Sender: TObject;
                    const FromIP: TInAddr;
                    const Message: string) of object;
 
  EUDPSocketException = class(Exception);
  EInvalidCheckSum = class(EUDPSocketException);
  EUDPSocketError = class(EUDPSocketException);
 
  ip_mreq = packed record
              imr_multiaddr: in_addr;  (* IP multicast address of group *)
              imr_interface: in_addr;  (* local IP address of interface *)
            end;
 
  TUDPSocket = class
               private
                 FPort: Word;
                 FOnReceiveMessage: TReceiveMessageEvent;
                 FSocket: TSocket;
                 FReceiveAddress,
                 FSendAddress: TSockAddrIn;
                 FMReq: ip_mreq;
                 FHandle: THandle;
                 procedure Initialize;
                 procedure AllocateHandle;
               protected
                 procedure DoReceiveMessage(const FromIP: TInAddr; const Message: string);
                 procedure WndProc(var Msg: TMessage); virtual;
                 procedure CMSocketMessage(var Msg: TCMSocketMessage); message CM_SOCKETMESSAGE;
               public
                 constructor Create(const APort: Word);
                 destructor Destroy; override;
 
                 class procedure Startup(var WsaData: TWSAData);
                 class procedure Shutdown(var WsaData: TWSAData);
 
                 procedure SendMessage(const Message: string);
                 procedure Listen;
                 procedure StopListen;
 
                 property Port: Word read FPort write FPort;
                 property OnReceiveMessage: TReceiveMessageEvent read FOnReceiveMessage write FOnReceiveMessage;
               end;
 
 
var
  WsaData: TWSAData;               
 
implementation
 
{ TUDPSocket }
 
procedure TUDPSocket.AllocateHandle;
begin
    if FHandle = INVALID_HANDLE_VALUE then
        FHandle := AllocateHWnd(Self.WndProc);
end;
 
procedure TUDPSocket.CMSocketMessage(var Msg: TCMSocketMessage);
var
    buf: array[0..4095] of Byte;
    FromAddress: TSockAddrIn;
    FromAddressLength: Integer;
    len: Integer;
    S: string;
begin
    if Msg.SelectError <> 0 then
        raise Exception.Create('Socket error');
    if Msg.Socket = INVALID_SOCKET then
        Exit;
    if Msg.SelectEvent = FD_READ then
    begin
        FillChar(FromAddress, SizeOf(FromAddress), 0);
        FromAddressLength := SizeOf(FromAddress);
        len := recvfrom(FSocket,
                        buf[0],
                        SizeOf(buf),
                        0,
                        FromAddress,
                        FromAddressLength);
 
        SetLength(S, len);
        Move(buf[0], S[1], len);
 
        if Length(S) > 0
          then DoReceiveMessage(FromAddress.sin_addr, S);
    end;
end;
 
constructor TUDPSocket.Create(const APort: Word);
begin
  FSocket:= INVALID_SOCKET;
  FHandle:= INVALID_HANDLE_VALUE;
  FPort:= APort;
  AllocateHandle;
  Initialize;
end;
 
destructor TUDPSocket.Destroy;
begin
  StopListen;
  DeallocateHWnd(FHandle);
  inherited;
end;
 
procedure TUDPSocket.DoReceiveMessage(const FromIP: TInAddr; const Message: string);
begin
  if Assigned(FOnReceiveMessage)
    then FOnReceiveMessage(Self, FromIP, Message);
end;
 
procedure TUDPSocket.Initialize;
var
    err: Integer;
begin
    FSocket := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
    if FSocket = INVALID_SOCKET then
        raise Exception.Create('Не могу открыть сокет.');
 
    err := setsockopt(FSocket, SOL_SOCKET, SO_REUSEADDR, '1', 1);
    if err = SOCKET_ERROR then
        raise Exception.Create('Не могу использовать адрес.');
 
    FReceiveAddress.sin_family := AF_INET;
    FReceiveAddress.sin_port := htons(FPort);
    FReceiveAddress.sin_addr.s_addr := INADDR_ANY;
    err := bind(FSocket, FReceiveAddress, SizeOf(FReceiveAddress));
    if err = SOCKET_ERROR then
        raise Exception.Create('Не могу привязать сокет.');
 
    err := setsockopt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, '7', 1);
    if err = SOCKET_ERROR then
        raise Exception.Create('Не могу установить time to live.');
 
    FillChar(FMReq, SizeOf(FMReq), 0);
    FMReq.imr_multiaddr.s_addr := inet_addr('225.0.0.1');
    FMReq.imr_interface.s_addr := INADDR_ANY;
    err := setsockopt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP, PAnsiChar(@FMReq), SizeOf(FMReq));
    if err <> 0 then
        raise Exception.Create('Не могу настроить мультикастинг.');
 
    FillChar(FSendAddress, SizeOf(FSendAddress), 0);
    FSendAddress.sin_family := AF_INET;
    FSendAddress.sin_addr.s_addr := inet_addr('225.0.0.1');
    FSendAddress.sin_port := htons(FPort);
end;
 
procedure TUDPSocket.Listen;
begin
  WSAAsyncSelect(FSocket, FHandle, CM_SOCKETMESSAGE, FD_READ);
end;
 
procedure TUDPSocket.SendMessage(const Message: string);
var
  S: string;
begin
  if Message = ''
    then raise EInvalidCheckSum.Create('Пустое сообщение.');
 
  if sendto(FSocket, S[1], Length(S), 0, FSendAddress, SizeOf(FSendAddress)) = SOCKET_ERROR
    then raise EUDPSocketError.Create('Ошибка сокета при отправке сообщения.');
end;
 
procedure TUDPSocket.StopListen;
begin
  if FSocket <> INVALID_SOCKET
    then closesocket(FSocket);
  FSocket:= INVALID_SOCKET
end;
 
procedure TUDPSocket.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = CM_SOCKETMESSAGE
    then Dispatch(Msg);
end;
 
class procedure TUDPSocket.Shutdown(var WsaData: TWSAData);
begin
  WSACleanup;
end;
 
class procedure TUDPSocket.Startup(var WsaData: TWSAData);
begin
  if WSAStartup($0101, WsaData) <> 0 then
      raise Exception.Create('Не могу инициализировать Windows Socket API.');
end;
 
initialization
    TUDPSocket.Startup(WsaData);
 
finalization
    TUDPSocket.Shutdown(WsaData);
 
end.

GAZ (статус: Посетитель), 27 июля 2014, 14:27 [#10]:

unit UDPSwich;
 
interface
 
uses
  Windows, WinSock, SysUtils, Classes, Messages{, Forms};
 
const
  WM_ASYNCSELECT = WM_USER + 100;
  READ_BUFFER_SIZE = 1024;
  MAX_LOOP = 100;
 
type
  TSocketState = (ssNotStarted, ssClosed, ssConnected, ssListening, ssOpen);
 
  TOnError = procedure(Sender: TObject; Error: integer; Msg: string) of object;
  TOnData = procedure(Sender: TObject; Socket: TSocket) of object;
  TOnAccept = procedure(Sender: TObject; Socket: TSocket) of object;
  TOnConnect = procedure(Sender: TObject; Socket: TSocket) of object;
  TOnClose = procedure(Sender: TObject; Socket: TSocket) of object;
 
  TReadBuffer = array[1..READ_BUFFER_SIZE] of byte;
 
  TUDPClientList = class(TObject)
  private
    FSockets: TList;
  protected
    function GetSockets(Index: integer): TSocket;
    function GetCount: integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Socket: TSocket): boolean;
    procedure Delete(Socket: TSocket);
    procedure Clear;
    function IndexOf(Socket: TSocket): integer;
    property Sockets[Index: integer]: TSocket read GetSockets; default;
    property Count: integer read GetCount;
  end;
 
  TCusSok = class(TComponent)
  private
    {WinSocket Information Private Fields}
    FVersion: string;
    FDescription: string;
    FSystemStatus: string;
    FMaxSockets: integer;
    FMaxUDPSize: integer;
    {End WinSocket Information Private Fields}
    FProtocol: integer;
    FType: integer;
 
    FReadBuffer: TReadBuffer;
    FLocalSocket: TSocket;
    FSocketState: TSocketState;
    FLastError: integer;
    FOnError: TOnError;
  protected
    procedure SocketError(Error: integer);
    function LastErrorDesc: string;
 
    function GetLocalHostAddress: string;
    function GetLocalHostName: string;
    {Socket Helper Functions}
    procedure SocketClose(var Socket: TSocket; Handle: HWND);
    function SocketQueueSize(Socket: TSocket): longint;
 
    procedure SocketWrite(Socket: TSocket; Flag: integer; Data: string);
    function SocketRead(Socket: TSocket; Flag: integer): string;
    function SocketWriteBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
    function SocketReadBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
 
    procedure SocketWriteTo(Socket: TSocket; Flag: integer; Data: string; var SockAddrIn: TSockAddrIn);
    function SocketReadFrom(Socket: TSocket; Flag: integer; var SockAddrIn: TSockAddrIn): string;
    function SocketWriteBufferTo(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn):
integer;
    function SocketReadBufferFrom(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn):
integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    {Address and Port Resolving Helper Functions}
    function GetSockAddrIn(Host, Port: string; var SockAddrIn: TSockAddrIn): boolean;
    function GetAnySockAddrIn(Port: string; var SockAddrIn: TSockAddrIn): boolean;
    function GetBroadcastSockAddrIn(Port: string; var SockAddrIn: TSockAddrIn): boolean;
    function SockAddrInToName(SockAddrIn: TSockAddrIn): string;
    function SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
    function SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
    function SocketToName(Socket: TSocket): string;
    function SocketToAddress(Socket: TSocket): string;
    function SocketToPort(Socket: TSocket): string;
    function PeerToName(Socket: TSocket): string;
    function PeerToAddress(Socket: TSocket): string;
    function PeerToPort(Socket: TSocket): string;
    {WinSocket Information Properties}
    property Version: string read FVersion;
    property Description: string read FDescription;
    property SystemStatus: string read FSystemStatus;
    property MaxSockets: integer read FMaxSockets;
    property MaxUDPSize: integer read FMaxUDPSize;
    {End WinSocket Information Properties}
    property LocalSocket: TSocket read FLocalSocket;
    property SocketState: TSocketState read FSocketState;
    property LastError: integer read FLastError;
    property LocalHostAddress: string read GetLocalHostAddress;
    property LocalHostName: string read GetLocalHostName;
  published
    property OnError: TOnError read FOnError write FOnError;
  end;
 
  TUDPClient = class(TCusSok)
  private
    FHandle: HWND;
 
    FHost: string;
    FPort: string;
 
    FOnData: TOnData;
  protected
    procedure WndProc(var AMsg: TMessage);
    procedure IncommingData(Socket: TSocket; Error: word);
 
    function GetPeerAddress: string;
    function GetPeerPort: string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    procedure Open;
    procedure Close;
 
    function Peek: string;
 
    procedure Write(Data: string);
    function Read: string;
 
    function WriteBuffer(Buffer: Pointer; Size: integer): integer;
    function ReadBuffer(Buffer: Pointer; Size: integer): integer;
 
    property Handle: HWND read FHandle;
 
    property PeerAddress: string read GetPeerAddress;
    property PeerPort: string read GetPeerPort;
  published
    property Host: string read FHost write FHost;
    property Port: string read FPort write FPort;
 
    property OnData: TOnData read FOnData write FOnData;
  end;
 
  TUDPServer = class(TCusSok)
  private
    FHandle: HWND;
    FPort: string;
 
    FOnData: TOnData;
  protected
    procedure WndProc(var AMsg: TMessage);
    procedure IncommingData(Socket: TSocket; Error: word);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    procedure Open;
    procedure Close;
 
    function Peek(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
 
    procedure Write(Socket: TSocket; Data: string; var SockAddrIn: TSockAddrIn);
    function Read(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
 
    function WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
    function ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
 
    property Handle: HWND read FHandle;
  published
    property Port: string read FPort write FPort;
 
    property OnData: TOnData read FOnData write FOnData;
  end;
 
  PSocketInfo = ^TSocketInfo;
  TSocketInfo = record
    Name:string;
    Addres:string;
    Port:string;
  end;
 
  TOnDataRecevied = procedure(Sender: TObject) of object;
 
 
  TUDPSwich = class(TComponent)
  private
    FUdpClient:TUDPClient;
    FUdpServer:TUDPServer;
    FOnError:TOnError;
    FOnData:TOnDataRecevied;
    FActiveServer:boolean;
    FLastSocket:TSocket;
    FLastSocketInfo:TSocketInfo;
    function GetLocalPort: integer;
    function GetRemoteHost: string;
    function GetRemotePort: integer;
    procedure SetLocalPort(const Value: integer);
    procedure SetRemoteHost(const Value: string);
    procedure SetRemotePort(const Value: integer);
    function GetUdpClient: TCusSok;
    function GetUdpServer: TCusSok;
    procedure SetActiveServer(const Value: boolean);
  protected
    procedure DataRecevie(Sender: TObject; Socket: TSocket);virtual;
    procedure UdpError(Sender: TObject; Error: integer; Msg: string);virtual;
    procedure Loaded;override;
    property UDPClient:TCusSok read GetUdpClient;
    property UDPServer:TCusSok read GetUdpServer;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    procedure Write(Data: string);
    function Read: string;
    function WriteBuffer(Buffer: Pointer; Size: integer): integer;
    function ReadBuffer(Buffer: Pointer; Size: integer): integer;
    property LastSocket:TSocket read FLastSocket;
    property LastSocketInfo:TSocketInfo read FLastSocketInfo;
  published
    property RemoteHost:string read GetRemoteHost write SetRemoteHost;
    property RemotePort:integer read GetRemotePort write SetRemotePort;
    property LocalPort:integer read GetLocalPort write SetLocalPort;
    property ActiveServer:boolean read FActiveServer write SetActiveServer;
    property OnDataRecevied:TOnDataRecevied read FOnData write FOnData;
    property OnError:TOnError read FOnError write FOnError;
  end;
 
implementation

GAZ (статус: Посетитель), 27 июля 2014, 14:30 [#11]:

(**** TUDPClientList Class ****)
 
constructor TUDPClientList.Create;
begin
  inherited Create;
  FSockets:= TList.Create;
end;
 
destructor TUDPClientList.Destroy;
begin
  Clear;
  FSockets.Free;
  inherited Destroy;
end;
 
function TUDPClientList.GetSockets(Index: integer): TSocket;
begin
  Result:= TSocket(FSockets[Index]);
end;
 
function TUDPClientList.GetCount: integer;
begin
  Result:= FSockets.Count;
end;
 
function TUDPClientList.Add(Socket: TSocket): boolean;
begin
  Result:= (FSockets.Add(Ptr(Socket)) >= 0);
end;
 
procedure TUDPClientList.Delete(Socket: TSocket);
var
  i: integer;
begin
  for i:= 0 to FSockets.Count-1 do
    begin
      if TSocket(FSockets[i]) = Socket then
        begin
          FSockets.Delete(i);
          Break;
        end;
    end;
end;
 
procedure TUDPClientList.Clear;
begin
  FSockets.Clear;
end;
 
function TUDPClientList.IndexOf(Socket: TSocket): integer;
var
  i: integer;
begin
  Result:= -1;
  for i:= 0 to FSockets.Count-1 do
    begin
      if TSocket(FSockets[i]) = Socket then
        begin
          Result:= i;
          Break;
        end;
    end;
end;
 
(**** TCusSok Class ****)
 
constructor TCusSok.Create(AOwner: TComponent);
var
  WSAData: TWSAData;
begin
  inherited Create(AOwner);
  FProtocol:= IPPROTO_IP;
  FType:= SOCK_RAW;
  FLocalSocket:= INVALID_SOCKET;
  FSocketState:= ssNotStarted;
  FLastError:= WSAStartup($101, WSAData);
  if FLastError = 0 then
    begin
      FSocketState:= ssClosed;
      with WSAData do
        begin
          FVersion:= Concat(IntToStr(Hi(wVersion)),'.',(IntToStr(Lo(wVersion))));
          FDescription:= StrPas(szDescription);
          FSystemStatus:= StrPas(szSystemStatus);
          FMaxSockets:= iMaxSockets;
          FMaxUDPSize:= iMaxUDPDg;
        end;
    end
  else
    SocketError(FLastError);
end;
 
destructor TCusSok.Destroy;
begin
  if FLocalSocket <> INVALID_SOCKET then
    closesocket(FLocalSocket);
  if FSocketState <> ssNotStarted then
    if WSACleanUp = SOCKET_ERROR then
      SocketError(WSAGetLastError);
  inherited Destroy;
end;
 
function TCusSok.GetSockAddrIn(
         Host, Port: string; var SockAddrIn: TSockAddrIn): boolean;
var
  ProtoEnt: PProtoEnt;
  ServEnt: PServEnt;
  HostEnt: PHostEnt;
begin
  Result:= false;
  SockAddrIn.sin_family:= AF_INET;
 
  ProtoEnt:= getprotobynumber(FProtocol);
  if ProtoEnt = nil then
    begin
      SocketError(WSAGetLastError);
      Exit;
    end;
 
  ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
  if ServEnt = nil then
    SockAddrIn.sin_port:= htons(StrToInt(Port))
  else
    SockAddrIn.sin_port:= ServEnt^.s_port;
 
  SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(Host));
  if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
    begin
      HostEnt:= gethostbyname(PChar(Host));
      if HostEnt = nil then
        begin
         SocketError(WSAGetLastError);
         Exit;
        end;
      SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
    end;
  Result:= true;
end;
 
function TCusSok.GetAnySockAddrIn(
         Port: string; var SockAddrIn: TSockAddrIn): boolean;
var
  ProtoEnt: PProtoEnt;
  ServEnt: PServEnt;
begin
  Result:= false;
  SockAddrIn.sin_family:= AF_INET;
 
  ProtoEnt:= getprotobynumber(FProtocol);
  if ProtoEnt = nil then
    Exit;
 
  ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
  if ServEnt = nil then
    SockAddrIn.sin_port:= htons(StrToInt(Port))
  else
    SockAddrIn.sin_port:= ServEnt^.s_port;
 
  SockAddrIn.sin_addr.s_addr:= INADDR_ANY;
  Result:= true;
end;
 
function TCusSok.GetBroadcastSockAddrIn(
         Port: string; var SockAddrIn: TSockAddrIn): boolean;
var
  ProtoEnt: PProtoEnt;
  ServEnt: PServEnt;
begin
  Result:= false;
  SockAddrIn.sin_family:= AF_INET;
 
  ProtoEnt:= getprotobynumber(FProtocol);
  if ProtoEnt = nil then
    Exit;
 
  ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
  if ServEnt = nil then
    SockAddrIn.sin_port:= htons(StrToInt(Port))
  else
    SockAddrIn.sin_port:= ServEnt^.s_port;
 
  SockAddrIn.sin_addr.s_addr:= INADDR_BROADCAST;
  Result:= true;
end;
 
function TCusSok.SockAddrInToName(SockAddrIn: TSockAddrIn): string;
var
  HostEnt: PHostEnt;
begin
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
  if HostEnt <> nil then
    Result:= HostEnt.h_name;
end;
 
function TCusSok.SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
begin
  Result:= inet_ntoa(SockAddrIn.sin_addr);
end;
 
function TCusSok.SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
begin
  Result:= IntToStr(ntohs(SockAddrIn.sin_port));
end;
 
function TCusSok.SocketToName(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
  HostEnt: PHostEnt;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        begin
          HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
          if HostEnt <> nil then
            Result:= HostEnt.h_name;
        end;
    end;
end;
 
function TCusSok.SocketToAddress(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= inet_ntoa(SockAddrIn.sin_addr);
    end;
end;
 
function TCusSok.SocketToPort(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= IntToStr(ntohs(SockAddrIn.sin_port));
    end;
end;
 
function TCusSok.PeerToName(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
  HostEnt: PHostEnt;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        begin
          HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
          if HostEnt <> nil then
            Result:= HostEnt.h_name;
        end;
    end;
end;
 
function TCusSok.PeerToAddress(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= inet_ntoa(SockAddrIn.sin_addr);
    end;
end;
 
function TCusSok.PeerToPort(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= IntToStr(ntohs(SockAddrIn.sin_port));
    end;
end;
 
procedure TCusSok.SocketClose(var Socket: TSocket; Handle: HWND);
var
  RC: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      if WSAASyncSelect(Socket, Handle, WM_ASYNCSELECT, 0) <> 0 then
        begin
          SocketError(WSAGetLastError);
          Exit;
        end;
 
      if shutdown(Socket, 1) <> 0 then
        if WSAGetLastError <> WSAENOTCONN then
          begin
            SocketError(WSAGetLastError);
            Exit;
          end;
 
      repeat
        RC:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), 0);
      until (RC = 0) or (RC = SOCKET_ERROR);
 
      if closesocket(Socket) <> 0 then
        SocketError(WSAGetLastError)
      else
        Socket:= INVALID_SOCKET;
    end;
end;

GAZ (статус: Посетитель), 27 июля 2014, 14:31 [#12]:

function TCusSok.SocketQueueSize(Socket: TSocket): longint;
var
  Size: longint;
begin
  Result:= 0;
  if ioctlsocket(Socket, FIONREAD, Size) <> 0 then
    SocketError(WSAGetLastError)
  else
    Result:= Size;
end;
 
procedure TCusSok.SocketWrite(Socket: TSocket; Flag: integer; Data: string);
var
  TotSent, ToSend, Sent, ErrorLoop: integer;
begin
  if Data <> '' then
    begin
      ErrorLoop:= 0;
      TotSent:= 0;
      ToSend:= Length(Data);
      repeat
        Sent:= send(Socket, Data[TotSent+1], (ToSend-TotSent), Flag);
        if Sent = SOCKET_ERROR then
          begin
            Inc(ErrorLoop);
            if WSAGetLastError <> WSAEWOULDBLOCK then
              begin
                SocketError(WSAGetLastError);
                Exit;
              end;
          end
        else
          Inc(TotSent, Sent);
      until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
    end;
end;
 
function TCusSok.SocketRead(Socket: TSocket; Flag: integer): string;
var
  Received: longint;
begin
  Result:= '';
  Received:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag);
  if Received = SOCKET_ERROR then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end
  else
    begin
      SetLength(Result, Received);
      Move(FReadBuffer, Result[1], Received);
    end;
end;
 
function TCusSok.SocketWriteBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
begin
  Result:= send(Socket, Buffer^, Size, Flag);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;
 
function TCusSok.SocketReadBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
begin
  Result:= recv(Socket, Buffer^, Size, Flag);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;
 
procedure TCusSok.SocketWriteTo(Socket: TSocket; Flag: integer; Data: string; var SockAddrIn: TSockAddrIn);
var
  TotSent, ToSend, Sent, ErrorLoop: integer;
begin
  if Data <> '' then
    begin
      ErrorLoop:= 0;
      TotSent:= 0;
      ToSend:= Length(Data);
      repeat
        Sent:= sendto(Socket, Data[TotSent+1], (ToSend-TotSent), Flag, SockAddrIn, SizeOf(SockAddrIn));
        if Sent = SOCKET_ERROR then
          begin
            Inc(ErrorLoop);
            if WSAGetLastError <> WSAEWOULDBLOCK then
              begin
                SocketError(WSAGetLastError);
                Exit;
              end;
          end
        else
          Inc(TotSent, Sent);
      until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
    end;
end;
 
function TCusSok.SocketReadFrom(Socket: TSocket; Flag: integer; var SockAddrIn: TSockAddrIn): string;
var
  Len: integer;
  Received: longint;
begin
  Len:= SizeOf(SockAddrIn);
  Received:= recvfrom(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag, SockAddrIn, Len);
  if Received = SOCKET_ERROR then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end
  else
    begin
      SetLength(Result, Received);
      Move(FReadBuffer, Result[1], Received);
    end;
end;
 
function TCusSok.SocketWriteBufferTo(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn:
TSockAddrIn): integer;
begin
  Result:= sendto(Socket, Buffer^, Size, Flag, SockAddrIn, SizeOf(SockAddrIn));
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;
 
function TCusSok.SocketReadBufferFrom(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn:
TSockAddrIn): integer;
var
  Len: integer;
begin
  Len:= SizeOf(SockAddrIn);
  Result:= recvfrom(Socket, Buffer^, Size, Flag, SockAddrIn, Len);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;
 
procedure TCusSok.SocketError(Error: integer);
begin
  FLastError:= Error;
  if Assigned(FOnError) then
    FOnError(Self, FLastError, LastErrorDesc);
end;
 
function TCusSok.LastErrorDesc: string;
begin
  case FLastError of
    WSAEINTR           : Result:= 'Interrupted system call';
    WSAEBADF           : Result:= 'Bad file number';
    WSAEACCES          : Result:= 'Permission denied';
    WSAEFAULT          : Result:= 'Bad address';
    WSAEINVAL          : Result:= 'Invalid argument';
    WSAEMFILE          : Result:= 'Too many open files';
    WSAEWOULDBLOCK     : Result:= 'Operation would block';
    WSAEINPROGRESS     : Result:= 'Operation now in progress';
    WSAEALREADY        : Result:= 'Operation already in progress';
    WSAENOTSOCK        : Result:= 'Socket operation on nonsocket';
    WSAEDESTADDRREQ    : Result:= 'Destination address required';
    WSAEMSGSIZE        : Result:= 'Message too long';
    WSAEPROTOTYPE      : Result:= 'Protocol wrong type for socket';
    WSAENOPROTOOPT     : Result:= 'Protocol not available';
    WSAEPROTONOSUPPORT : Result:= 'Protocol not supported';
    WSAESOCKTNOSUPPORT : Result:= 'Socket not supported';
    WSAEOPNOTSUPP      : Result:= 'Operation not supported on socket';
    WSAEPFNOSUPPORT    : Result:= 'Protocol family not supported';
    WSAEAFNOSUPPORT    : Result:= 'Address family not supported';
    WSAEADDRINUSE      : Result:= 'Address already in use';
    WSAEADDRNOTAVAIL   : Result:= 'Can''t assign requested address';
    WSAENETDOWN        : Result:= 'Network is down';
    WSAENETUNREACH     : Result:= 'Network is unreachable';
    WSAENETRESET       : Result:= 'Network dropped connection on reset';
    WSAECONNABORTED    : Result:= 'Software caused connection abort';
    WSAECONNRESET      : Result:= 'Connection reset by peer';
    WSAENOBUFS         : Result:= 'No buffer space available';
    WSAEISCONN         : Result:= 'Socket is already connected';
    WSAENOTCONN        : Result:= 'Socket is not connected';
    WSAESHUTDOWN       : Result:= 'Can''t send after socket shutdown';
    WSAETOOMANYREFS    : Result:= 'Too many references:can''t splice';
    WSAETIMEDOUT       : Result:= 'Connection timed out';
    WSAECONNREFUSED    : Result:= 'Connection refused';
    WSAELOOP           : Result:= 'Too many levels of symbolic links';
    WSAENAMETOOLONG    : Result:= 'File name is too long';
    WSAEHOSTDOWN       : Result:= 'Host is down';
    WSAEHOSTUNREACH    : Result:= 'No route to host';
    WSAENOTEMPTY       : Result:= 'Directory is not empty';
    WSAEPROCLIM        : Result:= 'Too many processes';
    WSAEUSERS          : Result:= 'Too many users';
    WSAEDQUOT          : Result:= 'Disk quota exceeded';
    WSAESTALE          : Result:= 'Stale NFS file handle';
    WSAEREMOTE         : Result:= 'Too many levels of remote in path';
    WSASYSNOTREADY     : Result:= 'Network subsystem is unusable';
    WSAVERNOTSUPPORTED : Result:= 'Winsock DLL cannot support this application';
    WSANOTINITIALISED  : Result:= 'Winsock not initialized';
    WSAHOST_NOT_FOUND  : Result:= 'Host not found';
    WSATRY_AGAIN       : Result:= 'Non authoritative - host not found';
    WSANO_RECOVERY     : Result:= 'Non recoverable error';
    WSANO_DATA         : Result:= 'Valid name, no data record of requested type'
  else
    Result:= 'Not a Winsock error';
  end;
end;

GAZ (статус: Посетитель), 27 июля 2014, 14:33 [#13]:

function TCusSok.GetLocalHostAddress: string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    begin
      HostEnt:= gethostbyname(szHostName);
      if HostEnt = nil then
        Result:= ''
      else
        begin
          SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
          Result:= inet_ntoa(SockAddrIn.sin_addr);
        end;
    end
  else
    SocketError(WSAGetLastError);
end;
 
function TCusSok.GetLocalHostName: string;
var
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    Result:= szHostName
  else
    SocketError(WSAGetLastError);
end;
 
(**** TUDPClient Class ****)
 
constructor TUDPClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle:= AllocateHWnd(WndProc);
  FProtocol:= IPPROTO_UDP;
  FType:= SOCK_DGRAM;
end;
 
destructor TUDPClient.Destroy;
begin
  Close;
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;
 
procedure TUDPClient.IncommingData(Socket: TSocket; Error: word);
begin
  if Error <> 0 then
    SocketError(Error)
  else
    if Assigned(FOnData) then
      FOnData(Self, Socket);
end;
 
procedure TUDPClient.WndProc(var AMsg: TMessage);
var
  Error: word;
begin
  with AMsg do
    case Msg of
      WM_ASYNCSELECT:
        begin
          if (FSocketState = ssClosed) then
            Exit;
          Error:= WSAGetSelectError(LParam);
          case WSAGetSelectEvent(LParam) of
            FD_READ   : IncommingData(WParam, Error);
          else
            if Error <> 0 then
              SocketError(Error);
          end;
        end;
    else
      Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
    end;
end;
 
procedure TUDPClient.Open;
var
  SockAddrIn: TSockAddrIn;
begin
  if (FSocketState <> ssClosed) then
    Exit;
 
  if not GetSockAddrIn(FHost, FPort, SockAddrIn) then
    Exit;
 
  FLocalSocket:= socket(PF_INET, FType, 0);
  if FLocalSocket = INVALID_SOCKET then
    begin
      SocketError(WSAGetLastError);
      Exit;
    end;
 
  if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, FD_READ) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;
 
  if connect(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        begin
          SocketError(WSAGetLastError);
          closesocket(FLocalSocket);
          Exit;
        end;
    end;
 
  FSocketState:= ssOpen;
end;
 
procedure TUDPClient.Close;
begin
  if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
    Exit;
 
  SocketClose(FLocalSocket, FHandle);
  if FLocalSocket = INVALID_SOCKET then
    FSocketState:= ssClosed;
end;
 
procedure TUDPClient.Write(Data: string);
begin
  SocketWrite(FLocalSocket, 0, Data);
end;
 
function TUDPClient.Read: string;
begin
  Result:= SocketRead(FLocalSocket, 0);
end;
 
function TUDPClient.Peek: string;
begin
  Result:= SocketRead(FLocalSocket, MSG_PEEK);
end;
 
function TUDPClient.WriteBuffer(Buffer: Pointer; Size: integer): integer;
begin
  Result:= SocketWriteBuffer(FLocalSocket, Buffer, Size, 0);
end;
 
function TUDPClient.ReadBuffer(Buffer: Pointer; Size: integer): integer;
begin
  Result:= SocketReadBuffer(FLocalSocket, Buffer, Size, 0);
end;

GAZ (статус: Посетитель), 27 июля 2014, 14:33 [#14]:

function TUDPClient.GetPeerAddress: string;
begin
  Result:= PeerToAddress(FLocalSocket);
end;
 
function TUDPClient.GetPeerPort: string;
begin
  Result:= PeerToPort(FLocalSocket);
end;
 
(**** TUDPServer Class ****)
 
constructor TUDPServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle:= AllocateHWnd(WndProc);
  FProtocol:= IPPROTO_UDP;
  FType:= SOCK_DGRAM;
end;
 
destructor TUDPServer.Destroy;
begin
  Close;
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;
 
procedure TUDPServer.IncommingData(Socket: TSocket; Error: word);
begin
  if Error <> 0 then
    SocketError(Error)
  else
    if Assigned(FOnData) then
      FOnData(Self, Socket);
end;
 
procedure TUDPServer.WndProc(var AMsg: TMessage);
var
  Error: word;
begin
  with AMsg do
    case Msg of
      WM_ASYNCSELECT:
        begin
          if (FSocketState = ssClosed) then
            Exit;
          Error:= WSAGetSelectError(LParam);
          case WSAGetSelectEvent(LParam) of
            FD_READ  : IncommingData(WParam, Error);
          else
            if Error <> 0 then
              SocketError(Error);
          end;
        end;
    else
      Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
    end;
end;
 
procedure TUDPServer.Open;
var
  SockAddrIn: TSockAddrIn;
  SockOpt: LongBool;
begin
  if (FSocketState <> ssClosed) then
    Exit;
 
  if not GetAnySockAddrIn(FPort, SockAddrIn) then
    Exit;
 
  FLocalSocket:= socket(PF_INET, FType, 0);
  if FLocalSocket = INVALID_SOCKET then
    begin
      SocketError(WSAGetLastError);
      Exit;
    end;
 
  if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, FD_READ) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;
 
  SockOpt:= true; {Enable Broadcasting on this Socket}
  if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;
 
  if bind(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;
 
  FSocketState:= ssListening;
end;
 
procedure TUDPServer.Close;
begin
  if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
    Exit;
 
  SocketClose(FLocalSocket, FHandle);
  if FLocalSocket = INVALID_SOCKET then
    FSocketState:= ssClosed;
end;
 
procedure TUDPServer.Write(Socket: TSocket; Data: string; var SockAddrIn: TSockAddrIn);
begin
  SocketWriteTo(Socket, 0, Data, SockAddrIn);
end;
 
function TUDPServer.Read(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
begin
  Result:= SocketReadFrom(Socket, 0, SockAddrIn);
end;
 
function TUDPServer.Peek(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
begin
  Result:= SocketReadFrom(Socket, MSG_PEEK, SockAddrIn);
end;
 
function TUDPServer.WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
begin
  Result:= SocketWriteBufferTo(Socket, Buffer, Size, 0, SockAddrIn);
end;
 
function TUDPServer.ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
begin
  Result:= SocketReadBufferFrom(Socket, Buffer, Size, 0, SockAddrIn);
end;
 
 
(**** TUDPSwich Class ****)
 
 
constructor TUDPSwich.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FUdpClient:=TUDPClient.Create(nil);
FUdpClient.OnError:=UdpError;
FUdpClient.Port:='6767';
FUdpClient.Host:='127.0.0.1';
FUdpServer:=TUdpServer.Create(nil);
FUdpServer.OnData:=DataRecevie;
FUdpServer.OnError:=UdpError;
FUdpServer.Port:='6767';
FActiveServer:=true;
end;
 
procedure TUDPSwich.DataRecevie(Sender: TObject; Socket: TSocket);
var SAIn:TSockAddrIn;
begin
FLastSocket:=Socket;
FUdpServer.GetAnySockAddrIn(FUdpServer.FPort,SAIn);
with FLastSocketInfo do
 begin
 Name:=FUdpServer.SockAddrInToName(SAIn);
 Addres:=FUdpServer.SockAddrInToAddress(SAIn);
 Port:=FUdpServer.SockAddrInToPort(SAIn);
 end;
if Assigned(FOnData) then FOnData(self);
end;
 
destructor TUDPSwich.Destroy;
begin
FUdpServer.Close;
FUdpClient.Free;
FUdpServer.Free;
inherited;
end;
 
function TUDPSwich.GetLocalPort: integer;
begin
Result:=StrToInt(FUdpServer.Port);
end;
 
function TUDPSwich.GetRemoteHost: string;
begin
Result:=FUdpClient.Host;
end;
 
function TUDPSwich.GetRemotePort: integer;
begin
Result:=StrToInt(FUdpClient.Port);
end;
 
function TUDPSwich.GetUdpClient: TCusSok;
begin
Result:=TCusSok(FUdpClient);
end;
 
function TUDPSwich.GetUdpServer: TCusSok;
begin
Result:=TCusSok(FUdpServer);
end;
 
procedure TUDPSwich.Loaded;
begin
inherited Loaded;
if FActiveServer and (not(csDesigning in ComponentState)) then FUdpServer.Open;
end;
 
function TUDPSwich.Read: string;
var SAIn:TSockAddrIn;
begin
Result:=FUdpServer.Read(FLastSocket,SAIn);
with FLastSocketInfo do
 begin
 Name:=FUdpServer.SockAddrInToName(SAIn);
 Addres:=FUdpServer.SockAddrInToAddress(SAIn);
 Port:=FUdpServer.SockAddrInToPort(SAIn);
 end;
end;
 
function TUDPSwich.ReadBuffer(Buffer: Pointer; Size: integer): integer;
var SAIn:TSockAddrIn;
begin
Result:=FUdpServer.ReadBuffer(FLastSocket,Buffer,Size,SAIn);
with FLastSocketInfo do
 begin
 Name:=FUdpServer.SockAddrInToName(SAIn);
 Addres:=FUdpServer.SockAddrInToAddress(SAIn);
 Port:=FUdpServer.SockAddrInToPort(SAIn);
 end;
end;
 
procedure TUDPSwich.SetActiveServer(const Value: boolean);
begin
if Value<>FActiveServer then
 begin
 if Value and (not(csDesigning in ComponentState))
   then FUdpServer.Open
   else FUdpServer.Close;
 end;
FActiveServer := FUdpServer.FSocketState in [ssConnected, ssListening, ssOpen];
end;
 
procedure TUDPSwich.SetLocalPort(const Value: integer);
begin
FUdpServer.Close;
FUdpServer.Port:=IntToStr(Value);
if FActiveServer and (not(csDesigning in ComponentState)) then FUdpServer.Open;
end;
 
procedure TUDPSwich.SetRemoteHost(const Value: string);
begin
FUdpClient.Host:=Value;
end;
 
procedure TUDPSwich.SetRemotePort(const Value: integer);
begin
FUdpClient.Port:=inttostr(Value);
end;
 
procedure TUDPSwich.UdpError(Sender: TObject; Error: integer; Msg: string);
begin
if Assigned(FOnError) then FOnError(self,error,Msg);
end;
 
procedure TUDPSwich.Write(Data: string);
begin
FUdpClient.Open;
try
FUdpClient.Write(Data)
finally
FUdpClient.Close;
end;
end;
 
function TUDPSwich.WriteBuffer(Buffer: Pointer; Size: integer): integer;
begin
FUdpClient.Open;
try
Result:=FUdpClient.WriteBuffer(Buffer,Size);
finally
FUdpClient.Close;
end;
end;
 
end.

GAZ (статус: Посетитель), 27 июля 2014, 14:34 [#15]:

min@y™ (статус: Доктор наук), 27 июля 2014, 14:40 [#16]:

GAZ (статус: Посетитель), 27 июля 2014, 14:46 [#17]:

min@y™ (статус: Доктор наук), 27 июля 2014, 14:48 [#18]:

GAZ (статус: Посетитель), 27 июля 2014, 17:11 [#19]:

procedure TForm1.btn1Click(Sender: TObject);
begin
  udpSv.Active:=True;
  if udpSv.Active then svLog.Lines.Add('Server started on port: '+inttostr(udpSv.DefaultPort))
    else svLog.Lines.Add('Can`t bind port: '+inttostr(udpSv.DefaultPort));
end;

procedure TForm1.udpSvUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  strm:TStringStream;
  str:string;
begin
  strm:=TStringStream.Create('');
  strm.CopyFrom(AData, AData.Size);
  //в этом месте я хочу считывать пакет по структуре, как ???
  strm.Free;
end;

min@y™ (статус: Доктор наук), 27 июля 2014, 17:19 [#20]:

Цитата (GAZ):