Delphi

Delphi→ Создаем компонент TCP на Winsock (Часть 2)

Окт 8, 2010


В прошлой части мы построили каркас нашего компонента, разобрались со свойствами и написали две процедуры — connect/disconnet. Теперь попробуем передавать и принимать данные.

Для начала приведем полный листинг из первой части:

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    FSocket: TSocket;
    FWSData: TWSAData;
    FHostname: PHostEnt;
    FAddress: TSockAddrIn;

    procedure FSetHost(AHost: string);
    procedure FSetPort(APort: integer);
    public
      constructor Create;
      destructor Destroy; override;

      procedure Connect;
      procedure Disconnect;

      property Host: string write FSetHost;
      property Port: integer write FSetPort;
  end;

implementation

{ TWinTCP }

constructor TWinTCP.Create;
begin
  WSAStartup($202, FWSData);
end;

destructor TWinTCP.Destroy;
begin
  inherited;
  WSACleanup;
end;

procedure TWinTCP.FSetHost(AHost: string);
begin
  FHostname := GetHostByName(PChar(AHost));
  FAddress.sin_addr := PInAddr(FHostname^.h_addr^)^;
end;

procedure TWinTCP.FSetPort(APort: integer);
begin
  FAddress.sin_family := AF_INET;
  FAddress.sin_port := htons(APort);
end;

procedure TWinTCP.Connect;
begin
  FSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  Winsock.connect(FSocket, FAddress, SizeOf(FAddress))
end;

procedure TWinTCP.Disconnect;
begin
  CloseSocket(FSocket);
end;

end.

Winsock умеет отправлять и принимать данные через буфер — обычно это динамический массив, каких-либо данных. Добавим функцию передачи SendBuf(var ABuffer; ACount: integer): integer в область паблик. Благодаря записи var ABuffer, функция сможет принимать в качестве аргумента ABuffer любые переменные. ACount количество данных, которые нужно передать — если нужно передать все данные, то в качестве аргумента можно указать SizeOf(ABuffer). Прием данных делаем по той же схеме.

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    FSocket: TSocket;
    FWSData: TWSAData;
    FHostname: PHostEnt;
    FAddress: TSockAddrIn;

    procedure FSetHost(AHost: string);
    procedure FSetPort(APort: integer);
    public
      constructor Create;
      destructor Destroy; override;

      procedure Connect;
      procedure Disconnect;

      function SendBuf(var ABuffer; ACount: integer): integer;
      function RecvBuf(var ABuffer; ACount: integer): integer;

      property Host: string write FSetHost;
      property Port: integer write FSetPort;
  end;

implementation

{ TWinTCP }

constructor TWinTCP.Create;
begin
  WSAStartup($202, FWSData);
end;

destructor TWinTCP.Destroy;
begin
  inherited;
  WSACleanup;
end;

procedure TWinTCP.FSetHost(AHost: string);
begin
  FHostname := GetHostByName(PChar(AHost));
  FAddress.sin_addr := PInAddr(FHostname^.h_addr^)^;
end;

procedure TWinTCP.FSetPort(APort: integer);
begin
  FAddress.sin_family := AF_INET;
  FAddress.sin_port := htons(APort);
end;

procedure TWinTCP.Connect;
begin
  FSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  Winsock.connect(FSocket, FAddress, SizeOf(FAddress))
end;

procedure TWinTCP.Disconnect;
begin
  CloseSocket(FSocket);
end;

function TWinTCP.SendBuf(var ABuffer; ACount: integer): integer;
begin
  Result := Send(FSocket, ABuffer, ACount, 0);
end;

function TWinTCP.RecvBuf(var ABuffer; ACount: integer): integer;
begin
  Result := Recv(FSocket, ABuffer, ACount, 0);
end;

end.

Допишем модифицированные функции передачи, так сказать часто используемые — WriteLn и ReadLn.

function TWinTCP.Writeln(ABuffer: string; ATerminator: string = #$D#$A): integer;
begin
  ABuffer := ABuffer + ATerminator;
  Result := Send(FSocket, ABuffer[1], ACount, 0);
end;

function TWinTCP.ReadLn(ATerminator: string = #$D#$A): integer;
var
  ARecvText: string;
  ARecvChar: Char;
begin
  ARecvText := '';
  while (true) do
  begin
    Recv(FSocket, ARecvChar, 1, 0); {принимаем 1 символ Char}
    ARecvText := ARecvText + ARecvChar; {добавляем его к переменной ARecvText}
    if Pos(ATerminator, ARecvText) > 0 then break; {ищем в ARecvText текст ATerminator}
  end;
  Result := ARecvText
end;

end.

В компонент можно добавить работу с потоками (stream), символами и еще много чего. Описывать все нет смысла — наш компонент почти готов, осталось только добавит в него возможность установки таймаута. Для этого создадим свойство Timeout (integer) и соответствующую ей private процедуру FSetTimeout.

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    FSocket: TSocket;
    FWSData: TWSAData;
    FHostname: PHostEnt;
    FAddress: TSockAddrIn;
    FTimeout: TTimeVal; 

    procedure FSetHost(AHost: string);
    procedure FSetPort(APort: integer);
    procedure FSetTimeout(ATimeout: integer);
    public
      constructor Create;
      destructor Destroy; override;

      procedure Connect;
      procedure Disconnect;

      function SendBuf(var ABuffer; ACount: integer): integer;
      function RecvBuf(var ABuffer; ACount: integer): integer;
      function Writeln(ABuffer: string; ATerminator: string = #$D#$A): integer;
      function ReadLn(ATerminator: string = #$D#$A): integer;

      property Host: string write FSetHost;
      property Port: integer write FSetPort;
      property Timeout: integer write FSetTimeout;
  end;

implementation

{ TWinTCP }

constructor TWinTCP.Create;
begin
  WSAStartup($202, FWSData);
end;

destructor TWinTCP.Destroy;
begin
  inherited;
  WSACleanup;
end;

procedure TWinTCP.FSetHost(AHost: string);
begin
  FHostname := GetHostByName(PChar(AHost));
  FAddress.sin_addr := PInAddr(FHostname^.h_addr^)^;
end;

procedure TWinTCP.FSetPort(APort: integer);
begin
  FAddress.sin_family := AF_INET;
  FAddress.sin_port := htons(APort);
end;

procedure TWinTCP.Connect;
begin
  FSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  Winsock.connect(FSocket, FAddress, SizeOf(FAddress))
end;

procedure TWinTCP.Disconnect;
begin
  CloseSocket(FSocket);
end;

function TWinTCP.SendBuf(var ABuffer; ACount: integer): integer;
begin
  Result := Send(FSocket, ABuffer, ACount, 0);
end;

function TWinTCP.RecvBuf(var ABuffer; ACount: integer): integer;
begin
  Result := Recv(FSocket, ABuffer, ACount, 0);
end;

function TWinTCP.Writeln(ABuffer: string; ATerminator: string = #$D#$A): integer;
begin
  ABuffer := ABuffer + ATerminator;
  Result := Send(FSocket, ABuffer[1], ACount, 0);
end;

function TWinTCP.ReadLn(ATerminator: string = #$D#$A): integer;
var
  ARecvText: string;
  ARecvChar: Char;
begin
  ARecvText := '';
  while (true) do
  begin
    Recv(FSocket, ARecvChar, 1, 0); {принимаем 1 символ Char}
    ARecvText := ARecvText + ARecvChar; {добавляем его к переменной ARecvText}
    if Pos(ATerminator, ARecvText) > 0 then break; {ищем в ARecvText текст ATerminator}
  end;
  Result := ARecvText
end;

procedure TWinTCP.FSetTimeout(ATimeout: integer);
begin
  FTimeout.tv_usec := 0;
  FTimeout.tv_sec := ATimeout;
end;

end.

Свой компонент (WinTCP) я буду постоянно использовать в проектах, добавлять новые функции. После того как он обрастет приличным функционалом, я выложу его в общественный доступ.

Enjoy!

Похожие статьи:

  1. Создаем компонент TCP на Winsock (Часть 1)
  2. Компонент Antigate для Delphi
  3. Компонент QuickSlide
  4. Функции кодирования Base64
  5. Компоненты в массиве TObjectList

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *