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 контактная форма обратной связи, которую, кстати говоря, может установить любой человек, не обладающий какими-то особыми знаниями в компьютерах.
Похожие статьи: