[NumLock]

Код:

unit SimpleClientSocket;

interface

{$DEBUGINFO OFF}

uses
  WinSock,
  Windows,
  SysUtils,
  Classes;

type
  TSimpleClientSocket = class(TComponent)
  private
    FAddress: String;
    FHost: String;
    FPort: Integer;
    FTimeOutRead: Cardinal;
    FTimeOutWrite: Cardinal;
    FTimeOutConnect: Cardinal;
    FSocket: TSocket;
    FCriticalSection: TRTLCriticalSection;
    FEvent: THandle;
    function GetConnected: Boolean;
    procedure Lock;
    procedure Unlock;
  public
    property Connected: Boolean read GetConnected;
    property SocketHandle: TSocket read FSocket;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
{
    function ReceiveBuf(var Buf; Count: Integer): Integer;
    function SendBuf(var Buf; Count: Integer): Integer;
}
    function recv(var Buf; Count: Integer): Integer;
    function send(var Buf; Count: Integer): Integer;
    procedure Write(s: String);
    procedure Writeln(s: String);
    function Read: Char;
    function Readln: String;
  published
    property Address: String read FAddress write FAddress;
    property Host: String read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property TimeOutRead: Cardinal read FTimeOutRead write FTimeOutRead;
    property TimeOutWrite: Cardinal read FTimeOutWrite write FTimeOutWrite;
    property TimeOutConnect: Cardinal read FTimeOutConnect write FTimeOutConnect;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Internet', [TSimpleClientSocket]);
end;

constructor TSimpleClientSocket.Create(AOwner: TComponent);
var
  WSAData: TWSAData;
begin
  inherited Create(AOwner);
  if WSAStartup($0101, WSAData)<>0 then
    raise Exception.Create('WSAStartup(): '+SysErrorMessage(WSAGetLastError));
  FAddress:='';
  FHost:='';
  FPort:=0;
  FTimeOutRead:=60000;
  FTimeOutWrite:=60000;
  FTimeOutConnect:=60000;
  FSocket:=INVALID_SOCKET;
  InitializeCriticalSection(FCriticalSection);
  FEvent:=CreateEvent(nil, True, False, nil);
end;

destructor TSimpleClientSocket.Destroy;
begin
  Close;
  CloseHandle(FEvent);
  DeleteCriticalSection(FCriticalSection);
  if WSACleanup<>0 then
    raise Exception.Create('WSACleanup(): '+SysErrorMessage(WSAGetLastError));
  inherited Destroy;
end;

function TSimpleClientSocket.GetConnected: Boolean;
begin
  Result:=FSocket<>INVALID_SOCKET;
end;

procedure TSimpleClientSocket.Lock;
begin
  EnterCriticalSection(FCriticalSection);
end;

procedure TSimpleClientSocket.Unlock;
begin
  LeaveCriticalSection(FCriticalSection);
end;

procedure TSimpleClientSocket.Open;
var
  FAddr: sockaddr_in;
  HostEnt: PHostEnt;
  InAddr: in_addr;
  arg: Integer;
  ErrorCode: Integer;
  FDSetW: TFDSet;
  FDSetE: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket<>INVALID_SOCKET then
    raise Exception.Create('Socket already open');
  FSocket:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('socket(): '+SysErrorMessage(WSAGetLastError));
  try
    FAddr.sin_family:=AF_INET;
    FAddr.sin_port:=htons(FPort);
    if FHost<>'' then
    begin
      FillChar(InAddr, SizeOf(InAddr), 0);
      HostEnt:=gethostbyname(PChar(FHost));
      if HostEnt<>nil then
      begin
        InAddr.S_un_b.s_b1:=HostEnt^.h_addr^[0];
        InAddr.S_un_b.s_b2:=HostEnt^.h_addr^[1];
        InAddr.S_un_b.s_b3:=HostEnt^.h_addr^[2];
        InAddr.S_un_b.s_b4:=HostEnt^.h_addr^[3];
        FAddr.sin_addr:=InAddr;
      end else raise Exception.Create('gethostbyname()');
    end else if FAddress<>'' then
      FAddr.sin_addr.S_addr:=inet_addr(PChar(FAddress))
    else raise Exception.Create('No address specified');
    arg:=1;
    ioctlsocket(FSocket, FIONBIO, arg);
    if connect(FSocket, FAddr, SizeOf(FAddr))<>0 then
    begin
      ErrorCode:=WSAGetLastError;
      if ErrorCode<>WSAEWOULDBLOCK then
        raise Exception.Create('connect(): '+SysErrorMessage(ErrorCode));
      FD_ZERO(FDSetW);
      FD_ZERO(FDSetE);
      FD_SET(FSocket, FDSetW);
      FD_SET(FSocket, FDSetE);
      TimeVal.tv_sec:=FTimeOutConnect div 1000;
      TimeVal.tv_usec:=(FTimeOutConnect mod 1000)*1000;
      select(0, nil, @FDSetW, @FDSetE, @TimeVal);
      if not FD_ISSET(FSocket, FDSetW) then
        raise Exception.Create('connect(): timeout');
    end;
    arg:=0;
    ioctlsocket(FSocket, FIONBIO, arg);
  except
    Close;
    raise;
  end;
end;

procedure TSimpleClientSocket.Close;
begin
  Lock;
  try
    if FSocket<>INVALID_SOCKET then
    begin
      if closesocket(FSocket)<>0 then
        raise Exception.Create('closesocket(): '+SysErrorMessage(WSAGetLastError));
      FSocket:=INVALID_SOCKET;
    end;
  finally
    Unlock;
  end;
end;
{
function TSimpleClientSocket.ReceiveBuf(var Buf; Count: Integer): Integer;
var
  Overlapped: TOverlapped;
  ErrorCode: Integer;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('recv(): invalid socket');
  FillChar(OVerlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent:=FEvent;
  if not ReadFile(FSocket, Buf, Count, DWORD(Result), @Overlapped) then
  begin
    if GetLastError<>ERROR_IO_PENDING then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('recv(): '+SysErrorMessage(ErrorCode));
    end;
    if WaitForSingleObject(FEvent, FTimeOutRead)<>WAIT_OBJECT_0 then
    begin
      Close;
      raise Exception.Create('recv(): timeout');
    end;
    if not GetOverlappedResult(FSocket, Overlapped, DWORD(Result), False) then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('recv(): '+SysErrorMessage(ErrorCode));
    end;
  end;
end;

function TSimpleClientSocket.SendBuf(var Buf; Count: Integer): Integer;
var
  Overlapped: TOverlapped;
  ErrorCode: Integer;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('send(): invalid socket');
  FillChar(OVerlapped, SizeOf(Overlapped), 0);
  Overlapped.hEvent:=FEvent;
  if not WriteFile(FSocket, Buf, Count, DWORD(Result), @Overlapped) then
  begin
    if GetLastError<>ERROR_IO_PENDING then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('send(): '+SysErrorMessage(ErrorCode));
    end;
    if WaitForSingleObject(FEvent, FTimeOutWrite)<>WAIT_OBJECT_0 then
    begin
      Close;
      raise Exception.Create('send(): timeout');
    end;
    if not GetOverlappedResult(FSocket, Overlapped, DWORD(Result), False) then
    begin
      ErrorCode:=WSAGetLastError;
      Close;
      raise Exception.Create('send(): '+SysErrorMessage(ErrorCode));
    end;
  end;
end;
}
procedure TSimpleClientSocket.Write(s: String);
begin
  send(Pointer(s)^, Length(s));
end;

procedure TSimpleClientSocket.Writeln(s: String);
begin
  Write(s+#13#10);
end;

function TSimpleClientSocket.Read: Char;
begin
  Result:=#0;
  recv(Result, 1);
end;

function TSimpleClientSocket.Readln: String;
begin
  Result:='';
  while FSocket<>INVALID_SOCKET do
  begin
    Result:=Result+Read;
    if Length(Result)>=2 then
    begin
      if (Result[Length(Result)-1]=#13) and (Result[Length(Result)]=#10) then
      begin
        Result:=Copy(Result, 1, Length(Result)-2);
        Break;
      end;
    end;
    if Length(Result)>=1 then
    begin
      if Result[Length(Result)]=#10 then
      begin
        Result:=Copy(Result, 1, Length(Result)-1);
        Break;
      end;
    end;
  end;
end;

function TSimpleClientSocket.recv(var Buf; Count: Integer): Integer;
var
  ErrorCode: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('recv: invalid socket');
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  TimeVal.tv_sec:=FTimeOutRead div 1000;
  TimeVal.tv_usec:=(FTimeOutRead mod 1000)*1000;
  if select(0, @FDSet, nil, nil, @TimeVal)=SOCKET_ERROR then
    raise Exception.Create('recv: invalid socket');
  if not FD_ISSET(FSocket, FDSet) then
    raise Exception.Create('recv(): timeout');
  Result:=WinSock.recv(FSocket, Buf, Count, 0);
  if Result=0 then
  begin
    Close;
    raise Exception.Create('recv: closed');
  end; 
  if (Result=SOCKET_ERROR) then
  begin
    ErrorCode:=WSAGetLastError;
    Close;
    raise Exception.Create('recv: '+SysErrorMessage(ErrorCode));
  end;
end;

function TSimpleClientSocket.send(var Buf; Count: Integer): Integer;
var
  ErrorCode: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
begin
  if FSocket=INVALID_SOCKET then
    raise Exception.Create('send: invalid socket');
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  TimeVal.tv_sec:=FTimeOutWrite div 1000;
  TimeVal.tv_usec:=(FTimeOutWrite mod 1000)*1000;
  if select(0, nil, @FDSet, nil, @TimeVal)=SOCKET_ERROR then
    raise Exception.Create('send: invalid socket');
  if not FD_ISSET(FSocket, FDSet) then
    raise Exception.Create('send(): timeout');
  Result:=WinSock.send(FSocket, Buf, Count, 0);
  if Result=SOCKET_ERROR then
  begin
    ErrorCode:=WSAGetLastError;
    Close;
    raise Exception.Create('send: '+SysErrorMessage(ErrorCode));
  end;
end;

end.

сегодня вырезать лень, поэтому твой метод Open;