Изучаем 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.
