Глава 5. Компонент Winsock в Delphi
Объекты хороши… но компоненты лучше. Чтобы наши программы могли мгновенно обращаться к Internet, мы упакуем весь багаж Winsock в один VCL-компонент.Internet (и распределенные среды вообще) с каждым днем становится все популярнее, поэтому сетевая поддержка в приложениях выглядит вполне естественно. Lingua francaдля работы с Internet в Microsoft Windows является Winsock API. Описанный в этой главе компонент Winsock1 станет отправной точкой, позволяющей вам самостоятельно написать многие знакомые программы на базе TCP/IP — такие, как FINGER, FTP, SMTP, POP3 и ECHO.
Что такое Winsock?
Winsock — сокращение от «Windows Sockets», это интерфейсная прослойка между Windows-приложением и базовой сетью TCP/IP. Интерфейс сокетов впервые появился в Berkeley Unix как API для работы с сетями TCP/IP. Winsock базируется на Berkeley Sockets API и включает большую часть стандартных функций BSD API, а также некоторые расширения, специфические для Windows. Поддержка сетевого взаимодействия через TCP/IP в Windows-программе сводится к вызову функций Winsock API и использованию библиоте ки WINSOCK.DLL, реализующей интерфейс Winsock.Программисту на Delphi проще всего работать
с Winsock API с помощью компонентов. В этой главе мы создадим компонент
CsSocket, инкапсулирую щий Winsock API. Он обладает несколькими несомненными
достоинствами:
 |
API становится составной частью Delphi VCL; |
|
инкапсуляция облегчает многократное использование кода; |
|
приложение-клиент видит четкий интерфейс, работа с которым происходит через свойства и методы. |
Несомненно, компонент CsSocket удобен для программирования на Delphi, но он не претендует на полноту. На фундаменте CsSocket вы сможете построить дочерние компоненты, предназначенные для работы с любым специали зированным Internet-протоколом. Компонент Winsock, поддерживающий все известные Internet-протоколы, получился бы слишком сложным и громоздким. Вместо этого мы воспользуемся CsSocket как основой для создания новых компонентов, работающих с конкретными протоколами.
Например, компонент для работы с гипертекстовым протоколом (HTTP) создается так:
- Создайте новый компонент, производный от CsSocket.
- В конструкторе нового компонента задайте свойству Service значение HTTP.
- Добавьте методы и свойства, необходимые для работы с HTTP.
Изучаем CsSocket
Компонент CsSocket построен на основе невизуального класса TCsSocket, который в свою очередь является потомком TComponent. Невизуальный класс TCsSocket похож на фундамент дома — обычно его никто не видит. Класс TComponent предоставляет самые необходимые методы и свойства, необходимые для работы CsSocket — но не более того. Если бы мы выбрали в качестве предка TGraphicControl, то класс TCsSocket обладал бы большими возможностями, но за счет соответствующего возрастания сложности и накладных расходов. CsSocket создает основу для настройки и поддержания TCP/IP-соединения, а также поддерживает сокеты как потоковые (TCP), так и датаграммные (UDP).Чтобы упростить задачу построения сетевых
компонентов TCP/IP для Internet-приложений, наш идеальный компонент Winsock
должен выполнять четыре основные функции. К ним относятся:
|
запуск и остановка Winsock; |
|
преобразование (resolving) имен хостов; |
|
создание, поддержка и уничтожение соединений (как TCP, так и UDP); |
|
отправка и прием данных через установленное соединение. |
Наш компонент Winsock, как и все сетевые формы жизни, должен выполнять инициализацию, корректно завершать работу и сообщать о возникающих ошибках. В листинге 5.1 приведен исходный код для класса TCsSocket, выполняющего эти и многие другие функции. Большинство методов находит ся в protected-секции TCsSocket, чтобы они были доступны компонентам -потомкам. Эти методы остаются невидимыми для клиентских приложений.
Листинг 5.1. Определение TCsSocket
(* CsSocket Unit
Простейший интерфейсный модуль Winsock
Написан для книги
High Performance Delphi Programming
Джон К.Пенман 1997
*)
{$H+}
unit CsSocket;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;
{$INCLUDE CsSOCKINT.PAS}
const
winsocket = 'wsock32.dll';
WSockVersionNo : String = '2.0';
WSockBuildDate : String = '7 May 97';
SOCK_EVENT = WM_USER + 1;
ASYNC_EVENT = SOCK_EVENT + 1;
type
TConditions = (Success, Failure, None);
THostAddr = (HostAddr, IPAddr);
TOperations = (SendOp, RecvOp, NoOp);
TAccess = (Blocking, NonBlocking);
TSockTypes = (SockStrm, SockDgram, SockRaw);
TServices = (NoService, Echo, Discard,
Systat, Daytime, Netstat,
Qotd, Chargen, ftp, telnet,
smtp, time, rlp, nameserver,
whois, domain, mtp, tftp, rje,
finger, http, link, supdup,
hostnames, ns, pop2,pop3,
sunrpc, auth, sftp,
uucp_path, nntp);
TProtoTypes = (IP, ICMP, GGP, TCP, PUP, UDP);
TAsyncTypes = (AsyncName, AsyncAddr, AsyncServ,
AsyncPort, AsyncProtoName, AsyncProtoNumber);
const
NULL : Char = #0;
CRLF : array[0..2] of char = #13#10#0;
MaxBufferSize = MAXGETHOSTSTRUCT;
{ Строки для расшифровки значения
свойства Service }
ServiceStrings : array[TServices] of String[10]
= ('No Service ',
'echo ',
'discard ',
'systat ',
'daytime ',
'netstat ',
'qotd ',
'chargen ',
'ftp ',
'telnet ',
'smtp ',
'time ',
'rlp ',
'nameserver ',
'whois ',
'domain ',
'mtp ',
'tftp ',
'rje ',
'finger ',
'http ',
'link ',
'supdup ',
'hostnames ',
'ns ',
'pop2 ',
'pop3 ',
'sunrpc ',
'auth ',
'sftp ',
'uucp-path ',
'nntp ');
{ Строки для расшифровки значения
свойства Protocol }
ProtoStrings : array[TProtoTypes] of String[4] =
('ip ',
'icmp ',
'gcmp ',
'tcp ',
'pup ',
'udp ');
type
CharArray = array[0..MaxBufferSize] of char;
TAddrTypes = (AFUnspec, { не указан }
AFUnix, { локальный для хоста
(конвейеры, порталы) }
AFInet, { межсетевой: UDP,
TCP и т. д. }
AFImpLink,
{ адреса arpanet imp}
AFPup,
{ протоколы pup: например, BSP }
AFChaos,
{ протокол mit CHAOS }
AFNs,
{ протоколы XEROX NS }
AFIso, { протоколы ISO }
AFOsi, { OSI - ISO }
AFEcma,
{ European computer manufacturers }
AFDatakit,
{ протоколы data kit }
AFCcitt,
{ протоколы CCITT,
X.25 и т. д.}
AFSna, { IBM SNA }
AFDecNet, { DECnet }
AFDli,
{ интерфейс непосредственной
передачи данных (data link) }
AFLat, { LAT }
AFHyLink, { гиперканал NSC }
AFAppleTalk,{ AppleTalk }
AFNetBios, { адреса NetBios }
AFMax);
const
ServDefault = NoService;
ProtoDefault = TCP;
SockDefault = SockStrm;
AddrDefault = AFINET;
PortNoDefault = 0;
type
{$LONGSTRINGS ON}
ECsSocketError = class(Exception);
TLookUpOp = (resHostName, resIpAddress,
resService, resPort,
resProto, resProtoNo);
TAsyncOpEvent = procedure(Sender : TObject;
sSocket : TSocket)
of object;
TCleanUpEvent = procedure(Sender : TObject;
CleanUp : Boolean)
of object;
TConnEvent = procedure(Sender : TObject;
sSocket : TSocket) of object;
TDisConnEvent = procedure(Sender : TObject;
sSocket : TSocket) of object;
TInfoEvent = procedure(Sender : TObject;
Msg : String) of object;
TErrorEvent = procedure(Sender : TObject;
Status : TConditions; Msg
: String) of object;
TAbortEvent = procedure(Sender : TObject)
of object;
TBusyEvent = procedure(Sender : TObject;
BusyFlag : Boolean) of object;
TStatusEvent = procedure(Sender : TObject;
Mode, Status : String)
of object;
TLookUpEvent = procedure(Sender : TObject;
LookUpOp : TLookUpOp; Value
: String; Result : Boolean) of object;
TSendDataEvent = procedure(Sender : TObject;
sSocket : TSocket) of object;
TRecvDataEvent = procedure(Sender : TObject;
sSocket : TSocket) of object;
TTimeOutEvent = procedure(Sender : TObject;
sSocket : TSocket; TimeOut
: LongInt) of object;
TCsSocket = class(TComponent)
private
{ Private declarations }
FOnCleanUpEvent : TCleanUpEvent;
FOnConnEvent : TConnEvent;
FOnDisConnEvent : TDisConnEvent;
FOnInfoEvent : TInfoEvent;
FOnErrorEvent : TErrorEvent;
FOnAbortEvent : TAbortEvent;
FOnBusyEvent : TBusyEvent;
FOnStatusEvent : TStatusEvent;
FOnLookUpEvent : TLookUpEvent;
FOnSendDataEvent : TSendDataEvent;
FOnRecvDataEvent : TRecvDataEvent;
FOnTimeOutEvent : TTimeOutEvent;
FOnAsyncOpEvent : TAsyncOpEvent;
FValidSocket : u_int;
FParent : TComponent;
FSockType : TSockTypes;
FService : TServices;
FProtocol : TProtoTypes;
FAddrType : TAddrTypes;
FAsyncType : TAsyncTypes;
FLookUpOp : TLookUpOp;
FCleanUp : Boolean;
FData,
FRemoteName,
FAsyncRemoteName,
FAsyncService,
FAsyncPort,
FAsyncProtocol,
FAsyncProtoNo,
FLocalName,
FInfo : String;
FBusy,
FCancelAsyncOp,
FOKToDisplayErrors : Boolean;
FStatus : TConditions;
FConnected : Boolean;
FTaskHandle : THandle;
FHomeHostName : String;
FWSALastError,
FTimeOut : Integer;
FRC : Integer;
FVendor,
FWSVersion,
FMaxNoSockets,
FMaxUDPPSize,
FWSStatus,
FServiceName,
FPortName,
FProtocolName,
FProtocolNo : String;
FAsyncBuff
: array[0..MAXGETHOSTSTRUCT-1] of char;
FNoOfBlockingTasks : Integer;
protected
{ Protected declarations }
FAccess : TAccess;
FPortNo : Integer;
FHost : pHostent;
FServ : pServent;
FProto : pProtoEnt;
FHostEntryBuff,
FProtoName,
FServName : CharArray;
Fh_addr : pChar;
FpHostBuffer,
FpHostName
: array[0..MAXGETHOSTSTRUCT-1] of char;
FAddress : THostAddr;
FMsgBuff : CharArray;
FSocket : TSocket;
FSockAddress : TSockAddrIn;
FHandle : THandle;
FStarted : Boolean;
FHwnd,
FAsyncHWND : HWND;
// Методы
procedure ConnEvent;
procedure CleanUpEvent; dynamic;
procedure DisConnEvent; dynamic;
procedure InfoEvent(Msg : String); dynamic;
procedure ErrorEvent(Status : TConditions;
Msg : String); dynamic;
procedure StatusEvent; dynamic;
procedure BusyEvent; dynamic;
procedure LookUpEvent(Value : TLookUpOp;
Msg : String; Result :
Boolean); dynamic;
procedure SendDataEvent; dynamic;
procedure RecvDataEvent; dynamic;
procedure TimeOutEvent; dynamic;
procedure AbortEvent; dynamic;
procedure AsyncOpEvent; dynamic;
function GetLocalName : String;
procedure SetRemoteHostName(NameReqd
: String);
function GetDataBuff : String;
procedure SetDataBuff(DataReqd : String);
function GetDatagram : String;
procedure SetDatagram(DataReqd : String);
procedure SetUpPort;
procedure SetPortName(ReqdPortName : String);
procedure SetServiceName(ReqdServiceName
: String);
{ Вызовы Winsock }
procedure GetProt(Protocol : PChar);
procedure ConnectToHost;
function GetOOBData : String;
procedure SetOOBData(ReqdOOBData : String);
function StartUp : Boolean;
procedure CleanUp;
procedure SetUpAddr; virtual;
procedure SetUpAddress; virtual;
procedure GetHost; virtual;
procedure GetServ;
function CreateSocket : TSocket;
function WSAErrorMsg : String;
function GetInfo : String; virtual;
procedure SetInfo(InfoReqd : String);
virtual;
procedure SetProtocolName(ReqdProtoName
: String);
procedure SetProtoNo(ReqdProtoNo : String);
procedure WMTimer(var Message : TMessage);
message wm_Timer;
procedure StartAsyncSelect; virtual;
procedure AsyncOperation(var Mess
: TMessage);
function GetAsyncHostName : String;
procedure SetAsyncHostName(ReqdHostName
: String);
function GetAsyncService : String;
procedure SetAsyncService(ReqdService
: String);
function GetAsyncPort : String;
procedure SetAsyncPort(ReqdPort : String);
function GetAsyncProtoName : String;
procedure SetAsyncProtoName(ReqdProtoName
: String);
function GetAsyncProtoNo : String;
procedure SetAsyncProtoNo(ReqdProtoNo
: String);
procedure CancelAsyncOperation(CancelOp
: Boolean);
function CheckConnection : Boolean;
public
{ Public declarations }
procedure GetServer;
procedure QuitSession;
procedure Cancel;
constructor Create(AOwner : TComponent);
override;
destructor Destroy; override;
{ Public properties }
property WSVendor : String
read FVendor;
property WSVersion : String
read FWSVersion;
property WSMaxNoSockets: String
read FMaxNoSockets;
property WSMaxUDPPSize : String
read FMaxUDPPSize;
property WSStatus : String
read FWSStatus;
property Info : String
read FInfo
write FInfo;
property WSErrNo : Integer
read FWSALastError
default 0;
property Connected : Boolean
read FConnected
write FConnected default FALSE;
property LocalName : String
read GetLocalName
write FLocalName;
property Status : TConditions
read FStatus
write FStatus default None;
property HostName : String
read FRemoteName
write SetRemoteHostName;
property WSService : String
read FServiceName
write SetServiceName;
property WSPort : String
read FPortName
write SetPortName;
property WSProtoName : String
read FProtocolName
write SetProtocolName;
property WSProtoNo : String
read FProtocolNo
write SetProtoNo;
property Data : String
read GetDataBuff
write SetDataBuff;
property Datagram : String
read GetDatagram
write SetDatagram;
property OOBData : String
read GetOOBData
write SetOOBData;
property CancelAsyncOP : Boolean
read FCancelAsyncOp
write CancelAsyncOperation;
published
{ Published declarations }
property OkToDisplayErrors : Boolean
read FOKToDisplayErrors
write FOKToDisplayErrors
default TRUE;
property HomeServer : String
read FHomeHostName
write FHomeHostName;
property SockType : TSockTypes
read FSockType
write FSockType
default SOCKSTRM;
property Service : TServices
read FService
write FService
default NoService;
property Protocol : TProtoTypes
read FProtocol
write FProtocol
default TCP;
property AddrType : TAddrTypes
read FAddrType
write FAddrType
default AFInet;
property Access : TAccess
read FAccess
write FAccess
default blocking;
property OnConnect : TConnEvent
read FOnConnEvent
write FOnConnEvent;
property OnClose : TDisConnEvent
read FOnDisConnEvent
write FOnDisConnEvent;
property OnCleanUp : TCleanUpEvent
read FOnCleanUpEvent
write FOnCleanUpEvent;
property OnInfo : TInfoEvent
read FOnInfoEvent
write FOnInfoEvent;
property OnError : TErrorEvent
read FOnErrorEvent
write FOnErrorEvent;
property OnLookup : TLookUpEvent
read FOnLookUpEvent
write FOnLookUpEvent;
property OnStatus : TStatusEvent
read FOnStatusEvent
write FOnStatusEvent;
property OnSendData : TSendDataEvent
read FOnSendDataEvent
write FOnSendDataEvent;
property OnRecvData : TRecvDataEvent
read FOnRecvDataEvent
write FOnRecvDataEvent;
property OnTimeOut : TTimeOutEvent
read FOnTimeOutEvent
write FOnTimeOutEvent;
property OnAbort : TAbortEvent
read FOnAbortEvent
write FOnAbortEvent;
property OnAsyncOp : TAsyncOpEvent
read FOnAsyncOpEvent
write FOnAsyncOpEvent;
end;
procedure Register;
implementation
var
myWsaData : TWSADATA;
function TCsSocket.StartUp : Boolean;
var
VersionReqd : WordRec;
begin
with VersionReqD do
begin
Hi := 1;
Lo := 1;
end;
Result :=
WSAStartUp(Word(VersionReqD),
myWsaData) = 0;
if not Result then
begin
FStatus := Failure;
raise ECsSocketError.create
('Cannot start Winsock!');
Exit;
end
else
begin
with myWsaData do
begin
FVendor := StrPas(szDescription);
FWSVersion :=
Concat(IntToStr(Hi(wVersion)),'.',
(intToStr(Lo(wVersion))));
FWSStatus := StrPas(szSystemStatus);
FMaxNoSockets := IntToStr(iMaxSockets);
FMaxUDPPSize := IntToStr(iMaxUDPDg);
end;
InfoEvent('Started WinSock');
end;
end;
procedure TCsSocket.CleanUp;
begin
if FStarted then
begin
FStarted := False;
if WSACleanUp = SOCKET_ERROR then
raise ECsSocketError.create('Cannot
close Winsock!');
end;
end;
constructor TCsSocket.Create(AOwner :
TComponent);
begin
inherited Create(AOwner);
FParent := AOwner;
FValidSocket := INVALID_SOCKET;
FSockType := SockDefault;
FAddrType := AddrDefault;
FService := ServDefault;
FProtocol := ProtoDefault;
with FSockAddress do
begin
sin_family := PF_INET;
sin_addr.s_addr := INADDR_ANY;
sin_port := 0;
end;
FSocket := INVALID_SOCKET;
FLocalName := '';
FInfo := '';
FAccess := Blocking;
FStarted := StartUp;
if not FStarted then
begin
inherited Destroy;
Exit;
end;
FHomeHostName := 'local';
Foktodisplayerrors := TRUE;
FConnected := FALSE;
FWSALastError := 0;
FTimeOut := 0;
FNoOfBlockingTasks := 0;
InfoEvent(Concat('Version ',WSockVersionNo));
FAsyncHWND :=
AllocateHWND(AsyncOperation);
end;
destructor TCsSocket.Destroy;
begin
DeallocateHWND(FAsyncHWND);
CleanUp;
inherited Destroy;
end;
procedure TCsSocket.SetUpPort;
begin
{ Теперь необходимо определить номер порта
по типу сервиса }
case FService of
NoService : FPortNo := 0;
echo : FPortNo := 7;
discard : FPortNo := 9;
systat : FPortNo := 11;
daytime : FPortNo := 13;
netstat : FPortNo := 15;
qotd : FPortNo := 17;
chargen : FPortNo := 19;
ftp : FPortNo := 21;
telnet : FPortNo := 23;
smtp : FPortNo := 25;
time : FPortNo := 37;
rlp : FPortNo := 39;
nameserver : FPortNo := 42;
whois : FPortNo := 43;
domain : FPortNo := 53;
mtp : FPortNo := 57;
tftp : FPortNo := 69;
rje : FPortNo := 77;
finger : FPortNo := 79;
http : FPortNo := 80;
link : FPortNo := 87;
supdup : FPortNo := 95;
hostnames : FPortNo := 101;
ns : FPortNo := 105;
pop2 : FPortNo := 109;
pop3 : FPortNo := 110;
sunrpc : FPortNo := 111;
auth : FPortNo := 113;
sftp : FPortNo := 115;
uucp_path : FPortNo := 117;
nntp : FPortNo := 119;
end;{case}
end;
function TCsSocket.GetLocalName : String;
var
LocalName : array[0..MaxBufferSize] of Char;
begin
if gethostname(LocalName,
SizeOf(LocalName)) = 0 then
Result := StrPas(LocalName)
else
Result := '';
end;
function TCsSocket.GetInfo : String;
begin
GetInfo := FInfo;
end;
procedure TCsSocket.SetInfo(InfoReqd : String);
begin
FInfo := InfoReqd;
end;
function TCsSocket.CreateSocket: TSocket;
begin
case FSockType of
SOCKSTRM : FSocket := socket(PF_INET,
SOCK_STREAM, IPPROTO_IP);
SOCKDGRAM : FSocket := socket(PF_INET,
SOCK_DGRAM, IPPROTO_IP);
SOCKRAW : FSocket := socket(PF_INET,
SOCK_RAW, IPPROTO_IP);
end;
if FSocket = INVALID_SOCKET then
begin { Попытка создать сокет
закончилась неудачно }
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
Result := INVALID_SOCKET;
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FStatus := Success;
Result := FSocket;
InfoEvent('Socket ' + IntToStr(Result) +
' created...');
end;
procedure TCsSocket.SetUpAddress;
begin
with FSockAddress.sin_addr do
begin
S_un_b.s_b1 := Fh_addr[0];
S_un_b.s_b2 := Fh_addr[1];
S_un_b.s_b3 := Fh_addr[2];
S_un_b.s_b4 := Fh_addr[3];
end;
end;
procedure TCsSocket.SetUpAddr;
begin
with FSockAddress do
begin
sin_family := AF_INET;
sin_port := FServ^.s_port;
end;
end;
procedure TCsSocket.GetServ;
var
ProtoStr,
ServStr : String;
begin
ProtoStr := Copy(ProtoStrings[TProtoTypes
(FProtocol)],1,Pos(' ',
ProtoStrings[TProtoTypes
(FProtocol)])-1);
StrPCopy(FProtoName, ProtoStr);
GetProt(FProtoName);
if FProto = NIL then
begin { Сервис недоступен }
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
InfoEvent(ProtoStr + ' not available!');
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
if FService = NoService then
Exit;
ServStr := Copy(ServiceStrings[TServices
(FService)],1,Pos(' ',
ServiceStrings[TServices
(FService)])-1);
StrPCopy(FServName, ServStr);
FServ := getservbyname(FServName,FProtoName);
if FServ = NIL then
begin { Сервис недоступен }
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
InfoEvent(ServStr + ' not available!');
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FStatus := Success;
end;
procedure TCsSocket.GetProt(Protocol : PChar);
begin
FProto := getprotobyname(Protocol);
if FProto = NIL then
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
LookUpEvent(resProto, StrPas(Protocol) +
' not available!', FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(StrPas
(Protocol) + 'not available!');
Exit;
end;
FStatus := Success;
LookUpEvent(resProto, StrPas(FProto.p_name),
TRUE);
end;
procedure TCsSocket.WMTimer(var Message
: TMessage);
begin
KillTimer(FHandle,10);
if WSAIsBlocking then
begin
if WSACancelBlockingCall <>
SOCKET_ERROR then
InfoEvent('Timed out. Call cancelled')
else
begin
ErrorEvent(Failure, WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
end;
end;
end;
procedure TCsSocket.ConnectToHost;
begin
InfoEvent('Connecting to ' + FRemoteName);
case SockType of
SOCKSTRM : begin
if connect(FSocket,
FSockAddress,
SizeOf(TSockAddrIn)) =
SOCKET_ERROR then
begin
if WSAGetLastError <>
WSAEWOULDBLOCK then
begin
ErrorEvent(Failure, WSAErrorMsg);
FConnected := FALSE;
closesocket(FSocket);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
end;
FStatus := Success;
FConnected := TRUE;
end;
SOCKDGRAM : begin
end;
end;{case}
end;
procedure TCsSocket.GetHost;
begin
if Length(HostName) = 0 then
begin
MessageDlg('No host name given!',
mtError,[mbOk],0);
FStatus := Failure;
Exit;
end;
CreateSocket;
if FStatus = Failure then
Exit;
GetServ;
if FStatus = Failure then
begin
raise ECsSocketError.create('Failed to
resolve host : ' + HostName);
Exit;
end;
SetUpAddress;
if FService = NoService then
FSockAddress.sin_family := AF_INET (* для
приложений, не требующих порта *)
else
SetUpAddr;
if FStatus = Failure then
Exit;
FRemoteName :=
StrPas(inet_ntoa(FSockAddress.sin_addr));
if SockType = SockStrm then
ConnectToHost
else
begin
{ Поскольку мы работаем с пакетами,
предполагается,
что соединение уже имеется }
FConnected := TRUE;
end;
end;
procedure TCsSocket.GetServer;
begin
GetServ;
if Status = Failure then Exit;
FSockAddress.sin_family
:= PF_INET;
FSockAddress.sin_port
:= FServ^.s_port;
FSockAddress.sin_addr.s_addr
:= htonl(INADDR_ANY);
FRemoteName
:= LocalName;
FSocket
:= CreateSocket;
end;
procedure TCsSocket.QuitSession;
begin
if FConnected then
begin
if WSAIsBlocking then
WSACancelBlockingCall;
closesocket(FSocket);
FConnected := FALSE;
end;
end;
function TCsSocket.WSAErrorMsg : String;
begin
FWSALastError := WSAGetLastError;
Result := LoadStr(SWSABASE + FWSALastError);
FStatus := Failure;
end;
procedure TCsSocket.SetRemoteHostName(NameReqd
: String);
var
P : Pointer;
IPAddress : LongInt;
begin
FRemoteName := NameReqd;
if Length(NameReqd) = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus, 'No host name given!');
case FLookUpOp of
resHostName : LookUpEvent(resHostName,
FRemoteName, FALSE);
resIPAddress : LookUpEvent(resIPAddress,
FRemoteName, FALSE);
end;// case
raise ECsSocketError.create('No host
name given!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncHostName(FRemoteName)
else
begin
InfoEvent('Resolving host');
StrPCopy(FpHostName, FRemoteName);
{ Определяем тип введенного адреса }
IPAddress := inet_addr(FpHostName);
if IPAddress <>INADDR_NONE then
{ Это IP-адрес }
begin
FLookUpOp := resHostName;
FAddress := IPAddr;
P := addr(IPAddress);
case AddrType of
AFINET : FHost := gethostbyaddr(P, 4,
AF_INET);
end;
end
else { Нет, это больше похоже на символьное
имя хоста }
begin
FLookUpOp := resIPAddress;
FAddress := HostAddr;
FHost := gethostbyname(FpHostName);
end;
if FHost = NIL then
begin{ Неизвестный хост, отменяем попытку... }
LookUpEvent(FLookUpOp, '', FALSE);
FStatus := Failure;
if FOKToDisplayErrors then
raise ECsSocketError.create('Unable to
resolve ' + FpHostName);
Exit;
end;
InfoEvent('Host found');
FStatus := Success;
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
if FAddress = HostAddr then
begin
SetUpAddress;
FRemoteName
:= StrPas(inet_ntoa(FSockAddress.sin_addr));
end
else
if FAddress = IPAddr then
begin
FRemoteName := StrPas(FHost^.h_name);
InfoEvent('Host found...');
end;
case FLookUpOp of
resHostName : LookUpEvent(resHostName,
FRemoteName, TRUE);
resIPAddress : LookUpEvent(resIPAddress,
FRemoteName, TRUE);
end;// case
end;
end;
function TCsSocket.GetDataBuff : String;
var
Response : Integer;
Buffer : CharArray;
begin
Response := recv(FSocket, Buffer,
MaxBufferSize, 0);
if Response = SOCKET_ERROR then
begin
if WSAGetLastError <> WSAEWOULDBLOCK then
{ Это действительно ошибка! }
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
Result := '';
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else Exit;
end
else
if Response = 0 then { Больше нет данных
от хоста}
begin
Result := '';
Exit;
end;
Buffer[Response] := NULL;
FData := StrPas(Buffer);
Result := FData;
end;
procedure TCsSocket.SetDataBuff(DataReqd :
String);
var
Data : CharArray;
Response : Integer;
begin
FData := DataReqd;
StrPCopy(Data, FData);
StrCat(Data, CRLF);
Response := send(FSocket, Data, StrLen(Data), 0);
if Response = SOCKET_ERROR then
begin { Ошибка при посылке данных
удаленному хосту }
if WSAGetLastError <>
WSAEWOULDBLOCK then{ Это
действительно ошибка! }
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end
end;
end;
function TCsSocket.GetDatagram : String;
var
Size : Integer;
Response : Integer;
MsgBuff : CharArray;
begin
Size := SizeOf(TSockAddrIn);
Response := recvfrom(FSocket, MsgBuff,
SizeOf(MsgBuff), 0,
FSockAddress, Size);
if Response = SOCKET_ERROR then
begin { Ошибка при посылке данных
удаленному хосту }
if WSAGetLastError <> WSAEWOULDBLOCK
then{ Это действительно ошибка! }
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end
end;
Result := StrPas(MsgBuff);
end;
procedure TCsSocket.SetDatagram(DataReqd
: String);
var
Response : Integer;
MsgBuff : CharArray;
begin
StrpCopy(MsgBuff,DataReqd);
StrCat(MsgBuff,@NULL);
Response := sendto(FSocket, MsgBuff,
SizeOf(MsgBuff), MSG_DONTROUTE,
FSockAddress,
SizeOf(TSockAddrIn));
if Response = SOCKET_ERROR then
begin { Ошибка при посылке данных удаленному
хосту }
if WSAGetLastError <> WSAEWOULDBLOCK
then { Это действительно ошибка! }
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end
end else InfoEvent('Data sent...');
end;
function TCsSocket.GetOOBData : String;
var
Response: integer;
Data : CharArray;
begin
if FSocket <> INVALID_SOCKET then
begin
Response := recv(FSocket,Data,255,MSG_OOB);
if Response < 0 then
begin
ErrorEvent(Failure, WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
FStatus := Failure;
Exit;
end;
Data[Response] := NULL;
Result := StrPas(Data);
end
else Result := '';
end;
procedure TCsSocket.SetOOBData(ReqdOOBData
: String);
var
Data : CharArray;
Response : Integer;
begin
if WSAIsBlocking then
if WSACancelBlockingCall <>
SOCKET_ERROR then
begin
StrPCopy(Data, ReqdOOBData);
StrCat(Data, CRLF);
Response := send(FSocket, Data,
StrLen(Data), MSG_OOB);
if Response = SOCKET_ERROR then
begin { Ошибка при посылке данных
удаленному хосту }
FStatus := Failure;
ErrorEvent(Failure,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
end;
end;
procedure TCsSocket.Cancel;
begin
if WSAIsBlocking then
if WSACancelBlockingCall = SOCKET_ERROR then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
end;
end;
{ Начало асинхронного кода }
procedure TCsSocket.StartAsyncSelect;
begin
FRC := WSAAsyncSelect(FSocket, FHwnd,
SOCK_EVENT, FD_READ
or FD_CONNECT or FD_WRITE or FD_CLOSE);
if FRC = SOCKET_ERROR then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
InfoEvent('Cannot get WSAAsyncSelect');
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
end;
procedure TCsSocket.SetPortName(ReqdPortName
: String);
var
ProtocolName : String;
ProtoName : CharArray;
begin
if Length(ReqdPortName) = 0 then
begin
FStatus := Failure;
LookUpEvent(resPort,'',FALSE);
raise ECsSocketError.create('No port
number given!');
Exit;
end;
if ReqdPortName[1] in ['a'..'z', 'A'..'Z'] then
begin
FStatus := Failure;
LookUpEvent(resPort,'',FALSE);
raise ECsSocketError.create('You must enter a
number for a port!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncPort(ReqdPortName)
else
begin
FPortName := ReqdPortName;
ProtocolName := ProtoStrings[FProtocol];
ProtocolName := Copy(ProtocolName,1, Pos(' ',
ProtocolName)-1);
StrPCopy(ProtoName, ProtocolName);
FServ := getservbyport(htons(StrToInt
(FPortName)),ProtoName);
if FServ = NIL then
begin
FStatus := Failure;
FPortName := 'no service';
LookUpEvent(resPort, '', FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create('Cannot get
service');
end else
begin
FStatus := Success;
FPortName := StrPas(Fserv^.s_name);
LookUpEvent(resPort, FPortName, TRUE);
end;
end;
end;
procedure TCsSocket.SetServiceName(ReqdServiceName
: String);
var
ProtoName, ServName : CharArray;
ProtocolName : String;
begin
if Length(ReqdServiceName) = 0 then
begin
FStatus := Failure;
LookUpEvent(resService, '', FALSE);
raise ECsSocketError.create('No service
name given!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncService(ReqdServiceName) else
begin
FServiceName := ReqdServiceName;
StrPCopy(ServName, FServiceName);
ProtocolName := ProtoStrings[FProtocol];
ProtocolName := Copy(ProtocolName,1, Pos(' ',
ProtocolName)-1);
StrPCopy(ProtoName, ProtocolName);
FServ := getservbyname(ServName,ProtoName);
if FServ = NIL then
begin
FStatus := Failure;
LookUpEvent(resService, '', FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
end else
begin
FStatus := Success;
FPortName
:= IntToStr(LongInt(abs(ntohs(FServ^.s_port))));
LookUpEvent(resService, FPortName, TRUE);
end;
end;
end;
procedure TCsSocket.SetProtocolName
(ReqdProtoName : String);
var
ProtoName : CharArray;
begin
if Length(ReqdProtoName) = 0 then
begin
FStatus := Failure;
LookUpEvent(resProto,'No protocol
number given!',FALSE);
raise ECsSocketError.create('No
protocol number given!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncProtoName(ReqdProtoName)
else
begin
StrPCopy(ProtoName, ReqdProtoName);
FProto := getprotobyname(ProtoName);
if FProto = NIL then
begin
InfoEvent(StrPas(ProtoName) +
' not available!');
LookUpEvent(resProto, '', FALSE);
FStatus := Failure;
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FStatus := Success;
FProtocolNo := IntToStr(FProto^.p_proto);
LookUpEvent(resProto, FProtocolNo, TRUE)
end;
end;
procedure TCsSocket.SetProtoNo(ReqdProtoNo
: String);
var
ProtoNo : Integer;
begin
if Length(ReqdProtoNo) = 0 then
begin
FStatus := Failure;
raise ECsSocketError.create('No protocol
number given!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncProtoNo(ReqdProtoNo)
else
begin
ProtoNo := StrToInt(ReqdProtoNo);
FProto := getprotobynumber(ProtoNo);
if FProto = NIL then
begin
InfoEvent(IntToStr(ProtoNo) +
' not available!');
LookUpEvent(resProtoNo, '', FALSE);
FStatus := Failure;
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FStatus := Success;
FProtocolName := StrPas(FProto^.p_name);
LookUpEvent(resProtoNo,FProtocolName, TRUE);
end;
end;
procedure TCsSocket.CancelAsyncOperation(CancelOP
: Boolean);
begin
if WSACancelAsyncRequest(THandle(FTaskHandle))
= SOCKET_ERROR then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
end
else
begin
FStatus := Success;
InfoEvent('WSAAsync lookup cancelled!');
end;
end;
procedure TCsSocket.AsyncOperation(var Mess
: TMessage);
var
MsgErr : Word;
begin
if Mess.Msg = ASYNC_EVENT then
begin
MsgErr := WSAGetAsyncError(Mess.lparam);
if MsgErr <> 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end
else
begin
FStatus := Success;
InfoEvent('WSAAsync operation succeeded!');
case FAsyncType of
AsyncName,
AsyncAddr : begin
FHost := pHostent(@FAsyncBuff);
if (FHost^.h_name = NIL) then
begin { Неизвестный хост, отменяем попытку...}
FStatus := Failure;
if FAsyncType = AsyncName then
LookUpEvent(resIPAddress,'',FALSE)
else
LookUpEvent(resHostName,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create('Unable
to resolve host');
Exit;
end;
if length(StrPas(FHost^.h_name)) = 0 then
begin
InfoEvent('Host lookup failed!');
FStatus := Failure;
if FAsyncType = AsyncName then
LookUpEvent(resIPAddress,'',FALSE)
else
LookUpEvent(resHostName,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create('Unknown host');
Exit;
end;
case FAddress of
IPAddr : begin
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
FAsyncRemoteName :=
StrPas(FHost^.h_name);
LookUpEvent(resHostName,
FAsyncRemoteName, TRUE);
end;
HostAddr : begin
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
SetUpAddress;
FAsyncRemoteName:=
StrPas(inet_ntoa(FSockAddress.
sin_addr));
LookUpEvent(resIPAddress,FAsyncRemoteName,
TRUE);
end;
end;{case}
end;
AsyncServ : begin
FServ := pServent(@FAsyncBuff);
if FServ^.s_name = NIL then
begin { Сервис недоступен }
FStatus := Failure;
LookUpEvent(resService,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncPort := IntToStr(ntohs(FServ^.s_port));
LookUpEvent(resService, FAsyncPort, TRUE);
end;
AsyncPort : begin
FServ := pServent(@FAsyncBuff);
if FServ^.s_name = NIL then
begin { Сервис недоступен }
FStatus := Failure;
LookUpEvent(resPort,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncService := StrPas(FServ^.s_name);
LookUpEvent(resPort, FAsyncService, TRUE);
end;
AsyncProtoName : begin
FProto := pProtoEnt(@FAsyncBuff);
if FProto^.p_name = NIL then
begin
FStatus := Failure;
LookUpEvent(resProto,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncProtoNo := IntToStr(FProto^.p_proto);
LookUpEvent(resProto, FAsyncProtoNo, TRUE);
end;
AsyncProtoNumber : begin
FProto := pProtoEnt(@FAsyncBuff);
if FProto^.p_name = NIL then
begin
FStatus := Failure;
LookUpEvent(resProtoNo,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncProtocol := StrPas(FProto^.p_name);
LookUpEvent(resProtoNo, FAsyncProtocol, TRUE);
end;
end;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
end;
end;
end;
function TCsSocket.GetAsyncHostName : String;
begin
InfoEvent('Host resolved');
Result := FAsyncRemoteName;
end;
procedure TCsSocket.SetAsyncHostName(ReqdHostName
: String);
var
IPAddress : TInaddr;
SAddress: array[0..31] of char;
begin
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
FAsyncRemoteName := ReqdHostName;
StrPcopy(SAddress, FAsyncRemoteName);
IPAddress.s_addr := inet_addr(SAddress);
if IPAddress.s_addr <> INADDR_NONE then
{ Это IP-адрес }
begin
FAddress := IPAddr;
FAsyncType := AsyncAddr;
if IPAddress.s_addr <> 0 then
FTaskHandle
:= WSAAsyncGetHostByAddr(FAsyncHWND, ASYNC_EVENT,
pChar(@IPAddress), 4, PF_INET,
@FAsyncBuff[0], SizeOf(FAsyncBuff));
if FTaskHandle = 0 then
begin
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end
else { Нет, это больше похоже на символьное
имя хоста }
begin
FAddress := HostAddr;
FAsyncType := AsyncName;
Inc(FNoOfBlockingTasks);
FTaskHandle
:= WSAAsyncGetHostByName(FAsyncHWND, ASYNC_EVENT,
@FpHostName[0],
@FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
end;
function TCsSocket.GetAsyncService : String;
begin
InfoEvent('Service resolved');
Result := FAsyncService;
end;
procedure TCsSocket.SetAsyncService(ReqdService
: String);
var
ProtoStr,
ServStr : String;
begin
ProtoStr
:= Copy(ProtoStrings[TProtoTypes
(FProtocol)],1,Pos(' ',
ProtoStrings[TProtoTypes(FProtocol)])-1);
StrPCopy(FProtoName, ProtoStr);
FProto := getprotobyname(FProtoName);
if FProto = NIL then
begin { Сервис недоступен }
FStatus := Failure;
InfoEvent(ProtoStr + ' not available!');
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
ServStr := ReqdService;
if Length(ServStr) = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
raise ECsSocketError.create('No service name!');
Exit;
end;
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
StrPCopy(FServName, ServStr);
Inc(FNoOfBlockingTasks);
FAsyncType := AsyncServ;
FTaskHandle := WSAAsyncGetServByName
(FAsyncHWND, ASYNC_EVENT,
FServName, FProtoName,
@FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
function TCsSocket.GetAsyncPort : String;
begin
InfoEvent('Port resolved');
Result := FAsyncPort;
end;
procedure TCsSocket.SetAsyncPort(ReqdPort
: String);
var
ProtoStr,
PortStr : String;
begin
ProtoStr
:= Copy(ProtoStrings
[TProtoTypes(FProtocol)],1,Pos(' ',
ProtoStrings[TProtoTypes(FProtocol)])-1);
StrPCopy(FProtoName, ProtoStr);
FProto := getprotobyname(FProtoName);
if FProto = NIL then
begin { Сервис недоступен }
FStatus := Failure;
InfoEvent(ProtoStr + ' not available!');
ErrorEvent(Failure, ProtoStr +
' not available');
raise ECsSocketError.create(ProtoStr +
' not available');
Exit;
end;
PortStr := ReqdPort;
if Length(PortStr) = 0 then
begin
FStatus := Failure;
raise ECsSocketError.create('No port number!');
Exit;
end;
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
FAsyncType := AsyncPort;
FTaskHandle := WSAAsyncGetServByPort
(FAsyncHWND, ASYNC_EVENT,
htons(StrToInt(PortStr)),
FProtoName,
@FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
function TCsSocket.GetAsyncProtoName : String;
begin
InfoEvent('Protocol resolved');
Result := FAsyncProtocol;
end;
procedure TCsSocket.SetAsyncProtoName
(ReqdProtoName : String);
begin
if Length(ReqdProtoName) = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus, 'No protocol name!');
raise ECsSocketError.create('No
protocol name!');
Exit;
end;
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
StrPCopy(FProtoName, ReqdProtoName);
FAsyncType := AsyncProtoName;
FTaskHandle
:= WSAAsyncGetProtoByName(FAsyncHWND, ASYNC_EVENT,
@FProtoName[0],
@FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus, WSAErrorMsg);
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
function TCsSocket.GetAsyncProtoNo : String;
begin
InfoEvent('Proto Number resolved');
Result := FAsyncProtoNo;
end;
procedure TCsSocket.SetAsyncProtoNo(ReqdProtoNo
: String);
var
ProtocolNo : Integer;
begin
if Length(ReqdProtoNo) = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus,'No protocol number!');
raise ECsSocketError.create('No protocol
number!');
Exit;
end;
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
ProtocolNo := StrToInt(ReqdProtoNo);
FAsyncType := AsyncProtoNumber;
FTaskHandle
:= WSAAsyncGetProtoByNumber(FAsyncHWND,ASYNC_EVENT,
ProtocolNo, @FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
function TCsSocket.CheckConnection : Boolean;
var
peeraddr : tsockaddr;
namelen : integer;
begin
namelen := SizeOf(tsockaddr);
Result := getpeername(FSocket,
peeraddr, namelen) = 0;
end;
procedure TCsSocket.ConnEvent;
begin
if Assigned(FOnConnEvent) then
FOnConnEvent(Self, FSocket);
end;
procedure TCsSocket.CleanUpEvent;
begin
if Assigned(FOnCleanUpEvent) then
FOnCleanUpEvent(Self, FCleanUp);
end;
procedure TCsSocket.DisConnEvent;
begin
if Assigned(FOnDisConnEvent) then
FOnDisConnEvent(Self, FSocket);
end;
procedure TCsSocket.InfoEvent(Msg : String);
begin
if Assigned(FOnInfoEvent) then
FOnInfoEvent(Self, Msg);
end;
procedure TCsSocket.ErrorEvent(Status
: TConditions; Msg : String);
begin
if Assigned(FOnErrorEvent) then
FOnErrorEvent(Self, Status, Msg);
end;
procedure TCsSocket.StatusEvent;
begin
if Assigned(FOnStatusEvent) then
FOnStatusEvent(Self, '','');
end;
procedure TCsSocket.BusyEvent;
begin
if Assigned(FOnBusyEvent) then
FOnBusyEvent(Self, FBusy);
end;
procedure TCsSocket.LookUpEvent(Value
: TLookUpOp; Msg : String; Result
: Boolean);
begin
if Assigned(FOnLookUpEvent) then
FOnLookUpEvent(Self, Value, Msg, Result);
end;
procedure TCsSocket.SendDataEvent;
begin
if Assigned(FOnSendDataEvent) then
FOnSendDataEvent(Self, FSocket);
end;
procedure TCsSocket.RecvDataEvent;
begin
if Assigned(FOnRecvDataEvent) then
FOnRecvDataEvent(Self, FSocket);
end;
procedure TCsSocket.TimeOutEvent;
begin
if Assigned(FOnTimeOutEvent) then
FOnTimeOutEvent(Self, FSocket, FTimeOut);
end;
procedure TCsSocket.AbortEvent;
begin
if Assigned(FOnAbortEvent) then
FOnAbortEvent(Self);
end;
procedure TCsSocket.AsyncOpEvent;
begin
if Assigned(FOnAsyncOpEvent) then
FOnAsyncOpEvent(Self, FSocket);
end;
// Начало кода WinSock - реализация
{$INCLUDE CsSOCKIMP.PAS}
procedure Register;
begin
RegisterComponents('CSWinsock', [TCsSocket]);
end;
end.
В Unix сетевые протоколы обычно компилируются прямо в ядро операционной системы. Как следствие, они всегда инициализированы и доступны для приложений. Однако в Windows ситуация выглядит иначе. Перед тем как приложение сможет воспользоваться услугами сетевого протокола, оно сначала должно обратиться с запросом на инициализацию к Winsock DLL. Компонент CsSocket решает эту задачу с помощью своего private-метода StartUp . Конструктор TCsSocket.Create задает значения свойств по умолчанию и затем вызывает StartUp (см. листинг 5.2).
Листинг 5.2. Конструктор TCsSocket.Create
constructor TCsSocket.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FParent := AOwner;
FValidSocket := INVALID_SOCKET;
FSockType := SockDefault;
FAddrType := AddrDefault;
FService := ServDefault;
FProtocol := ProtoDefault;
with FSockAddress do
begin
sin_family := PF_INET;
sin_addr.s_addr := INADDR_ANY;
sin_port := 0;
end;
FSocket := INVALID_SOCKET;
FLocalName := '';
FInfo := '';
FAccess := Blocking;
FStarted := StartUp;
if not FStarted then
begin
inherited Destroy;
Exit;
end;
FHomeHostName := 'local';
Foktodisplayerrors := TRUE;
FConnected := FALSE;
FWSALastError := 0;
FTimeOut := 0;
FNoOfBlockingTasks := 0;
InfoEvent(Concat('Version ',WSockVersionNo));
FAsyncHWND
:= AllocateHWND(AsyncOperation);
end;
Метод StartUp проверяет доступность Winsock DLL и ее статус. В нем задаются значения следующих свойств: FVendor, FWSVersion, FMaxNoSocks и FMaxUDPPSize (см. листинг 5.3). Это чисто информационные свойства, которые никак не влияют на работу главного приложения. При желании вы можете вывести данные, возвращаемые методом StartUp. Если методу StartUp не удается инициализировать Winsock DLL, он присваивает полю FStatus код «неудача», отображает сообщение об ошибке и завершает работу. Приложение, вызывающее этот метод, всегда должно проверять значение свойства Status во время инициализации программы, обычно в обработчике OnCreate приложения.
Листинг 5.3. Функция TCsSocket.StartUp
function TCsSocket.StartUp : Boolean;
var
VersionReqd : WordRec;
begin
with VersionReqD do
begin
Hi := 1;
Lo := 1;
end;
Result := WSAStartUp(Word(VersionReqD),
myWsaData) = 0;
if not Result then
begin
FStatus := Failure;
raise ECsSocketError.create('Cannot
start Winsock!');
Exit;
end
else
begin
with myWsaData do
begin
FVendor := StrPas(szDescription);
FWSVersion :=
Concat(IntToStr(Hi(wVersion)),'.',
(intToStr(Lo(wVersion))));
FWSStatus := StrPas(szSystemStatus);
FMaxNoSockets := IntToStr(iMaxSockets);
FMaxUDPPSize := IntToStr(iMaxUDPDg);
end;
InfoEvent('Started WinSock');
end;
end;
«Уборка мусора» не менее важна, чем инициализация. Когда клиентское приложение завершает свою работу (и не нуждается более в услугах Winsock), оно должно приказать Winsock DLL освободить используемую память. Процедура CleanUp (см. листинг 5.4) автоматически выполняет эту работу при закрытии Winsock DLL.
Листинг 5.4. Процедура TCsSocket.CleanUp
procedure TCsSocket.CleanUp;
begin
if FStarted then
begin
FStarted := False;
if WSACleanUp = SOCKET_ERROR then
raise ECsSocketError.create('Cannot
close Winsock!');
end;
end;
Наконец, обращение к Winsock DLL может закончиться неудачей по целому ряду причин, обусловленных спецификой сети. Если это происходит, CsSocket сообщает об ошибке, вызывая функцию Winsock WSAGetLastError через WSA ErrorMsg.
Приложение RESOLVER32
Программа RESOLVER32 использует ряд интересных методов и свойств объекта TCsSocket. RESOLVER32 может преобразовывать символьное имя хоста в его IP-адрес (то есть адрес в Internet), и наоборот. Кроме того, программа определяет взаимное соответствие между номером порта и типом сервиса, а также между номером протокола и его именем. Все эти примеры взяты из практики, поскольку преобразование имен хостов и имен сервисов — самые распространенные операции, выполняемые приложениями Winsock.На рис. 5.1 показано, как выглядит приложение в Delphi IDE. Щелкните на компоненте CsSocket1, и в окне инспектора объектов появится перечень его свойств (см. рис. 5.2). Содержащиеся в нем стандартные значения хорошо подходят для выполнения преобразований с помощью блокирующих функций. Свойство Service по умолчанию имеет значение NoService, поскольку в нашем приложении не предусмотрено конкретного сервиса для выполнения преобразований.
На рис. 5.3 изображена вкладка Events с несколькими обработчиками событий. При любом изменении статуса Winsock DLL обработчик CsSocket1OnInfo передает информацию от CsSocket к приложению. Аналогично, процедура CsSocket1LookUp передает информацию при завершении работы функции просмотра. Также заслуживает внимания процедура CsSocket1Error, которая сообщает приложению об ошибках, случившихся во время работы CsSocket.
Рис. 5.1. Приложение RESOLVER32
Рис. 5.2. Свойства CsSocket
Рис. 5.3. События CsSocket
При запуске приложения RESOLVER32 процедура Application.CreateForm из файла RESOLVER32.DPR вызывает конструктор TCsSocket.Create, чтобы задать свойствам CsSocket значения по умолчанию. После того как конструктор инициализирует компоненты и успешно обратится к Winsock DLL, процедура TFrmMain.FormCreate (см. листинг 5.5) выполняет ряд других задач.
В частности, метод TMainForm.FormCreate должен проверить свойство Status, обновляемое в CsSocket. Если свойство Status сообщает о наличии сбоев, RESOLVER32 блокирует кнопку Resolve и текстовые поля, устанавливает цвет компонента pnStatus (элемента типа TPanel) в значение clRed и выводит в панели pnStatus сообщение об ошибке. Если же все прошло гладко, RESOLVER32 обновляет элементы в групповом поле gbWSInfo в соответствии со значениями, полученными от Winsock.
Листинг 5.5. Процедура FormCreate главной формы
procedure TfrmMain.FormCreate(Sender: TObject); begin tag := 1; memErrorLog.Clear; memErrorLog.Visible := FALSE; if CsSocket1.Status = Failure then begin pnStatus.Color := clRed; pnStatus.Caption := 'Winsock not available!'; btnResolve.Enabled := FALSE; gbNameRes.Enabled := FALSE; gbServiceRes.Enabled := FALSE; gbProtoRes.Enabled := FALSE; gbTypeOfLookUp.Enabled := FALSE; edMachineName.Text := ''; edVendorName.Text := ''; edVersionNo.Text := ''; edMaxNoSockets.Text := ''; edMaxUDPacketSize.Text := ''; edWSStatusInfo.Text := ''; end else begin with CsSocket1 do begin edMachineName.Text := LocalName; edVendorName.Text := WSVendor; edVersionNo.Text := WSVersion; edMaxNoSockets.Text := WSMaxNoSockets; edMaxUDPacketSize.Text := WSMaxUDPPSize; edWSStatusInfo.Text := WSStatus; Access := Blocking; rgProtocol.ItemIndex := 0; // По умолчанию выбирается TCP end; if CsSocket1.Access = Blocking then begin btnAbortRes.Enabled := FALSE; rbBlocking.Checked := TRUE; end; cbHint.Checked := TRUE; frmMain.ShowHint := TRUE; end; end;
Как меня зовут?
Программа RESOLVER32 отображает имя, под которым ваш компьютер числится в сети. Это достигается путем присваивания тексту в поле ввода edMachineName значения свойства CsSocket1.LocalName. Метод TCsSocket.GetLocalName является оболочкой для функции gethostname Winsock API. Он извлекает имя вашего компьютера из локального файла хостов (который обычно хранится в каталоге Windows) и возвращает его в свойстве LocalName.В листинге 5.6 приведен метод TCsSocket.GetLocalName из файла CSSOCKET.PAS. Обратите внимание — gethostname, как и все функции Winsock, работает только со строками, завершающимися нулевым символом . Метод Get LocalName использует функцию StrPas, чтобы преобразовать возвращаемый результат в строку Object Pascal. Затем имя компьютера выводится в текстовом поле edMachineName. Если компьютер не имеет имени, GetLocalName просто возвращает пустую строку. Разнообразная информация, собранная методом TCsSocket.StartUp об используемом Winsock DLL, передается RESOLVER32 через свойства WSVendor, WSVersion, WSStatus, WSMaxNoSockets и WSMaxUDPPSize и отобража ется в групповом поле gbWSInfo.
Листинг 5.6. Функция GetLocalName
function TCsSocket.GetLocalName : String; var LocalName : array[0..MaxBufferSize] of Char; begin if gethostname(LocalName, SizeOf(LocalName)) = 0 then Result := StrPas(LocalName) else Result := ''; end;
Какой у тебя адрес?
Преобразование имени хоста является самой распространенной операцией, выполняемой Winsock-приложениями в режиме блокировки. В данном случае «режим блокировки» означает, что приложение ожидает ответа от удаленного компьютера — ответа, который может никогда не прийти. До получения ответа заблокированное приложение не может продолжать работу или реагировать на ввод информации пользователем и часто кажется «мертвым».В таких операционных системах, как Unix, Windows 95 и Windows NT, такое поведение не представляет особых проблем. Даже если приложение заблокировано, использованный в них принцип вытеснения задач позволяет другим приложениям нормально работать.
Чтобы пользователь не терял возможности взаимодействовать с любым приложением Winsock во время блокировки, Winsock заменяет блокирующие функции псевдоблокирующими асинхронными эквивалентами. Вместо того чтобы осуществлять полноценную блокировку, эти функции при ожидании завершения сетевого события переходят в цикл опроса. Псевдоблокирующие функции можно узнать по префиксу WSAAsync. Например, функция WSAAsyncGet HostByName является асинхронной версией gethostbyname. Используя WSAAsyncGet HostByName, пользователь может в любой момент прервать операцию просмотра. В блокирующих функциях такая возможность отсутствует.
Чтобы изменить поведение RESOLVER32, достаточно сменить значение свойства Access c Blocking на NonBlocking, или наоборот. Значение NonBlocking сообщает CsSocket о том, что для просмотра должны использоваться асинхронные функции.
Обычно хост Internet идентифицируется в
сети по уникальному адресу
в виде четверки десятичных чисел, разделенных
точками, — например, 127.0.0.1 (обратите внимание на этот специальный адрес
обратной связи, с его помощью можно тестировать приложения Winsock на компьютерах,
не подключенных к сети). Хотя такие адреса исключительно удобны для компьютеров,
на людей они производят угнетающее впечатление. Чтобы уладить эту проблему,
была разработана система, которая позволяет задать уникальное символьное
имя для каждого IP-адреса. Например, имя slipper109.iaccess.za соответствует
IP-адресу 196.7.7.109.
Чтобы преобразовать имя хоста, введите его в текстовом поле edHostName программы RESOLVER32. После нажатия кнопки Resolve RESOLVER32 присваивает имя, введенное в edHostName, свойству Hostname. При этом свойство вызывает метод TCsSocket.SetRemoteHostName. Если строка NameReqd пуста, SetRemote HostName сообщает об ошибке и завершается. В противном случае CsSocket проверяет значение поля FAccess (которое может быть равно Blocking или NonBlocking в зависимости от свойства Access), чтобы определить режим преобразования имени хоста в IP-адрес. Если значение FAccess равно NonBlocking, вызывается SetAsyncHostName. В противном случае функция StrpCopy преобразует FRemoteName из строки Паскаля в строку с нуль-терминатором. В листинге 5.7 показано, как это делается в CsSocket.
Листинг 5.7. Метод TCsSocket.SetRemoteHostName
— преобразование
имени хоста в IP-адрес
procedure TCsSocket.SetRemoteHostName(NameReqd
: String);
var
P : Pointer;
IPAddress : LongInt;
begin
FRemoteName := NameReqd;
if Length(NameReqd) = 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus, 'No host name given!');
case FLookUpOp of
resHostName : LookUpEvent(resHostName,
FRemoteName, FALSE);
resIPAddress : LookUpEvent(resIPAddress,
FRemoteName, FALSE);
end;// case
raise ECsSocketError.create('No host
name given!');
Exit;
end;
if FAccess = NonBlocking then
SetAsyncHostName(FRemoteName)
else
begin
InfoEvent('Resolving host');
StrPCopy(FpHostName, FRemoteName);
{ Определяем тип введенного адреса }
IPAddress := inet_addr(FpHostName);
if IPAddress <>INADDR_NONE then
{ Это IP-адрес }
begin
FLookUpOp := resHostName;
FAddress := IPAddr;
P := addr(IPAddress);
case AddrType of
AFINET : FHost := gethostbyaddr(P, 4,
AF_INET);
end;
end
else { Нет, это больше похоже на
символьное имя хоста }
begin
FLookUpOp := resIPAddress;
FAddress := HostAddr;
FHost := gethostbyname(FpHostName);
end;
if FHost = NIL then
begin{ Неизвестный хост, отменяем попытку...}
LookUpEvent(FLookUpOp, '', FALSE);
FStatus := Failure;
if FOKToDisplayErrors then
raise ECsSocketError.create('Unable to
resolve ' + FpHostName);
Exit;
end;
InfoEvent('Host found');
FStatus := Success;
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
if FAddress = HostAddr then
begin
SetUpAddress;
FRemoteName
:= StrPas(inet_ntoa(FSockAddress.sin_addr));
end
else
if FAddress = IPAddr then
begin
FRemoteName := StrPas(FHost^.h_name);
InfoEvent('Host found...');
end;
case FLookUpOp of
resHostName : LookUpEvent(resHostName,
FRemoteName, TRUE);
resIPAddress : LookUpEvent(resIPAddress,
FRemoteName, TRUE);
end;// case
end;
end;
Затем метод SetRemoteHostName с помощью функции inet_addr проверяет, не содержит ли исходная строка числового IP-адреса. Если не содержит, метод предполагает, что в ней находится имя хоста, и вызывает функцию gethostbyname для преобразования его в IP-адрес. Если имя хоста отсутствует в локальном файле хостов, gethostbyname ищет имя в удаленном файле хостов, хранящемся в сети.
Если имя не найдено, процесс поиска прекращает работу по тайм-ауту и присваивает protected-свойству FHost (которое представляет собой указатель на структуру pHostent) значение NIL. Затем SetRemoteHostName вызывает обработчик события LookUpEvent, чтобы сообщить о неудачном завершении просмотра, присваивает флагу FStatus значение Failure и возвращает управление вызывающему приложению. При удачном завершении поиска функция gethostbyname возвращает указатель на FHost, где содержится найденный адрес. Наконец, SetRemoteHostName возвращает IP-адрес в виде строки Паскаля, для чего используется следующий оператор:
FRemoteName := StrPas(inet_ntoa(FSockAddress.sin_addr));
Функция inet_itoa переводит возвращаемый IP-адрес в строку с нуль-терминатором, а функция StrPas завершает преобразование в строку Паскаля. Адресная информация сокета размещается в поле FSockAddress, откуда она позднее извлекается для установки соединения с хостом. Полученный в результате поиска IP-адрес помещается в текстовое поле edIPName (см. рис. 5.4). Для этого RESOLVER32 использует обработчик события OnLookUp, который вызывается внутри процедуры LookUpEvent. В листинге 5.8 показано, как это делается.
Рис. 5.4. RESOLVER32 после преобразования имени хоста
Листинг 5.8. Метод TfrmMain.CsSocket1Lookup,
используемый
программой RESOLVER32 для отображения
результатов,
полученных от функции просмотра
procedure TfrmMain.CsSocket1Lookup (Sender: TObject; LookUpOp: TLookUpOp; Value: String; Result : Boolean); begin btnResolve.Enabled := TRUE; btnAbortRes.Enabled := FALSE; Screen.Cursor := crDefault; if Result then begin pnStatus.Color := clLime; case LookUpOp of resHostName : begin edHostName.Text := Value; pnStatus.Caption := 'IP address resolved'; end; resIPAddress : begin edIpName.Text := Value; pnStatus.Caption := 'Host name resolved'; end; resService : begin edPortName.Text := Value; pnStatus.Caption := 'Service resolved'; end; resPort : begin edServiceName.Text := Value; pnStatus.Caption := 'Port number resolved'; end; resProto : begin edProtoNo.Text := Value; pnStatus.Caption := 'Protocol resolved'; end; resProtoNo : begin edProtoName.Text := Value; pnStatus.Caption := 'Protocol number resolved'; end; end;// case end else begin pnStatus.Color := clRed; case LookUpOp of resHostName : begin edHostName.Text := ''; pnStatus.Caption := 'IP address resolution failed.'; end; resIPAddress : begin edIpName.Text := ''; pnStatus.Caption := 'Host name resolution failed'; end; resService : begin edPortName.Text := ''; pnStatus.Caption := 'Service resolution failed'; end; resPort : begin edServiceName.Text := ''; pnStatus.Caption := 'Port number resolution failed.'; end; resProto : begin edProtoNo.Text := ''; pnStatus.Caption := 'Protocol resolution failed.'; end; resProtoNo : begin edProtoName.Text := ''; pnStatus.Caption := 'Protocol number resolution failed.'; end; end;// case end; end;
Как тебя зовут?
RESOLVER32 также умеет определять имя хоста по его числовому IP-адресу. Для этого следует ввести адрес в текстовом поле edIPName (см. рис. 5.5). При нажатии кнопки Resolve программа передает адресную строку из edIPName.Text методу SetRemoteHostName через свойство Hostname.Метод SetRemoteHostName, как и ранее, с помощью функции inet_addr проверяет, является ли строка корректным IP-адресом. Кроме того, перед вызовом этой функции метод присваивает указателю P адрес переменной IPAddress1, используемый функцией gethostbyaddr в качестве параметра.
Рис. 5.5. IP-адрес готов к преобразованию
Если inet_addr возвращает результат, отличный от INADDR_NONE (то есть строка представляет собой корректный числовой IP-адрес), SetRemoteHostName вызывает gethostbyaddr. Данный вызов, как и обращение к gethostbyname, может выполняться в режиме блокировки. Если вызов gethostbyaddr заканчивается успешно, он возвращает указатель на структуру pHostent. Если для заданного IP-адреса не нашлось соответствующего имени, FHost получает значение NIL, а SetRemoteHostName вызывает LookUpEvent, чтобы сообщить о неудачном поиске, устанавливает флаг FStatus и завершается. При успешном поиске свойство Hostname записывает полученное имя хоста обратно в текстовое поле edHostName через процедуру события LookUpEvent, предварительно преобразовав имя в строку Паскаля и присвоив его значение private-полю FRemoteName:
FRemoteName := StrPas(FHost^.h_name);
Асинхронное получение адреса
Блокирующие функции gethostbyname и gethostbyaddr используются достаточно просто. С асинхронными версиями этих функций, WSAAsyncGetHostByName и WSA AsyncGetHostByAddr, дело обстоит несколько сложнее. Чтобы понять, как работает асинхронный процесс, мы посмотрим, как WSAAsyncGetHostByName вызывается в программе RESOLVER32.Прежде всего смените значение свойства Access с Blocking на NonBlocking — для этого следует установить переключатель NonBlocking в групповом поле TypeOfLookup (см. рис. 5.6). При нажатии кнопки Resolve имя передается свойству HostName.
Рис. 5.6. Переход от блокирующих функций к псевдоблокирующим
Поскольку FAsync имеет значение NonBlocking, SetRemoteHostName передает его процедуре SetAsyncHostName (см. листинг 5.9).
Листинг 5.9. Метод TCsSocket.SetAsyncHostName — преобразование имени хоста
procedure TCsSocket.SetAsyncHostName
(ReqdHostName : String);
var
IPAddress : TInaddr;
SAddress: array[0..31] of char;
begin
FillChar(FAsyncBuff, SizeOf(FAsyncBuff), #0);
FAsyncRemoteName := ReqdHostName;
StrPcopy(SAddress, FAsyncRemoteName);
IPAddress.s_addr := inet_addr(SAddress);
if IPAddress.s_addr <> INADDR_NONE then
{ Это IP-адрес }
begin
FAddress := IPAddr;
FAsyncType := AsyncAddr;
if IPAddress.s_addr <> 0 then
FTaskHandle := WSAAsyncGetHostByAddr(FAsyncHWND,
ASYNC_EVENT,
pChar(@IPAddress), 4, PF_INET,
@FAsyncBuff[0], SizeOf(FAsyncBuff));
if FTaskHandle = 0 then
begin
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end
else { Нет, это больше похоже на
символьное имя хоста }
begin
FAddress := HostAddr;
FAsyncType := AsyncName;
Inc(FNoOfBlockingTasks);
FTaskHandle := WSAAsyncGetHostByName
(FAsyncHWND, ASYNC_EVENT,
@FpHostName[0],
@FAsyncBuff[0],
MAXGETHOSTSTRUCT);
if FTaskHandle = 0 then
begin
FStatus := Failure;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end else FStatus := Success;
end;
end;
SetAsyncHostName вызывает процедуру WSAAsyncGetHostByName с пятью важными аргументами. FASyncHWND — логический номер окна, которому асинхронная функция должна отправить сообщение о завершении операции просмотра. Он инициализируется в конструкторе TCsSocket.Create вызовом AllocateHWND с параметром-процедурой AsyncOperation. ASYNC_EVENT — константа события, используемая в WSAAsyncGetHostByName. Символьный массив FAsyncBuff содержит результат выполнения операции. Наконец, MAXGETHOSTSTRUCT — константа Winsock, определяющая максимальный размер буфера FAsyncBuff. Процедура WSAAsyncGet HostByName возвращает номер задачи в виде значения типа TaskHandle, которое затем присваивается полю FTaskHandle.
WSAAsyncGetHostByName немедленно завершает работу с нулевым кодом, если вызов был неудачным; в случае удачного вызова она возвращает положительное число. Тем не менее отличное от 0 значение FTaskHandle свидетель ствует лишь об успешном вызове WSAAsyncGetHostByName, но не гарантирует успех последующей операции просмотра (которая продолжает выполняться в фоновом режиме).
После завершения просмотра Winsock DLL инициирует событие ASYNC_EVENT, сообщая процедуре AsyncOperation о том, что она должна обработать сообщение ASYNC_EVENT (см. листинг 5.10).
Листинг 5.10. Процедура AsyncOperation
procedure TCsSocket.AsyncOperation(var Mess
: TMessage);
var
MsgErr : Word;
begin
if Mess.Msg = ASYNC_EVENT then
begin
MsgErr := WSAGetAsyncError(Mess.lparam);
if MsgErr <> 0 then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end
else
begin
FStatus := Success;
InfoEvent('WSAAsync operation succeeded!');
case FAsyncType of
AsyncName,
AsyncAddr : begin
FHost := pHostent(@FAsyncBuff);
if (FHost^.h_name = NIL) then
begin { Неизвестный хост, отменяем попытку... }
FStatus := Failure;
if FAsyncType = AsyncName then
LookUpEvent(resIPAddress,'',FALSE)
else
LookUpEvent(resHostName,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create
('Unable to resolve host');
Exit;
end;
if length(StrPas(FHost^.h_name)) = 0 then
begin
InfoEvent('Host lookup failed!');
FStatus := Failure;
if FAsyncType = AsyncName then
LookUpEvent(resIPAddress,'',FALSE)
else
LookUpEvent(resHostName,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create
('Unknown host');
Exit;
end;
case FAddress of
IPAddr : begin
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
FAsyncRemoteName :=
StrPas(FHost^.h_name);
LookUpEvent(resHostName,
FAsyncRemoteName, TRUE);
end;
HostAddr : begin
Move(FHost^.h_addr_list^, Fh_addr,
SizeOf(FHost^.h_addr_list^));
SetUpAddress;
FAsyncRemoteName:=
StrPas(inet_ntoa(FSockAddress.
sin_addr));
LookUpEvent(resIPAddress,FAsyncRemoteName,
TRUE);
end;
end;{case}
end;
AsyncServ : begin
FServ := pServent(@FAsyncBuff);
if FServ^.s_name = NIL then
begin { Сервис недоступен }
FStatus := Failure;
LookUpEvent(resService,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncPort := IntToStr(ntohs(FServ^.s_port));
LookUpEvent(resService, FAsyncPort, TRUE);
end;
AsyncPort : begin
FServ := pServent(@FAsyncBuff);
if FServ^.s_name = NIL then
begin { Сервис недоступен }
FStatus := Failure;
LookUpEvent(resPort,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncService := StrPas(FServ^.s_name);
LookUpEvent(resPort, FAsyncService, TRUE);
end;
AsyncProtoName : begin
FProto := pProtoEnt(@FAsyncBuff);
if FProto^.p_name = NIL then
begin
FStatus := Failure;
LookUpEvent(resProto,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncProtoNo := IntToStr(FProto^.p_proto);
LookUpEvent(resProto, FAsyncProtoNo, TRUE);
end;
AsyncProtoNumber : begin
FProto := pProtoEnt(@FAsyncBuff);
if FProto^.p_name = NIL then
begin
FStatus := Failure;
LookUpEvent(resProtoNo,'',FALSE);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
Exit;
end;
FAsyncProtocol := StrPas(FProto^.p_name);
LookUpEvent(resProtoNo, FAsyncProtocol, TRUE);
end;
end;
if FNoOfBlockingTasks > 0 then
dec(FNoOfBlockingTasks);
end;
end;
end;
Функция WSAGetAsyncError проверяет значение переменной Mess. Если переменная сообщает о происшедшей ошибке, AsyncOperation вызывает ErrorEvent для вывода причины ошибки из WSAErrorMsg, а затем завершает работу, присваивая флагу FStatus значение Failure. Если ошибки не было, мы анализируем переменную FAsyncType.
При вызове WSAAsyncGetHostByName мы присваиваем FAsyncType значение AsyncName, чтобы установить признак асинхронного поиска имени. Затем оператор case переходит к фрагменту, соответствующему значению AsyncName. Здесь символьный массив FAsyncBuff, содержащий результаты поиска, преобразуется в структуру pHostent и сохраняется в поле FHost. SetUpAddress читает адресную структуру найденного хоста и получает искомый IP-адрес. Наконец, процедура LookUpEvent возвращает IP-адрес программе RESOLVER32.
Кто находится по этому адресу?
Мы поближе познакомимся с асинхронным режимом на примере определения имени хоста по Internet-адресу функцией WSAAsyncGetHostByAddr. Чтобы воспользоваться функцией в приложении RESOLVER32, установите переключатель NonBlocking в групповом поле TypeOfLookUp и введите Internet-адрес в текстовом поле edIPName.Как и ранее, имя передается свойству HostName для обработки с помощью метода TCsSocket.SetAsyncHostName. Если переданное имя является пустой строкой, SetRemoteHostName присваивает флагу FStatus значение Failure и вызывает процедуру ErrorEvent, которая посылает сообщение об ошибке. Затем вызывается другой обработчик ошибок, LookUpEvent, который сообщает RESOLVER32 о неудачной попытке поиска и завершается. Убедившись, что FRemoteName не является пустой строкой, мы вызываем метод SetAsyncHostName, в котором функция inet_addr определяет, соответствует ли строка символьному имени или IP-адресу с точками-разделителями. Код возврата, отличный от INADDR_NONE, свидетельствует о том, что строка соответствует формату IP-адреса.
Затем эта строка передается WSAAsyncGetHostByAddr, чтобы получить информацию о хосте для данного Internet-адреса. При успешном вызове WSAAsyncGetHostByAddr свойству FTaskHandle присваивается положительное число, но это вовсе не гарантирует, что после завершения WSAAsyncGetHostByAddr также будет получен верный результат. Метод возвращает управление приложению RESOLVER32, и поиск продолжается в фоновом режиме.
Winsock DLL сообщает CsSocket о завершении поиска, инициируя событие ASYNC_EVENT. При этом вызывается метод TCsSocket.AsyncOperation, в котором просматривается значение переменной Mess. Если Mess содержит информацию об ошибке, метод AsyncOperation вызывает ErrorEvent, чтобы выдать сообщение о причине ошибки из WSAErrormsg, присваивает флагу FStatus значение Failure и завершается.
Если переменная Mess не содержит сведений об ошибках, оператор case анализирует поле FAsyncType. В данном случае FAsyncType имеет значение AsyncAddr, поэтому в результате выполняется фрагмент кода, уже знакомый нам по случаю AsyncName. Затем после анализа FAddress выполняется фрагмент, обрабатывающий результат WSAAsyncGetHostByAddr. Значение FAddress автоматически устанавливается методом SetAsyncHostName в соответствии с результатом операции inet_addr. Другими словами, FAddress получает значение IPAddr, если будет найден IP-адрес с точками-разделителями, и HostAddr в противном случае (то есть для символьного имени). Затем имя хоста извлекается с помощью следующего фрагмента кода:
Move(FHost^.h_addr_list^, Fh_addr, SizeOf(FHost^.h_addr_list^));
FAsyncRemoteName:= StrPas(FHost^.h_name));
Результат передается приложению через обработчик события OnLookUp.
Отмена операции WSAAsync
Поскольку асинхронные операции нарушают нормальную логику работы приложения, отменить их оказывается не так просто. Для прерывания асинхронных операций в Winsock API предусмотрена специальная функция WSACancelAsyncRequest (тем не менее обратите внимание — эта функция не может отменять операции, запущенные функцией WSAAsyncSelect). В листинге 5.11 показана функция WSACancelAsyncRequest в «оболочке» метода CancelAsyncOperation.Листинг 5.11. Метод TCsSocket.CancelAsyncOperation
— отмена
асинхронной операции
procedure TCsSocket.CancelAsyncOperation
(CancelOP : Boolean);
begin
if WSACancelAsyncRequest(THandle(FTaskHandle))
= SOCKET_ERROR then
begin
FStatus := Failure;
ErrorEvent(FStatus,WSAErrorMsg);
if FOKToDisplayErrors then
raise ECsSocketError.create(WSAErrorMsg);
end
else
begin
FStatus := Success;
InfoEvent('WSAAsync lookup cancelled!');
end;
end;
Однако метод CancelAsyncOperation определен в секции protected и поэтому недоступен приложению RESOLVER32. Но как же RESOLVER32 отменяет WSAAsyncGetHostByName или WSAAsyncGetHostByAddr? Обращаясь к методу CancelAsyncOperation через логическое public-свойство CancelAsyncOp.
Листинг 5.12 показывает, что происходит при нажатии кнопки Abort в групповом поле gbnameRes приложения RESOLVER32. Поскольку функция вызывается в псевдоблокирующем режиме, мы присваиваем CancelAsyncOp значение True. Тем самым мы приказываем CsSocket через CancelAsyncOperation вызвать WSACancelAsyncRequest и таким образом прервать асинхронную операцию. Обратите внимание — при вызове блокирующих функций кнопка Abort становится недоступной.
Листинг 5.12. Метод TFrmMain.AbortAsyncHostBtnClick
— отмена
асинхронной операции
procedure TfrmMain.btnAbortResClick(Sender : TObject); begin CsSocket1.CancelAsyncOp := TRUE; pnStatus.Color := clYellow; pnStatus.Caption := 'Operation aborted'; btnAbortRes.Enabled := FALSE; btnResolve.Enabled := TRUE; Screen.Cursor := crDefault; end;
Преобразование портов и сервисов
Преобразование имен сервисов и портов, как и символьных имен с IP-адресами, может выполняться в блокирующем или псевдоблокирующем (асинхронном) режиме. В блокирующем режиме для этого используются функции getservbyname и getservbyport.Поиск порта, связанного с определенным сервисом, во многом похож на процесс получения имени хоста. Например, если мы захотим определить номер порта для FTP, следует ввести строку FTP в текстовом поле edServiceName и затем присвоить ее свойству WSService. При этом имя сервиса передается методу TCsSocket.SetServiceName для преобразования. После копирования строки Паскаля ReqdServiceName в строку с нуль-терминатором ServName с помощью функции StrPCopy в строку протокола заносится текст «TCP», один из обязательных параметров для getservbyname. По умолчанию используется протокол TCP, а это означает, что при попытке определить номер порта для сервиса, основанного на другом протоколе (обычно UDP), функция getservbyname вернет указатель NIL. Некоторые сервисы используют либо TCP, либо UDP, либо оба протокола сразу. Чтобы определить, доступен ли сервис для протокола UDP, следует установить переключатель UDP в групповом поле rgProtocol и затем нажать кнопку Resolve.
Метод SetServiceName вызывает функцию getservbyname для получения соответствующего номера порта. Если сервис найден, функция getservbyname
присваивает полю FServ указатель на структуру типа pServent. После этого структура будет содержать номер порта. В противном случае функция возвращает пустой указатель; тогда метод вызывает ErrorEvent, чтобы вывести причину ошибки из WSAErrorMsg, присваивает флагу FStatus значение Failure и возвращает управление вызывающему приложению. Номер порта определяется с помощью следующего оператора:
FPortName := IntToStr(LongInt(abs(ntohs(FServ^.s_port))));
На рис. 5.7 показано, как выглядит результат преобразования.
Поиск сервиса
Процесс преобразования номера порта в соответствующий ему тип сервиса почти не отличается от только что описанного, за исключением того, что на этот раз используется блокирующая функция Winsock getservbyport. Вместо того чтобы подробно рассматривать весь процесс, мы лучше рассмотрим WSAAsyncGetServByPort, асинхронную версию getservbyport.Чтобы воспользоваться асинхронным режимом, необходимо сначала изменить свойство Access установкой переключателя Non-blocking в групповом поле TypeOfLookup. Затем введите имя порта в текстовом поле edPortName и нажмите кнопку Resolve.
Рис. 5.7. Результат преобразования имени сервиса
Когда мы присваиваем номер порта, хранящийся в edPortName.Text, свойству WSPort, он передается методу TCsSocket.SetPortName в качестве параметра ReqdPortName. Убедившись в том, что строка номера порта не пуста, SetPortName вызывает SetAsyncPort. Метод SetAsyncPort копирует номер порта в поле FPortNo — строку с нуль-терминатором. Затем вызов WSAAsyncGetServByPort извлекает номер порта.
Результат этого вызова сохраняется в поле FTaskHandle. Если значение FTaskHandle равно нулю, вызов закончился неудачей. В противном случае он прошел успешно, и тогда SetAsyncPort возвращает управление приложению, оставляя процесс просмотра выполняться в фоновом режиме. После его завершения посредством сообщения от Winsock DLL инициируется AsyncOperation. Переменная Mess проверяется на предмет ошибки. Если ошибки не было, метод возвращает номер порта. В противном случае он вызывает ErrorEvent, чтобы вывести причину ошибки, присваивает флагу FStatus значение Failure и возвращает управление приложению.
Преобразование протоколов
Получение имени и номера протокола требуется несколько реже других функций преобразования, но для полноты картины CsSocket поддерживает и их. Эти преобразования выполняются функциями API getprotobyname, getprotobyno, WSAAsyncGetProtoByName и WSAAsyncGetProtoByNo. По своей структуре и использованию эти функции похожи на те, что рассматривались выше.Использование свойства Tag
Наверное, вас давно интересует вопрос — как RESOLVER32 определяет, какое из введенных значений необходимо обработать? Все очень просто: у каждого элемента есть свойство Tag, по нему можно выделить текстовое поле, которое получает строку для преобразования. Свойствам Tag текстовых полей назначаются целые числа, начиная с 1 для текстового поля edIPName и заканчивая 6 для edProtoNo. Затем обработчики событий OnClick этих текстовых полей используются для изменения свойства Tag формы. Следующий фрагмент показывает, как это делается, на примере текстового поля edIPName1:procedure TfrmMain.edIPNameClick(Sender:
TObject);
begin
frmMain.tag := edIpName.tag;
end;
При нажатии кнопки Resolve RESOLVER32 анализирует frmMain.tag в операторе case и присваивает значение нужному свойству. В листинге 5.13 показано, как это делается.
Листинг 5.13. Использование свойства tag для определения того, какое из введенных значений следует преобразовать
procedure TfrmMain.btnResolveClick(Sender: TObject);
begin
btnResolve.Enabled := FALSE;
Screen.Cursor := crHourGlass;
if CsSocket1.Access = NonBlocking then
btnAbortRes.Enabled := TRUE;
pnStatus.Color := clBtnFace;
pnStatus.UpDate;
case tag of
begin
edHostName.Text := '';
edHostName.Update;
pnStatus.Caption := Concat('Resolving ',edIPName.Text);
pnStatus.UpDate;
CsSocket1.HostName := edIPName.Text;
end;
begin
edIPName.Text := '';
edIPName.UpDate;
pnStatus.Caption := Concat('Resolving ',edHostName.Text);
pnStatus.UpDate;
CsSocket1.HostName := edHostName.Text
end;
begin
edPortName.Text := '';
edPortName.UpDate;
pnStatus.Caption := Concat('Resolving ', edServiceName.Text);
pnStatus.UpDate;
CsSocket1.WSService := edServiceName.Text
end;
begin
edServiceName.Text := '';
edServiceName.UpDate;
pnStatus.Caption := Concat('Resolving ',
edServiceName.Text);
pnStatus.UpDate;
CsSocket1.WSPort := edPortName.Text
end;
begin
edProtoNo.Text := '';
edProtoNo.UpDate;
pnStatus.Caption := 'Resolving protocol name.';
pnStatus.UpDate;
CsSocket1.WSProtoName := edProtoName.Text;
end;
begin
edProtoName.Text := '';
edProtoName.UpDate;
pnStatus.Caption := 'Resolving
protocol number.';
pnStatus.UpDate;
CsSocket1.WSProtoNo := edProtoNo.Text;
end;
end;
end;
Стоит ли блокировать?
Если ваше приложение использует локальную систему DNS и целевой хост находится в локальной сети, использование блокирующих функций существенно уменьшает объем накладных расходов. Тем не менее, если приложение подключается к хостам за пределами локальной сети и при этом часто используется удаленная DNS, асинхронные вызовы обладают явным преимуществом — во время ожидания ваше приложение может выполнять полезную работу.CsSocket не претендует на звание идеального
компонента Winsock, и все же он образует неплохую основу для построения
других Internet-компонентов. Теперь, после знакомства с CsSocket, мы перейдем
к построению более интересных приложений, в которых участвуют дочерние
компоненты, созданные на базе CsSocket. В следующей
главе мы построим клиентское приложение FTP. Все дальнейшее оставляю
вашему воображению.
