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

Окт 8, 2010


При написании программы, работающей через протокол TCP, я столкнулся с рядом проблем в стандартных компонентах IDE Delphi. В каждом компоненте свой недостаток.

  • TCPClient (uses Sockets): нет возможности установить таймаут соединения;
  • TIdTCPClient (uses IdTCPClient): принимаемые данные приходили не полностью;
  • ClientSocket (uses ScktComp): ничем не отличается от первого претендента.

Выход только один - использовать Winsock, предварительно создав на основе его компонент. И как оказалось, это совсем не сложно.

Приступим.

Для начала создадим новый Unit (File->New->Unit), в окне редактора появится готовый шаблон:

unit Unit1;
interface
implementation
end.

Свой компонент я назвал WinTCP, поэтому название модуля Unit 1 изменяем на WinTCP. После директивы interface добавляем директиву uses с модулем Winsock. Теперь необходимо создать класс на основе TObject, назовем его, например, TWinTCP:

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    public
  end;

implementation

end.

Директивы private и public являются областями видимости, в которые мы помещаем переменные и функции. Если размещать функции после private, то к функции нельзя будет обратиться вне класса, а если в public, то можно.

Говоря простым языком, в приват мы будем размещать функции для своих нужд, а в паблик те функции, которыми сможет воспользоваться наш потенциальный пользователь компонента.

В область public добавляем конструктор и деструктор класса, соответственно они будут запускаться при создании и уничтожении экземпляра нашего класса.

Примечание: чтобы автоматически создавались функции/процедуры вы можете зажать CTRL + SHIFT + C, когда курсор находится на функции в public/private.

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    public
      constructor Create;
      destructor Destroy; override;
  end;

implementation

{ TWinTCP }

constructor TWinTCP.Create;
begin

end;

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

end.

Здесь мы используем директиву override, которая переписывает уже имеющийся деструктор у класса TObject. Так надо.

В конструктор добавляем команду инициализации сокетов WSAStartup($202, FWSData), в деструктор команду очищения WSACleanup. Мы используем переменную FWSData, её нужно объявить в области private, т.к. никому не нужно знать, что она есть - только для внутреннего пользования.

Примечание: хорошим стилем написания своих классов является именование внутренних переменных и функций с заглавной буквы F.

unit WinTCP;

interface

uses Winsock;

type
  TWinTCP = class(TObject)
    private
    FWSData: TWSAData;
    public
      constructor Create;
      destructor Destroy; override;
  end;

implementation

{ TWinTCP }

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

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

end.

Прежде чем создавать процедуры подключения/отключения, добавим нашему классу возможность задать адрес и порт удаленного узла. Для этого будем использовать свойства - property. В область public пишем property Host: string write FSetHost; Таким образом мы добавили свойство Host, который имеет тип данных string, при этом в свойство можно только записывать (write) данные. Записывая в эту переменную значение, оно будет сохранятся в переменную (или вызываться функция, как в нашем случае).

Теперь нужно объявить внутреннюю функцию FSetHost, которая будет принимать аргумент с типом данных string (Host же у нас string) :

unit WinTCP;

interface

uses Winsock;

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

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

      property Host: string write FSetHost;
  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;

end.

В области private объявляем переменные FHostname (необходима для преобразования Hostname в IP) и FAddress (переменная, которая содержит ip-адрес, порт и тип соединения). GetHostByName() как раз таки преобразует name в ip-адрес (DNS-Resolve). После этого все заносится в переменную FAddress хитроумным способом, через указатели.

Тоже самое делаем и для свойства Port (integer):

unit WinTCP;

interface

uses Winsock;

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

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

      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;

end.

Необходимые свойства заданны, приступаем к коннекту/дисконнекту.

Объявляем переменную FSocket (TSocket), после чего создаем две процедуры Connect и Disconnect. В коннекте создаем сокет и присваиваем его FSocket'у. После чего соединяемся.

Здесь очень важный момент: нужно явно указать модуль из которого используется функция Connect т.к. по умолчанию будет взята свежесозданная процедура Connect.

Закрытие сокета CloseSocket() добавляем в деструктор.

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.

Сохраняем наш Unit под именем WinTCP.pas. Для проверки закинем его в папку с каким-нибудь проектом, добавляем в uses WinTCP, после объявляем переменную TCP (TWinTCP) и создаем экземпляр:

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinTCP;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TCP: TWinTCP;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
TCP := TWinTCP.Create;
TCP.Host := 'ya.ru';
TCP.Port := 80;
TCP.Connect;
TCP.Disconnect;
TCP.Free;

end;

end.

Теперь у нас есть полноценный компонент, который можно добавлять в свои проекты, не переписывая каждый раз по новой один и тот же код. Правда пока мы не добавили функции отправки/приемки данных он мало чем полезен, но об этом мы поговорим в следующей части.

Некоторые вебмастеры недооценивают важность формы обратной связи. А зря, так как я не раз наблюдал, когда сайт имеет уязвимость, но уведомить автора нет возможности. Что уж говорить о клиентах, которые захотят приобрести товары или услуги "без заморочек". Проблема решается, если на вашем портале установлена ajax контактная форма обратной связи, которую, кстати говоря, может установить любой человек, не обладающий какими-то особыми знаниями в компьютерах.

Post to Twitter

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

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

Комментарии (1)

  1. avatar

    overBlack
    Январь 5th, 2011 at 16:27 #

    Спасибочки автору. Возможно, в будущем я и действительно реализую аналогичную затею. :)

Ваш комментарий

Rambler's Top100 Яндекс.Метрика