Глава 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) создается так:

  1. Создайте новый компонент, производный от CsSocket.
  2. В конструкторе нового компонента задайте свойству Service значение HTTP.
  3. Добавьте методы и свойства, необходимые для работы с HTTP.

В следующей главе мы посмотрим, как это делается, на примере компонента для клиентского приложения FTP.

Изучаем 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. Все дальнейшее оставляю вашему воображению.

 

Используются технологии uCoz