Context Navigation

SCKTCOMP.PAS

Last change on this file was 7, checked in by RBRi, 19 years ago
+ sibyl staff
Property svn:eol-style set to `native`
File size: 78.8 KB

Line
1
2	{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3	º º
4	º Sibyl Portable Component Classes º
5	º º
6	º Delphi 3 compatible sockets º º
7	º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
8	º Portions Copyright (C) 1997 Borland Inc. º
9	º º
10	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
11
12	Unit ScktComp;
13
14	Interface
15
16	Uses SysUtils,Classes,Forms,SyncComp;
17
18	{$IFDEF OS2}
19	Uses Os2Def,BseDos,BseErr,PmWin;
20	{$ENDIF}
21	{$IFDEF WIN32}
22	Uses WinNT,WinBase,WinUser;
23	{$ENDIF}
24
25	Const
26	CM_SOCKETMESSAGE = WM_USER + $0005;
27	CM_DEFERFREE = WM_USER + $0006;
28
29	{$IFDEF OS2}
30	INFINITE=SEM_INDEFINITE_WAIT;
31	{$ENDIF}
32	{$IFDEF WIN32}
33	INFINITE=WinBase.INFINITE;
34	{$ENDIF}
35
36	Type
37	ESocketError = class(Exception);
38
39	TSocket=LongInt;
40
41	TIn_Addr=Record
42	Case Integer Of
43	1:(S_un_b:Record s_b1,s_b2,s_b3,s_b4:Byte; End;);
44	2:(s_un_w:Record s_w1,s_w2:Word; End;);
45	3:(s_addr:LongWord);
46	End;
47
48	TSockAddrIn=Record
49	sin_family:Integer;
50	sin_port:Word;
51	sin_addr:TIn_addr;
52	sin_zero:CString[7];;
53	End;
54	TInAddr=TIn_Addr;
55
56	TServerWinSocket=Class;
57	TServerClientWinSocket=Class;
58	TCustomWinSocket=Class;
59	TCustomSocket=Class;
60	TServerAcceptThread=Class;
61	TServerClientThread=Class;
62
63	{$M+}
64	TClientType = (ctNonBlocking, ctBlocking);
65	TServerType = (stNonBlocking, stThreadBlocking);
66
67	TSocketEvent=(seLookup, seConnecting, seConnect, seDisconnect, seListen,
68	seAccept, seWrite, seRead, seDisconnected);
69	TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);
70
71	TGetSocketEvent = Procedure(Sender: TObject; Socket: TSocket;
72	Var ClientSocket: TServerClientWinSocket) of object;
73	TGetThreadEvent = Procedure(Sender: TObject; ClientSocket: TServerClientWinSocket;
74	Var SocketThread: TServerClientThread) of object;
75
76	TSocketEventEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket;
77	SocketEvent: TSocketEvent) Of Object;
78	TSocketErrorEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket;
79	ErrorEvent: TErrorEvent; Var ErrorCode:Word) Of Object;
80
81	TSocketNotifyEvent = Procedure(Sender: TObject; Socket: TCustomWinSocket) Of Object;
82
83	TThreadNotifyEvent = Procedure(Sender:TObject;Thread: TServerClientThread) Of Object;
84
85	TAsyncStyle=(asRead,asWrite,asOOB,asAccept,asConnect,asClose);
86	TAsyncStyles=Set Of TAsyncStyle;
87	{$M-}
88
89	TCustomWinSocket=Class
90	Private
91	FConnected: Boolean;
92	FSendStream: TStream;
93	FSocket: TSocket;
94	FDropAfterSend: Boolean;
95	FHandle:LongWord;
96	FOnSocketEvent: TSocketEventEvent;
97	FOnErrorEvent: TSocketErrorEvent;
98	FData: Pointer;
99	FSocketControl:TControl;
100	FAddr: TSockAddrIn;
101	FAsyncStyles: TASyncStyles;
102	Private
103	Function GetHandle:LongWord;
104	Function GetLocalHost:String;
105	Function GetLocalAddress:String;
106	Function GetLocalPort:LongInt;
107	Function GetRemoteHost:String;
108	Function GetRemoteAddress:String;
109	Function GetRemotePort:LongInt;
110	Function GetRemoteAddr:TSockAddrIn;
111	Protected
112	Procedure Open(Var Name,Address,Service:String;Port:Word);
113	Procedure Read(Socket:TSocket); Virtual;
114	Procedure Write(Socket:TSocket); Virtual;
115	Procedure Connect(Socket:TSocket); Virtual;
116	Procedure Disconnect(Socket:TSocket); Virtual;
117	Function InitSocket(Var Name,Address,Service:String;Port:Word;
118	Client:Boolean):TSockAddrIn;
119	Procedure Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent); Virtual;
120	Procedure Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word); Virtual;
121	Procedure SetAsyncStyles(Value:TASyncStyles);
122	Procedure Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
123	Procedure Accept(Socket:TSocket); Virtual;
124	Public
125	Constructor Create(ASocket:TSocket);
126	Destructor Destroy; Override;
127	Function ReceiveBuf(Var Buf;Count:LongInt):LongInt;
128	Function ReceiveText: String;
129	Function SendBuf(Var Buf; Count: LongInt): LongInt;
130	Function SendStream(AStream: TStream): Boolean;
131	Procedure Close;
132	Function LookupName(Const Name:String):TInAddr;
133	Function LookupService(Const Service:String):LongInt;
134	Function ReceiveLength:LongInt;
135	Function SendStreamThenDrop(AStream:TStream): Boolean;
136	Procedure SendText(Const S:String);
137	Public
138	Property LocalHost:String read GetLocalHost;
139	Property LocalAddress:String read GetLocalAddress;
140	Property LocalPort:LongInt read GetLocalPort;
141	Property RemoteHost:String read GetRemoteHost;
142	Property RemoteAddress:String read GetRemoteAddress;
143	Property RemotePort:LongInt read GetRemotePort;
144	Property RemoteAddr:TSockAddrIn read GetRemoteAddr;
145	Property Connected:Boolean read FConnected;
146	Property Addr:TSockAddrIn read FAddr;
147	Property ASyncStyles:TAsyncStyles read FAsyncStyles write SetAsyncStyles;
148	Property Handle:LongWord read GetHandle;
149	Property SocketHandle:TSocket read FSocket;
150	Property OnSocketEvent:TSocketEventEvent read FOnSocketEvent write FOnSocketEvent;
151	Property OnErrorEvent:TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;
152	Property Data:Pointer read FData write FData;
153	End;
154
155	TClientWinSocket=Class(TCustomWinSocket)
156	Private
157	FClientType:TClientType;
158	Protected
159	Procedure Connect(Socket:TSocket); Override;
160	Procedure SetClientType(Value:TClientType);
161	Public
162	Property ClientType:TClientType read FClientType write SetClientType;
163	End;
164
165	TServerClientWinSocket=Class(TCustomWinSocket)
166	Private
167	FServerWinSocket: TServerWinSocket;
168	Public
169	Constructor Create(Socket:TSocket;ServerWinSocket:TServerWinSocket);
170	Destructor Destroy; Override;
171	Public
172	Property ServerWinSocket:TServerWinSocket read FServerWinSocket;
173	End;
174
175	TServerWinSocket=Class(TCustomWinSocket)
176	Private
177	FConnections: TList;
178	FActiveThreads: TList;
179	FServerType: TServerType;
180	FThreadCacheSize: LongInt;
181	FServerAcceptThread: TServerAcceptThread;
182	FOnGetSocket: TGetSocketEvent;
183	FOnGetThread: TGetThreadEvent;
184	FOnThreadStart: TThreadNotifyEvent;
185	FOnThreadEnd: TThreadNotifyEvent;
186	FOnClientConnect: TSocketNotifyEvent;
187	FOnClientDisconnect: TSocketNotifyEvent;
188	FOnClientDisconnected: TSocketNotifyEvent;
189	FOnClientRead: TSocketNotifyEvent;
190	FOnClientWrite: TSocketNotifyEvent;
191	FOnClientError: TSocketErrorEvent;
192	Private
193	Procedure ClientEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent: TSocketEvent);
194	Procedure ClientError(Sender:TObject;Socket:TCustomWinSocket;
195	ErrorEvent:TErrorEvent;Var ErrorCode:Word);
196	Function GetActiveConnections:LongInt;
197	Function GetActiveThreads:LongInt;
198	Function GetConnections(Index:LongInt):TCustomWinSocket;
199	Function GetIdleThreads:LongInt;
200	Protected
201	Procedure Accept(Socket:TSocket); Override;
202	Procedure ClientConnect(Socket:TCustomWinSocket); Virtual;
203	Procedure ClientDisconnect(Socket:TCustomWinSocket); Virtual;
204	Procedure ClientDisconnected(Socket:TCustomWinSocket); Virtual;
205	Procedure ClientErrorEvent(Socket:TCustomWinSocket; ErrorEvent: TErrorEvent;
206	Var ErrorCode:Word); Virtual;
207	Procedure Disconnect(Socket:TSocket); Override;
208	Procedure ClientRead(Socket:TCustomWinSocket); Virtual;
209	Procedure ClientWrite(Socket:TCustomWinSocket); Virtual;
210	Function DoCreateThread(ClientSocket:TServerClientWinSocket): TServerClientThread; Virtual;
211	Procedure Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
212	Procedure SetServerType(Value:TServerType);
213	Procedure SetThreadCacheSize(Value:LongInt);
214	Procedure ThreadEnd(AThread:TServerClientThread); Virtual;
215	Procedure ThreadStart(AThread:TServerClientThread); Virtual;
216	Function GetClientSocket(Socket:TSocket): TServerClientWinSocket; Virtual;
217	Function GetServerThread(ClientSocket:TServerClientWinSocket): TServerClientThread; Virtual;
218	Public
219	Constructor Create(ASocket:TSocket);
220	Destructor Destroy; Override;
221	Function GetClientThread(ClientSocket:TServerClientWinSocket): TServerClientThread;
222	Public
223	Property ActiveConnections:LongInt read GetActiveConnections;
224	Property ActiveThreads:LongInt read GetActiveThreads;
225	Property Connections[Index: LongInt]: TCustomWinSocket read GetConnections;
226	Property IdleThreads:LongInt read GetIdleThreads;
227	Property ServerType:TServerType read FServerType write SetServerType;
228	Property ThreadCacheSize: LongInt read FThreadCacheSize write SetThreadCacheSize;
229	Property OnGetSocket:TGetSocketEvent read FOnGetSocket write FOnGetSocket;
230	Property OnGetThread:TGetThreadEvent read FOnGetThread write FOnGetThread;
231	Property OnThreadStart:TThreadNotifyEvent read FOnThreadStart write FOnThreadStart;
232	Property OnThreadEnd:TThreadNotifyEvent read FOnThreadEnd write FOnThreadEnd;
233	Property OnClientConnect:TSocketNotifyEvent read FOnClientConnect write FOnClientConnect;
234	Property OnClientDisconnect:TSocketNotifyEvent read FOnClientDisconnect write FOnClientDisconnect;
235	Property OnClientDisconnected:TSocketNotifyEvent read FOnClientDisconnected write FOnClientDisconnected;
236	Property OnClientRead:TSocketNotifyEvent read FOnClientRead write FOnClientRead;
237	Property OnClientWrite:TSocketNotifyEvent read FOnClientWrite write FOnClientWrite;
238	Property OnClientError:TSocketErrorEvent read FOnClientError write FOnClientError;
239	End;
240
241	TServerAcceptThread=Class(TThread)
242	Private
243	FServerSocket: TServerWinSocket;
244	Public
245	Constructor Create(CreateSuspended:Boolean;ASocket:TServerWinSocket);
246	Procedure Execute; Override;
247	Public
248	Property ServerSocket:TServerWinSocket read FServerSocket;
249	End;
250
251	TServerClientThread = class(TThread)
252	Private
253	FKeepInCache: Boolean;
254	FData: Pointer;
255	FClientSocket: TServerClientWinSocket;
256	FServerSocket: TServerWinSocket;
257	FException: Exception;
258	FEvent: TSimpleEvent;
259	Private
260	Procedure HandleEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent: TSocketEvent);
261	Procedure HandleError(Sender:TObject;Socket:TCustomWinSocket;
262	ErrorEvent:TErrorEvent;Var ErrorCode:Word);
263	Procedure DoHandleException;
264	Procedure DoRead;
265	Procedure DoWrite;
266	Protected
267	Procedure DoTerminate; Override;
268	Procedure Execute; Override;
269	Procedure ClientExecute; virtual;
270	Procedure Event(SocketEvent:TSocketEvent); virtual;
271	Procedure Error(ErrorEvent:TErrorEvent; Var ErrorCode:Word); virtual;
272	Procedure HandleException(e:Exception); virtual;
273	Procedure ReActivate(ASocket:TServerClientWinSocket);
274	Function StartConnect:Boolean;
275	Function EndConnect:Boolean;
276	Public
277	Constructor Create(CreateSuspended:Boolean;ASocket:TServerClientWinSocket);
278	Destructor Destroy; Override;
279	Public
280	Property ClientSocket:TServerClientWinSocket read FClientSocket;
281	Property ServerSocket:TServerWinSocket read FServerSocket;
282	Property KeepInCache:Boolean read FKeepInCache write FKeepInCache;
283	Property Data:Pointer read FData write FData;
284	End;
285
286	TCustomSocket=Class(TComponent)
287	Private
288	FActive:Boolean;
289	FPort:LongInt;
290	FAddress:String;
291	FHost:String;
292	FService:String;
293	FOnLookup:TSocketNotifyEvent;
294	FOnConnect:TSocketNotifyEvent;
295	FOnConnecting:TSocketNotifyEvent;
296	FOnDisconnect:TSocketNotifyEvent;
297	FOnListen:TSocketNotifyEvent;
298	FOnAccept:TSocketNotifyEvent;
299	FOnRead:TSocketNotifyEvent;
300	FOnWrite:TSocketNotifyEvent;
301	FOnError:TSocketErrorEvent;
302	Private
303	Procedure DoEvent(Sender:TObject;Socket:TCustomWinSocket;SocketEvent:TSocketEvent);
304	Procedure DoError(Sender:TObject;Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word);
305	Protected
306	Procedure Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent); Virtual;
307	Procedure Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;Var ErrorCode:Word); Virtual;
308	Procedure DoActivate(Value:Boolean); Virtual; Abstract;
309	Procedure Loaded; Override;
310	Procedure SetActive(Value:Boolean);
311	Procedure SetAddress(Value:String);
312	Procedure SetHost(Value:String);
313	Procedure SetPort(Value:LongInt);
314	Procedure SetService(Value:String);
315	Protected
316	Property Active:Boolean read FActive write SetActive;
317	Property Address:String read FAddress write SetAddress;
318	Property OnRead:TSocketNotifyEvent read FOnRead write FOnRead;
319	Property OnWrite:TSocketNotifyEvent read FOnWrite write FOnWrite;
320	Property Host:String read FHost write SetHost;
321	Property Port:LongInt read FPort write SetPort;
322	Property Service:String read FService write SetService;
323	Property OnLookup:TSocketNotifyEvent read FOnLookup write FOnLookup;
324	Property OnConnecting:TSocketNotifyEvent read FOnConnecting write FOnConnecting;
325	Property OnConnect:TSocketNotifyEvent read FOnConnect write FOnConnect;
326	Property OnDisconnect:TSocketNotifyEvent read FOnDisconnect write FOnDisconnect;
327	Property OnListen:TSocketNotifyEvent read FOnListen write FOnListen;
328	Property OnAccept:TSocketNotifyEvent read FOnAccept write FOnAccept;
329	Property OnError:TSocketErrorEvent read FOnError write FOnError;
330	Public
331	Procedure Open;
332	Procedure Close;
333	End;
334
335	TWinSocketStream=Class(TStream)
336	Private
337	FSocket: TCustomWinSocket;
338	FTimeout: Longint;
339	FEvent: TSimpleEvent;
340	Public
341	Constructor Create(ASocket:TCustomWinSocket;TimeOut:Longint);
342	Destructor Destroy; Override;
343	Function WaitForData(Timeout:Longint):Boolean;
344	Function Read(Var Buffer;Count:Longint):Longint; Override;
345	Function Write(Const Buffer;Count:Longint):Longint; Override;
346	Function Seek(Offset:Longint;Origin:Word):Longint; Override;
347	Public
348	Property TimeOut:Longint read FTimeout write FTimeout;
349	End;
350
351	TClientSocket=Class(TCustomSocket)
352	Private
353	FClientSocket: TClientWinSocket;
354	Private
355	Procedure DoActivate(Value:Boolean); Override;
356	Protected
357	Function GetClientType:TClientType;
358	Procedure SetClientType(Value:TClientType);
359	Public
360	Constructor Create(AOwner:TComponent); Override;
361	Destructor Destroy; Override;
362	Public
363	Property Socket:TClientWinSocket read FClientSocket;
364	Published
365	Property Active;
366	Property Address;
367	Property ClientType:TClientType read GetClientType write SetClientType;
368	Property Host;
369	Property Port;
370	Property Service;
371	Property OnLookup;
372	Property OnConnecting;
373	Property OnConnect;
374	Property OnDisconnect;
375	Property OnRead;
376	Property OnWrite;
377	Property OnError;
378	End;
379
380	TServerSocket = class(TCustomSocket)
381	Private
382	Procedure DoActivate(Value:Boolean); Override;
383	Protected
384	FServerSocket: TServerWinSocket;
385	Protected
386	Function GetServerType:TServerType;
387	Function GetGetThreadEvent:TGetThreadEvent;
388	Function GetGetSocketEvent:TGetSocketEvent;
389	Function GetThreadCacheSize:LongInt;
390	Function GetOnThreadStart:TThreadNotifyEvent;
391	Function GetOnThreadEnd:TThreadNotifyEvent;
392	Function GetOnClientConnect:TSocketNotifyEvent;
393	Function GetOnClientDisconnect:TSocketNotifyEvent;
394	Function GetOnClientDisconnected:TSocketNotifyEvent;
395	Function GetOnClientRead:TSocketNotifyEvent;
396	Function GetOnClientWrite:TSocketNotifyEvent;
397	Function GetOnClientError:TSocketErrorEvent;
398	Procedure SetServerType(Value:TServerType);
399	Procedure SetGetThreadEvent(Value:TGetThreadEvent);
400	Procedure SetGetSocketEvent(Value:TGetSocketEvent);
401	Procedure SetThreadCacheSize(Value:LongInt);
402	Procedure SetOnThreadStart(Value:TThreadNotifyEvent);
403	Procedure SetOnThreadEnd(Value:TThreadNotifyEvent);
404	Procedure SetOnClientConnect(Value:TSocketNotifyEvent);
405	Procedure SetOnClientDisconnect(Value:TSocketNotifyEvent);
406	Procedure SetOnClientDisconnected(Value:TSocketNotifyEvent);
407	Procedure SetOnClientRead(Value:TSocketNotifyEvent);
408	Procedure SetOnClientWrite(Value:TSocketNotifyEvent);
409	Procedure SetOnClientError(Value:TSocketErrorEvent);
410	Public
411	Constructor Create(AOwner: TComponent); Override;
412	Destructor Destroy; Override;
413	Public
414	Property Socket: TServerWinSocket read FServerSocket;
415	Published
416	Property Active;
417	Property Port;
418	Property Service;
419	Property OnListen;
420	Property OnAccept;
421	Property ServerType:TServerType read GetServerType write SetServerType;
422	Property ThreadCacheSize:LongInt read GetThreadCacheSize write SetThreadCacheSize;
423	Property OnGetThread:TGetThreadEvent read GetGetThreadEvent write SetGetThreadEvent;
424	Property OnGetSocket:TGetSocketEvent read GetGetSocketEvent write SetGetSocketEvent;
425	Property OnThreadStart:TThreadNotifyEvent read GetOnThreadStart write SetOnThreadStart;
426	Property OnThreadEnd:TThreadNotifyEvent read GetOnThreadEnd write SetOnThreadEnd;
427	Property OnClientConnect:TSocketNotifyEvent read GetOnClientConnect write SetOnClientConnect;
428	Property OnClientDisconnect:TSocketNotifyEvent read GetOnClientDisconnect write SetOnClientDisconnect;
429	Property OnClientDisconnected:TSocketNotifyEvent read GetOnClientDisconnected write SetOnClientDisconnected;
430	Property OnClientRead:TSocketNotifyEvent read GetOnClientRead write SetOnClientRead;
431	Property OnClientWrite:TSocketNotifyEvent read GetOnClientWrite write SetOnClientWrite;
432	Property OnClientError:TSocketErrorEvent read GetOnClientError write SetOnClientError;
433	End;
434
435	ThreadVar SocketErrorProc:Procedure(ErrorCode:Word);
436
437	Implementation
438
439	Const
440	INADDR_ANY =$00000000;
441	PF_INET =2;
442	SOCK_STREAM =1; /* stream socket */
443	IPPROTO_IP =0; /* dummy for IP */
444
445	FD_READ =$01;
446	FD_WRITE =$02;
447	FD_OOB =$04;
448	FD_ACCEPT =$08;
449	FD_CONNECT =$10;
450	FD_CLOSE =$20;
451
452	INVALID_SOCKET = -1;
453	SOCKET_ERROR = -1;
454
455	IOCPARM_MASK = $7f;
456	IOC_VOID = $20000000;
457	IOC_OUT = $40000000;
458	IOC_IN = $80000000;
459	IOC_INOUT = IOC_IN Or IOC_OUT;
460	FIONREAD = IOC_OUT Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
461	(Longint(Byte('f')) Shl 8) Or 127;
462	FIONBIO = IOC_IN Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
463	(Longint(Byte('f')) shl 8) Or 126;
464	FIOASYNC = IOC_IN Or ((Longint(SizeOf(Longint)) And IOCPARM_MASK) Shl 16) Or
465	(Longint(Byte('f')) Shl 8) Or 125;
466
467	SOMAXCONN =5;
468
469	Uses Forms;
470
471	Const
472	WSABASEERR =10000;
473	WSAEINTR =(WSABASEERR+4);
474	WSAEBADF =(WSABASEERR+9);
475	WSAEACCES =(WSABASEERR+13);
476	WSAEFAULT =(WSABASEERR+14);
477	WSAEINVAL =(WSABASEERR+22);
478	WSAEMFILE =(WSABASEERR+24);
479	WSAEWOULDBLOCK =(WSABASEERR+35);
480	WSAEINPROGRESS =(WSABASEERR+36);
481	WSAEALREADY =(WSABASEERR+37);
482	WSAENOTSOCK =(WSABASEERR+38);
483	WSAEDESTADDRREQ =(WSABASEERR+39);
484	WSAEMSGSIZE =(WSABASEERR+40);
485	WSAEPROTOTYPE =(WSABASEERR+41);
486	WSAENOPROTOOPT =(WSABASEERR+42);
487	WSAEPROTONOSUPPORT =(WSABASEERR+43);
488	WSAESOCKTNOSUPPORT =(WSABASEERR+44);
489	WSAEOPNOTSUPP =(WSABASEERR+45);
490	WSAEPFNOSUPPORT =(WSABASEERR+46);
491	WSAEAFNOSUPPORT =(WSABASEERR+47);
492	WSAEADDRINUSE =(WSABASEERR+48);
493	WSAEADDRNOTAVAIL =(WSABASEERR+49);
494	WSAENETDOWN =(WSABASEERR+50);
495	WSAENETUNREACH =(WSABASEERR+51);
496	WSAENETRESET =(WSABASEERR+52);
497	WSAECONNABORTED =(WSABASEERR+53);
498	WSAECONNRESET =(WSABASEERR+54);
499	WSAENOBUFS =(WSABASEERR+55);
500	WSAEISCONN =(WSABASEERR+56);
501	WSAENOTCONN =(WSABASEERR+57);
502	WSAESHUTDOWN =(WSABASEERR+58);
503	WSAETOOMANYREFS =(WSABASEERR+59);
504	WSAETIMEDOUT =(WSABASEERR+60);
505	WSAECONNREFUSED =(WSABASEERR+61);
506	WSAELOOP =(WSABASEERR+62);
507	WSAENAMETOOLONG =(WSABASEERR+63);
508	WSAEHOSTDOWN =(WSABASEERR+64);
509	WSAEHOSTUNREACH =(WSABASEERR+65);
510	WSAENOTEMPTY =(WSABASEERR+66);
511	WSAEPROCLIM =(WSABASEERR+67);
512	WSAEUSERS =(WSABASEERR+68);
513	WSAEDQUOT =(WSABASEERR+69);
514	WSAESTALE =(WSABASEERR+70);
515	WSAEREMOTE =(WSABASEERR+71);
516	WSASYSNOTREADY =(WSABASEERR+91);
517	WSAVERNOTSUPPORTED =(WSABASEERR+92);
518	WSANOTINITIALISED =(WSABASEERR+93);
519	WSAHOST_NOT_FOUND =(WSABASEERR+1001);
520	HOST_NOT_FOUND =WSAHOST_NOT_FOUND;
521	WSATRY_AGAIN =(WSABASEERR+1002);
522	TRY_AGAIN =WSATRY_AGAIN;
523	WSANO_RECOVERY =(WSABASEERR+1003);
524	NO_RECOVERY =WSANO_RECOVERY;
525	WSANO_DATA =(WSABASEERR+1004);
526	NO_DATA =WSANO_DATA;
527	WSANO_ADDRESS =WSANO_DATA;
528	NO_ADDRESS =WSANO_ADDRESS;
529
530
531	Function SocketErrorMsg(ErrorCode:Word):String;
532	Begin
533	Case ErrorCode Of
534	WSAEINTR:Result:='Blocking call canceled';
535	WSAEFAULT:Result:='Parameter fault';
536	WSAEINVAL:Result:='No listen call for accept';
537	WSAEMFILE:Result:='Queue empty for accept';
538	WSAEWOULDBLOCK:Result:='Call would block';
539	WSAEINPROGRESS:Result:='Blocking call in progress';
540	WSAENOTSOCK:Result:='Invalid socket handle';
541	WSAEDESTADDRREQ:Result:='Destination address required';
542	WSAEMSGSIZE:Result:='Datagram too large';
543	WSAENOPROTOOPT:Result:='Option not supported';
544	WSAEOPNOTSUPP:Result:='Invalid socket handle type';
545	WSAEAFNOSUPPORT:Result:='Address family not supported';
546	WSAEADDRINUSE:Result:='Address is in use';
547	WSAEADDRNOTAVAIL:Result:='Address not available';
548	WSAENETDOWN:Result:='Network subsystem failure';
549	WSAENETUNREACH:Result:='Network unreachable';
550	WSAENETRESET:Result:='Connection timed out';
551	WSAECONNABORTED:Result:='Connection aborted due to timeout or failure';
552	WSAECONNRESET:Result:='Connection reset by remote host';
553	WSAENOBUFS:Result:='No more buffer space';
554	WSAEISCONN:Result:='Socket already connected';
555	WSAENOTCONN:Result:='Socket not connected';
556	WSAESHUTDOWN:Result:='Socket has been shutdown';
557	WSAETIMEDOUT:Result:='TimeOut';
558	WSAECONNREFUSED:Result:='Connection rejected';
559	WSAENAMETOOLONG:Result:='Name too long';
560	WSAEHOSTDOWN:Result:='Host down';
561	WSAEHOSTUNREACH:Result:='Host unreachable';
562	WSASYSNOTREADY:Result:='System not ready';
563	WSAVERNOTSUPPORTED:Result:='Version not supported';
564	WSANOTINITIALISED:Result:='WinSock not initialized';
565	WSAHOST_NOT_FOUND:Result:='Host not found';
566	WSATRY_AGAIN:Result:='Try again';
567	WSANO_RECOVERY:Result:='No recovery';
568	WSANO_DATA:Result:='No data';
569	Else Result:='Unkown error';
570	End;
571	Result:=' ('+Result+'.)';
572	End;
573
574
575
576	{
577	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
578	º º
579	º Speed-Pascal/2 Version 2.0 º
580	º º
581	º Speed-Pascal Component Classes (SPCC) º
582	º º
583	º This section: TCustomWinSocket Class Implementation º
584	º º
585	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
586	º º
587	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
588	}
589
590	Type
591	TCMSocketMessage=Record
592	Msg: LongWord;
593	ReceiverClass: TObject;
594	Receiver: Longword;
595	Handled: LONGBOOL; {True If the message was handled}
596	Socket: TSocket;
597	SelectEvent: Word;
598	SelectError: Word;
599	Result: Longint;
600	End;
601
602	TSocketNotifyControl=Class(TControl)
603	Private
604	FSocket:TCustomWinSocket;
605	Procedure CreateWnd;Override;
606	Protected
607	Procedure SetupComponent;Override;
608	Procedure CMSocketMessage(Var Message: TCMSocketMessage); message CM_SOCKETMESSAGE;
609	Procedure CMDeferFree(Var Message:TMessage); message CM_DEFERFREE;
610	End;
611
612
613	Procedure TSocketNotifyControl.CreateWnd; //dummy
614	Begin
615	Inherited CreateWnd;
616	End;
617
618	Procedure TSocketNotifyControl.SetupComponent;
619	Begin
620	Inherited SetupComponent;
621	Include (ComponentState, csDetail);
622	End;
623
624	Procedure TSocketNotifyControl.CMSocketMessage(Var Message: TCMSocketMessage);
625	Var
626	ErrorEvent: TErrorEvent;
627	Begin
628	Case Message.SelectEvent of
629	FD_READ:
630	Begin
631	Message.Handled:=True;
632	If Message.SelectError=0 Then
633	Begin
634	FSocket.Read(Message.Socket);
635	exit;
636	End
637	Else ErrorEvent:=eeReceive;
638	End;
639	FD_WRITE:
640	Begin
641	Message.Handled:=True;
642	If Message.SelectError=0 Then
643	Begin
644	FSocket.Write(Message.Socket);
645	exit;
646	End
647	Else ErrorEvent:=eeSend;
648	End;
649	FD_ACCEPT:
650	Begin
651	Message.Handled:=True;
652	If Message.SelectError=0 Then
653	Begin
654	FSocket.Accept(Message.Socket);
655	exit;
656	End
657	Else ErrorEvent:=eeAccept;
658	End;
659	FD_CLOSE:
660	Begin
661	Message.Handled:=True;
662	If Message.SelectError=0 Then
663	Begin
664	FSocket.Disconnect(Message.Socket);
665	exit;
666	End
667	Else ErrorEvent:=eeDisconnect;
668	End;
669	FD_CONNECT:
670	Begin
671	Message.Handled:=True;
672	If Message.SelectError=0 Then
673	Begin
674	FSocket.Connect(Message.Socket);
675	exit;
676	End
677	Else ErrorEvent:=eeConnect;
678	End;
679	Else ErrorEvent :=eeGeneral;
680	End; //case
681	FSocket.Error(FSocket,ErrorEvent,Message.SelectError);
682	If Message.SelectError<>0 Then
683	raise ESocketError.Create('Async socket error #'+tostr(Message.SelectError)+
684	SocketErrorMsg(Message.SelectError));
685	End;
686
687
688	Procedure TSocketNotifyControl.CMDeferFree(Var Message:TMessage);
689	Begin
690	If FSocket<>Nil Then FSocket.Destroy;
691	FSocket:=Nil;
692	Message.Handled:=True;
693	End;
694
695	Const WinSockHandle:LongWord=0;
696
697	Const
698	WSADESCRIPTION_LEN =256;
699	WSASYS_STATUS_LEN =128;
700
701	Type
702	WSAData=Record
703	wVersion:Word;
704	wHighVersion:Word;
705	szDescription: array[0..WSADESCRIPTION_LEN] of Char;
706	szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
707	iMaxSockets:Word;
708	iMaxUdpDg:Word;
709	lpVendorInfo:PChar;
710	End;
711	PWSADATA=^WSAData;
712
713	Type TWinSockProcs=Record
714	WSAStartup:Function(wVersionRequired:Word;Var aWSAData:WSAData):LongInt; CDecl;
715	WSACleanup:Function:LongInt; CDecl;
716	WSAGetLastError:Function:LongInt; CDecl;
717	getsockname:Function(s:TSOCKET;Var name;Var namelen:LongInt):LongInt; CDecl;
718	getpeername:Function(s:TSOCKET;Var name;Var nameLen:LongInt):LongInt; CDecl;
719	gethostname:Function(Const name:CString;namelen:LongInt):LongInt; CDecl;
720	inet_ntoa:Function(Var _in):PChar; CDecl;
721	gethostbyaddr:Function(Var addr;len,typ:LongInt):Pointer; CDecl;
722	ntohs:Function(netshort:Word):Word; CDecl;
723	gethostbyname:Function(Const name:CString):Pointer; CDecl;
724	getservbyname:Function(Const name,proto:CString):Pointer; CDecl;
725	inet_addr:Function(Const cp:CString):LongWord; CDecl;
726	htons:Function(hostshort:Word):Word; CDecl;
727	socket:Function(af,typ,protocol:LongInt):TSOCKET; CDecl;
728	accept:Function(s:TSOCKET;Var addr;Var addrlen:LongInt):TSOCKET; CDecl;
729	bind:Function(s:TSOCKET;Const addr;namelen:LongInt):LongInt; CDecl;
730	WSAAsyncSelect:Function(s:TSOCKET;ahWnd:LongWord;wMsg:LongWord;lEvent:LongInt):LongWord; CDecl;
731	listen:Function(s:TSOCKET;backlog:LongInt):LongInt; CDecl;
732	ioctlsocket:Function(s:TSOCKET;cmd:LongInt;Var argp:LongWord):LongInt; CDecl;
733	connect:Function(s:TSOCKET;Const name;namelen:LongInt):LongInt; CDecl;
734	closesocket:Function(s:TSOCKET):LongInt; CDecl;
735	send:Function(s:TSOCKET;Const Buf;len,flags:LongInt):LongInt; CDecl;
736	recv:Function(s:TSOCKET;Var Buf;len,flags:LongInt):LongInt; CDecl;
737	select:Function(nfds:LongInt;Var readfds,writefds,exceptfds;
738	Const timeout):LongInt; CDecl;
739	End;
740
741	Var WinSockProcs:TWinSockProcs;
742
743	Function InitWinSock:BOOLEAN;
744	Var c:Cstring;
745	ok:BOOLEAN;
746
747	Function GetProcAddr(Const ProcName:String):Pointer;
748	Var S:cstring;
749	Begin
750	S:=ProcName;
751	{$IFDEF OS2}
752	If DosQueryProcAddr(WinSockHandle,0,S,Result)<>0 Then Raise Exception.Create(ProcName);
753	{$ENDIF}
754	{$IFDEF Win95}
755	Result:=GetProcAddress(WinSockHandle,S);
756	If Result=Nil Then Raise Exception.Create(ProcName);
757	{$ENDIF}
758	End;
759
760	Begin
761	result:=WinSockHandle<>0;
762	If result Then exit;
763
764	{$IFDEF OS2}
765	If DosLoadModule(c,255,'PMWSOCK',WinSockHandle)<>0 Then
766	Begin
767	WinSockHandle:=0;
768	ErrorBox2('PMWSOCK.DLL not found. Sockets not available');
769	exit;
770	End;
771	{$ENDIF}
772	{$IFDEF WIN32}
773	WinSockHandle:=LoadLibrary('wsock32.dll');
774	If WinSockHandle=0 Then
775	Begin
776	WinSockHandle:=0;
777	ErrorBox2('WSOCK32.DLL not found. Sockets not available');
778	exit;
779	End;
780	{$ENDIF}
781
782	ok:=TRUE;
783	With WinSockProcs Do
784	Begin
785	Try
786	WSAStartup:=Pointer(GetProcAddr('WSAStartup'));
787	WSACleanup:=Pointer(GetProcAddr('WSACleanup'));
788	WSAGetLastError:=Pointer(GetProcAddr('WSAGetLastError'));
789	getpeername:=Pointer(GetProcAddr('getpeername'));
790	getsockname:=Pointer(GetProcAddr('getsockname'));
791	socket:=Pointer(GetProcAddr('socket'));
792	inet_ntoa:=Pointer(GetProcAddr('inet_ntoa'));
793	gethostname:=Pointer(GetProcAddr('gethostname'));
794	gethostbyaddr:=Pointer(GetProcAddr('gethostbyaddr'));
795	ntohs:=Pointer(GetProcAddr('ntohs'));
796	gethostbyname:=Pointer(GetProcAddr('gethostbyname'));
797	getservbyname:=Pointer(GetProcAddr('getservbyname'));
798	inet_addr:=Pointer(GetProcAddr('inet_addr'));
799	htons:=Pointer(GetProcAddr('htons'));
800	accept:=Pointer(GetProcAddr('accept'));
801	bind:=Pointer(GetProcAddr('bind'));
802	WSAAsyncSelect:=Pointer(GetProcAddr('WSAAsyncSelect'));
803	listen:=Pointer(GetProcAddr('listen'));
804	ioctlsocket:=Pointer(GetProcAddr('ioctlsocket'));
805	connect:=Pointer(GetProcAddr('connect'));
806	closesocket:=Pointer(GetProcAddr('closesocket'));
807	send:=Pointer(GetProcAddr('send'));
808	recv:=Pointer(GetProcAddr('recv'));
809	select:=Pointer(GetProcAddr('select'));
810	Except
811	ok:=FALSE;
812	{$IFDEF OS2}
813	DosFreeModule(WinSockHandle);
814	{$ENDIF}
815	{$IFDEF WIN32}
816	FreeLibrary(WinSockHandle);
817	{$ENDIF}
818	WinSockHandle:=0;
819	End;
820	End;
821
822	If Not ok Then raise ESocketError.Create('Windows sockets not available');
823
824	result:=ok;
825	End;
826
827
828	Var
829	aWSAData: WSAData;
830
831	Procedure CheckSockError(Socket:TCustomWinSocket;Const Op:String);
832	Var ErrorCode:Word;
833	Begin
834	If WinSockHandle<>0 Then ErrorCode:=WinSockProcs.WSAGetLastError
835	Else ErrorCode:=0;
836	If ErrorCode<>WSAEWOULDBLOCK Then
837	Begin
838	Socket.Error(Socket,eeReceive,ErrorCode);
839	Socket.Disconnect(Socket.FSocket);
840	If ErrorCode <> 0 Then
841	raise ESocketError.Create('Socket error #'+tostr(ErrorCode)+' in '+Op+
842	SocketErrorMsg(ErrorCode));
843	End;
844	End;
845
846	Procedure CheckSockResult(ResultCode: Integer; Const Op: String);
847	Var Ret:LongInt;
848	Begin
849	If ResultCode=0 Then exit; //no error
850	If WinSockHandle<>0 Then Ret:=WinSockProcs.WSAGetLastError
851	Else Ret:=0;
852	If Ret=WSAEWOULDBLOCK Then exit;
853	If SocketErrorProc<>Nil Then SocketErrorProc(Ret)
854	Else Raise ESocketError.Create('Windows socket error #'+tostr(Ret)+' in '+Op+
855	SocketErrorMsg(Ret));
856	End;
857
858	Const CallCount:LongInt=0;
859
860	Constructor TCustomWinSocket.Create(ASocket: TSocket);
861	Var ErrorCode:LongInt;
862	InsideDesigner:Boolean;
863	Begin
864	Inherited Create;
865	InitWinSock;
866
867	If CallCount=0 Then
868	Begin
869	If WinSockHandle<>0 Then
870	Begin
871	Asm
872	MOV AL,Classes.InsideDesigner
873	MOV InsideDesigner,AL
874	End;
875	If not InsideDesigner Then
876	Begin
877	ErrorCode := WinSockProcs.WSAStartup($0101, aWSAData);
878	If ErrorCode <> 0 Then
879	raise ESocketError.Create('Windows socket error #'+tostr(ErrorCode)+
880	SocketErrorMsg(ErrorCode));
881	End;
882	End;
883	End;
884	inc(CallCount);
885
886	FSocket := ASocket;
887	FASyncStyles := [asRead, asWrite, asConnect, asClose];
888	FAddr.sin_addr.s_addr := INADDR_ANY;
889	FAddr.sin_port := 0;
890	FAddr.sin_family := PF_INET;
891	FConnected:=FSocket>0;
892	End;
893
894	Destructor TCustomWinSocket.Destroy;
895	Var ErrorCode:LongInt;
896	InsideDesigner:Boolean;
897	Begin
898	FOnSocketEvent := nil;
899	If FSocket>0 Then Disconnect(FSocket);
900
901	If FSocketControl<>Nil Then
902	Begin
903	TSocketNotifyControl(FSocketControl).FSocket:=Nil;
904	FSocketControl.Destroy;
905	FHandle:=0;
906	End;
907	FSocketControl:=Nil;
908	If CallCount>0 Then dec(CallCount);
909
910	If CallCount=0 Then
911	Begin
912	If WinSockHandle<>0 Then
913	Begin
914	Asm
915	MOV AL,Classes.InsideDesigner
916	MOV InsideDesigner,AL
917	End;
918	If not InsideDesigner Then
919	Begin
920	ErrorCode := WinSockProcs.WSACleanup;
921	If ErrorCode <> 0 Then
922	raise ESocketError.Create('Windows socket error #'+tostr(ErrorCode)+
923	SocketErrorMsg(ErrorCode));
924	End;
925	{$IFDEF OS2}
926	DosFreeModule(WinSockHandle);
927	{$ENDIF}
928	{$IFDEF WIN32}
929	FreeLibrary(WinSockHandle);
930	{$ENDIF}
931	WinSockHandle:=0;
932	End;
933	End;
934
935	Inherited Destroy;
936	End;
937
938
939	Procedure TCustomWinSocket.Accept(Socket: TSocket);
940	Begin
941	End;
942
943	Procedure TCustomWinSocket.Close;
944	Begin
945	Disconnect(FSocket);
946	End;
947
948	Procedure TCustomWinSocket.Connect(Socket: TSocket);
949	Begin
950	End;
951
952	Function TCustomWinSocket.GetHandle:LongWord;
953	Begin
954	If FHandle = 0 Then
955	Begin
956	FSocketControl:=TSocketNotifyControl.Create(Nil);
957	TSocketNotifyControl(FSocketControl).FSocket:=Self;
958	TSocketNotifyControl(FSocketControl).CreateWnd;
959	FHandle:=FSocketControl.Handle;
960	End;
961	Result := FHandle;
962	End;
963
964	Function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
965	Var
966	Size:LongInt;
967	Begin
968	FillChar(Result, SizeOf(TSockAddrIn), 0);
969	If not FConnected Then Exit;
970
971	Size:=SizeOf(TSockAddrIn);
972	If WinSockHandle<>0 Then
973	If WinSockProcs.getpeername(FSocket,Result,Size)<>0 Then FillChar(Result,SizeOf(TSockAddrIn),0);
974	End;
975
976	Function TCustomWinSocket.GetLocalAddress: String;
977	Var
978	Size:LongInt;
979	SoIn:TSockAddrIn;
980	Begin
981	Result:='';
982	If FSocket<=0 Then Exit; //invalid socket
983
984	Size:=SizeOf(SoIn);
985	FillChar(SoIn,SizeOf(TSockAddrIn),0);
986	If WinSockHandle<>0 Then
987	If WinSockProcs.getsockname(FSocket,SoIn,Size)=0 Then
988	With SoIn.sin_Addr.S_un_b Do
989	Result:=tostr(s_b1)+'.'+tostr(s_b2)+'.'+tostr(s_b3)+'.'+tostr(s_b4);
990	End;
991
992	Function TCustomWinSocket.GetRemoteAddress:String;
993	Var
994	Size:LongInt;
995	SoIn:TSockAddrIn;
996	Begin
997	Result := '';
998	If not FConnected Then Exit;
999
1000	If WinSockHandle<>0 Then
1001	Begin
1002	Size:=SizeOf(SoIn);
1003	CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
1004	With SoIn.sin_Addr.S_un_b Do
1005	Result:=tostr(s_b1)+'.'+tostr(s_b2)+'.'+tostr(s_b3)+'.'+tostr(s_b4);
1006	End;
1007	End;
1008
1009	Function TCustomWinSocket.GetLocalHost:String;
1010	Var
1011	LocName:CString;
1012	Begin
1013	Result:='';
1014	If FSocket<=0 Then Exit; //invalid socket
1015
1016	If WinSockHandle<>0 Then
1017	If WinSockProcs.gethostname(LocName,255)=0 Then Result:=LocName;
1018	End;
1019
1020	Type
1021	PCharArray=^TCharArray;
1022	TCharArray=Array[0..0] Of PChar;
1023
1024	hostent=Record
1025	h_name:PChar; /* official name of host */
1026	h_aliases:PCharArray; /* alias list */
1027	h_addrtype:LongInt; /* host address type */
1028	h_length:LongInt; /* length of address */
1029	h_addr_list:PCharArray; /* list of addresses from name server */
1030	//h_addr h_addr_list[0] /* address, for backward compatiblity */
1031	End;
1032	phostent=^hostent;
1033
1034	Function TCustomWinSocket.GetRemoteHost:String;
1035	Var
1036	Size:LongInt;
1037	aHostEnt:PHostEnt;
1038	SoIn:TSockAddrIn;
1039	Begin
1040	Result:='';
1041	If not FConnected Then Exit;
1042
1043	If WinSockHandle<>0 Then
1044	Begin
1045	Size:=SizeOf(SoIn);
1046	CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
1047	aHostEnt:=WinSockProcs.gethostbyaddr(SoIn.sin_addr.s_addr,4,PF_INET);
1048	If aHostEnt<>Nil Then Result:=aHostEnt^.h_name^;
1049	End;
1050	End;
1051
1052	Function TCustomWinSocket.GetLocalPort:LongInt;
1053	Var
1054	Size:LongInt;
1055	SoIn:TSockAddrIn;
1056	Begin
1057	Result:=-1;
1058	If FSocket<=0 Then Exit; //invalid socket
1059
1060	If WinSockHandle<>0 Then
1061	Begin
1062	Size := SizeOf(SoIn);
1063	If WinSockProcs.getsockname(FSocket,SoIn,Size)=0 Then
1064	Result:=WinSockProcs.ntohs(SoIn.sin_port);
1065	End;
1066	End;
1067
1068	Function TCustomWinSocket.GetRemotePort: LongInt;
1069	Var
1070	Size:LongInt;
1071	SoIn:TSockAddrIn;
1072	Begin
1073	Result := 0;
1074	If not FConnected Then Exit;
1075
1076	If WinSockHandle<>0 Then
1077	Begin
1078	Size:=SizeOf(SoIn);
1079	CheckSockResult(WinSockProcs.getpeername(FSocket,SoIn,Size),'getpeername');
1080	Result:=WinSockProcs.ntohs(SoIn.sin_port);
1081	End;
1082	End;
1083
1084	Function TCustomWinSocket.LookupName(Const Name: String): TInAddr;
1085	Var
1086	HostEnt: PHostEnt;
1087	Begin
1088	FillChar(Result, SizeOf(TInAddr),0);
1089	If WinSockHandle<>0 Then HostEnt:=WinSockProcs.gethostbyname(Name)
1090	Else exit;
1091	If HostEnt=Nil Then exit;
1092
1093	Result.S_un_b.s_b1 := Byte(HostEnt^.h_addr_list^[0]^[0]);
1094	Result.S_un_b.s_b2 := Byte(HostEnt^.h_addr_list^[0]^[1]);
1095	Result.S_un_b.s_b3 := Byte(HostEnt^.h_addr_list^[0]^[2]);
1096	Result.S_un_b.s_b4 := Byte(HostEnt^.h_addr_list^[0]^[3]);
1097	End;
1098
1099	Type
1100	servent=Record
1101	s_name:PChar;
1102	s_aliases:PCharArray;
1103	s_port:LongInt;
1104	s_proto:PChar;
1105	End;
1106	pservent=^servent;
1107
1108	Function TCustomWinSocket.LookupService(Const Service: String): LongInt;
1109	Var
1110	aServEnt: PServEnt;
1111	Begin
1112	Result:=0;
1113	If WinSockHandle<>0 Then aServEnt:=WinSockProcs.getservbyname(Service, 'tcp')
1114	Else exit;
1115	If aServEnt=Nil Then exit;
1116	Result:=WinSockProcs.ntohs(aServEnt^.s_port)
1117	End;
1118
1119	Function TCustomWinSocket.InitSocket(Var Name,Address,Service:String;Port:Word;
1120	Client:Boolean):TSockAddrIn;
1121	Begin
1122	FillChar(Result,sizeof(Result),0);
1123	Result.sin_family := PF_INET;
1124	If Name<>'' Then Result.sin_addr:=LookupName(name)
1125	Else If Address<>'' Then
1126	Begin
1127	If WinSockHandle<>0 Then Result.sin_addr.s_addr:=WinSockProcs.inet_addr(Address)
1128	Else Raise ESocketError.Create('Sockets not available');
1129	End
1130	Else If not Client Then Result.sin_addr.s_addr:=INADDR_ANY
1131	Else Raise ESocketError.Create('No socket address');
1132
1133	If Service<>'' Then
1134	Begin
1135	If WinSockHandle<>0 Then Result.sin_port:=WinSockProcs.htons(LookupService(Service))
1136	Else Raise ESocketError.Create('Sockets not available');
1137	End
1138	Else
1139	Begin
1140	If WinSockHandle<>0 Then Result.sin_port:=WinSockProcs.htons(Port)
1141	Else Raise ESocketError.Create('Sockets not available');
1142	End;
1143	End;
1144
1145	Procedure TCustomWinSocket.Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
1146	Var
1147	SoIn: TSockAddrIn;
1148	Blocking:LongWord;
1149	Begin
1150	If FConnected Then Raise ESocketError.Create('Socket cannot listen on open');
1151	If FSocket>0 Then
1152	Begin
1153	If WinSockHandle<>0 Then CheckSockResult(WinSockProcs.closesocket(FSocket), 'closesocket');
1154	End;
1155	If WinSockHandle<>0 Then FSocket:=WinSockProcs.socket(PF_INET, SOCK_STREAM, IPPROTO_IP)
1156	Else FSocket:=INVALID_SOCKET;
1157	If FSocket<=0 Then Raise ESocketError.Create('Cannot create socket');
1158
1159	Try
1160	SoIn:=InitSocket(Name,Address,Service,Port,False);
1161	CheckSockResult(WinSockProcs.bind(FSocket, SoIn, SizeOf(TSockAddrIn)),'bind');
1162	If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
1163	Else
1164	Begin
1165	WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
1166	Blocking := 0;
1167	WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
1168	End;
1169
1170	Event(Self,seListen);
1171	If QueueSize>SOMAXCONN Then QueueSize:=SOMAXCONN;
1172	CheckSockResult(WinSockProcs.listen(FSocket, QueueSize), 'listen');
1173	FConnected := True;
1174	Except
1175	Disconnect(FSocket);
1176	Raise;
1177	End;
1178	End;
1179
1180	Procedure TCustomWinSocket.Open(Var Name,Address,Service:String;Port:Word);
1181	Var
1182	SoIn:TSockAddrIn;
1183	Blocking:LongWord;
1184	Begin
1185	If FConnected Then raise ESocketError.Create('Socket already open');
1186
1187	If WinSockHandle<>0 Then FSocket:=WinSockProcs.socket(PF_INET, SOCK_STREAM, IPPROTO_IP)
1188	Else FSocket:=INVALID_SOCKET;
1189	If FSocket<=0 Then Raise ESocketError.Create('Cannot create socket');
1190
1191	Try
1192	Event(Self, seLookUp);
1193	SoIn := InitSocket(Name, Address, Service, Port, True);
1194	If FAsyncStyles=[] Then
1195	Begin
1196	WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
1197	Blocking := 0;
1198	WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
1199	End
1200	Else WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles));
1201
1202	Event(Self,seConnecting);
1203
1204	CheckSockResult(WinSockProcs.connect(FSocket,SoIn, SizeOf(TSockAddrIn)),'connect');
1205	If not (asConnect In FAsyncStyles) Then
1206	Begin
1207	FConnected:=FSocket>0;
1208	Event(Self,seConnect);
1209	End;
1210	Except
1211	Disconnect(FSocket);
1212	Raise;
1213	End;
1214	End;
1215
1216	Procedure TCustomWinSocket.Read(Socket: TSocket);
1217	Begin
1218	If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
1219	Event(Self, seRead);
1220	End;
1221
1222	Procedure TCustomWinSocket.Write(Socket: TSocket);
1223	Var Stream:TStream;
1224	Begin
1225	If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
1226	Stream:=FSendStream;
1227	FSendStream:=Nil;
1228	If not SendStream(Stream) Then Event(Self, seWrite);
1229	End;
1230
1231
1232	Procedure TCustomWinSocket.Disconnect(Socket: TSocket);
1233	Begin
1234	If not FConnected Then exit;
1235
1236	If ((Socket<=0)Or(Socket<>FSocket)) Then exit;
1237
1238	Event(Self, seDisconnect);
1239	If WinSockHandle<>0 Then
1240	Begin
1241	WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
1242
1243	IF FSocket<0 Then
1244	Begin
1245	FSocket:=INVALID_SOCKET;
1246	FConnected:=False;
1247	exit;
1248	End;
1249	CheckSockResult(WinSockProcs.closesocket(FSocket), 'closesocket');
1250	End;
1251	FSocket:=INVALID_SOCKET;
1252	FConnected:=False;
1253	If FSendStream<>Nil Then
1254	Begin
1255	FSendStream.Destroy;
1256	FSendStream := nil;
1257	End;
1258
1259	Event(Self, seDisconnected);
1260	End;
1261
1262	Procedure TCustomWinSocket.Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent);
1263	Begin
1264	If FOnSocketEvent<>Nil Then FOnSocketEvent(Self,Socket,SocketEvent);
1265	End;
1266
1267	Procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
1268	Var ErrorCode:Word);
1269	Begin
1270	If FOnErrorEvent<>Nil Then FOnErrorEvent(Self,Socket,ErrorEvent,ErrorCode);
1271	End;
1272
1273	Procedure TCustomWinSocket.SendText(Const s: String);
1274	Begin
1275	SendBuf(S[1], Length(S));
1276	End;
1277
1278	Function TCustomWinSocket.SendStream(AStream: TStream): Boolean;
1279	Var
1280	BufferBytesLeft:LongInt;
1281	BufferBytesSent:LongInt;
1282	ErrorCode:Word;
1283	Buf:Array[0..4095] of Byte;
1284	StartPos:LongInt;
1285	Label ex;
1286	Begin
1287	Result := False;
1288	If WinSockHandle=0 Then exit;
1289
1290	If FSendStream = nil Then
1291	Begin
1292	FSendStream := AStream;
1293
1294	If FSendStream=Nil Then exit;
1295	If ((FSocket<=0)Or(not FConnected)) Then exit;
1296
1297	Repeat
1298	StartPos:=FSendStream.Position;
1299	BufferBytesLeft:=FSendStream.Read(Buf,SizeOf(Buf));
1300
1301	If BufferBytesLeft>0 Then
1302	Begin
1303	BufferBytesSent:=WinSockProcs.send(FSocket,Buf,BufferBytesLeft,0);
1304	If BufferBytesSent=SOCKET_ERROR Then
1305	Begin
1306	ErrorCode := WinSockProcs.WSAGetLastError;
1307	If ErrorCode <> WSAEWOULDBLOCK Then
1308	Begin
1309	Error(Self,eeSend, ErrorCode);
1310	Disconnect(FSocket);
1311	goto ex;
1312	End
1313	Else
1314	Begin
1315	FSendStream.Position:=StartPos;
1316	Result:=True;
1317	exit;
1318	End;
1319	End
1320	Else If BufferBytesLeft>BufferBytesSent Then FSendStream.Position:=StartPos+(BufferBytesLeft-BufferBytesSent)
1321	Else If FSendStream.Position=FSendStream.Size Then goto ex;
1322	End
1323	Else
1324	Begin
1325	ex:
1326	If FDropAfterSend Then Disconnect(FSocket);
1327	FDropAfterSend := False;
1328	FSendStream.Destroy;
1329	FSendStream := nil;
1330	Result:=True;
1331	exit;
1332	End;
1333	Until False;
1334	End;
1335	End;
1336
1337	Function TCustomWinSocket.SendStreamThenDrop(AStream: TStream): Boolean;
1338	Begin
1339	FDropAfterSend := True;
1340	Result := SendStream(AStream);
1341	If not Result Then FDropAfterSend:=False;
1342	End;
1343
1344	Function TCustomWinSocket.SendBuf(Var Buf;Count:LongInt):LongInt;
1345	Begin
1346	Result := 0;
1347	If not FConnected Then Exit;
1348	If WinSockHandle=0 Then exit;
1349
1350	Result:=WinSockProcs.send(FSocket, Buf, Count, 0);
1351	If Result=SOCKET_ERROR Then CheckSockError(Self,'send');
1352	End;
1353
1354	Procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
1355	Var Blocking:LongWord;
1356	Begin
1357	If Value <> FASyncStyles Then
1358	Begin
1359	FASyncStyles := Value;
1360	If WinSockHandle=0 Then exit;
1361	If FSocket>0 Then
1362	Begin
1363	If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
1364	Else
1365	Begin
1366	WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
1367	Blocking := 0;
1368	WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
1369	End;
1370	End;
1371	End;
1372	End;
1373
1374	Function TCustomWinSocket.ReceiveBuf(Var Buf; Count: LongInt): LongInt;
1375	Begin
1376	Result := 0;
1377	If not FConnected Then Exit;
1378	If WinSockHandle=0 Then exit;
1379
1380	If ((Count=-1)And(FConnected)) Then WinSockProcs.ioctlsocket(FSocket,FIONREAD,LongWord(Result))
1381	Else
1382	Begin
1383	Result:=WinSockProcs.recv(FSocket, Buf, Count, 0);
1384	If Result = SOCKET_ERROR Then CheckSockError(Self,'recv');
1385	End;
1386	End;
1387
1388	Function TCustomWinSocket.ReceiveLength: LongInt;
1389	Var p:Pointer;
1390	Begin
1391	p:=Nil;
1392	Result := ReceiveBuf(p^, -1);
1393	End;
1394
1395	Function TCustomWinSocket.ReceiveText: String;
1396	Var p:Pointer;
1397	Begin
1398	p:=Nil;
1399	SetLength(Result, ReceiveBuf(p^, -1));
1400	ReceiveBuf(Result[1], Length(Result));
1401	End;
1402
1403	{
1404	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1405	º º
1406	º Speed-Pascal/2 Version 2.0 º
1407	º º
1408	º Speed-Pascal Component Classes (SPCC) º
1409	º º
1410	º This section: TClientWinSocket Class Implementation º
1411	º º
1412	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1413	º º
1414	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1415	}
1416
1417	Procedure TClientWinSocket.Connect(Socket: TSocket);
1418	Begin
1419	FConnected:=True;
1420	Event(Self, seConnect);
1421	End;
1422
1423	Procedure TClientWinSocket.SetClientType(Value: TClientType);
1424	Begin
1425	If Value=FClientType Then exit;
1426
1427	If FConnected Then Raise ESocketError.Create('Cannot change socket while active');
1428
1429	FClientType := Value;
1430	If FClientType=ctBlocking Then ASyncStyles:=[]
1431	Else ASyncStyles:=[asRead,asWrite,asConnect,asClose];
1432	End;
1433
1434	{
1435	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1436	º º
1437	º Speed-Pascal/2 Version 2.0 º
1438	º º
1439	º Speed-Pascal Component Classes (SPCC) º
1440	º º
1441	º This section: TServerClientWinSocket Class Implementation º
1442	º º
1443	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1444	º º
1445	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1446	}
1447
1448	Constructor TServerClientWinSocket.Create(Socket: TSocket;ServerWinSocket:TServerWinSocket);
1449	Var Blocking:LongWord;
1450	Begin
1451	FServerWinSocket := ServerWinSocket;
1452	If FServerWinSocket<>Nil Then
1453	Begin
1454	If FServerWinSocket.FConnections.IndexOf(Self)<0 Then
1455	FServerWinSocket.FConnections.Add(Self);
1456	If FServerWinSocket.AsyncStyles <> [] Then
1457	OnSocketEvent := FServerWinSocket.ClientEvent;
1458	End;
1459
1460	Inherited Create(Socket);
1461
1462	If FServerWinSocket.ASyncStyles <> [] Then
1463	If WinSockHandle<>0 Then
1464	Begin
1465	If FAsyncStyles<>[] Then WinSockProcs.WSAAsyncSelect(FSocket,Handle,CM_SOCKETMESSAGE,Longint(FAsyncStyles))
1466	Else
1467	Begin
1468	WinSockProcs.WSAAsyncSelect(FSocket,0,WM_NULL,0);
1469	Blocking := 0;
1470	WinSockProcs.ioctlsocket(FSocket,FIONBIO,Blocking);
1471	End;
1472	End;
1473	If FConnected Then Event(Self, seConnect);
1474	End;
1475
1476	Destructor TServerClientWinSocket.Destroy;
1477	Begin
1478	If FServerWinSocket<>Nil Then
1479	Begin
1480	If FServerWinSocket.FConnections.IndexOf(Self)>=0 Then
1481	FServerWinSocket.FConnections.Remove(Self);
1482	End;
1483	Inherited Destroy;
1484	End;
1485
1486	{
1487	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1488	º º
1489	º Speed-Pascal/2 Version 2.0 º
1490	º º
1491	º Speed-Pascal Component Classes (SPCC) º
1492	º º
1493	º This section: TServerWinSocket Class Implementation º
1494	º º
1495	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1496	º º
1497	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1498	}
1499
1500	Constructor TServerWinSocket.Create(ASocket: TSocket);
1501	Begin
1502	FConnections.Create;
1503	FActiveThreads.Create;
1504	Inherited Create(ASocket);
1505	FAsyncStyles:=[asAccept];
1506	End;
1507
1508	Destructor TServerWinSocket.Destroy;
1509	Begin
1510	Inherited Destroy;
1511	FConnections.Destroy;
1512	FActiveThreads.Destroy;
1513	End;
1514
1515	Procedure TServerWinSocket.ClientEvent(Sender:TObject;Socket:TCustomWinSocket;
1516	SocketEvent:TSocketEvent);
1517	Begin
1518	Case SocketEvent of
1519	seConnect:ClientConnect(Socket);
1520	seDisconnect:ClientDisconnect(Socket);
1521	seDisconnected:ClientDisconnected(Socket);
1522	seRead:ClientRead(Socket);
1523	seWrite:ClientWrite(Socket);
1524	End;
1525	End;
1526
1527	Procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
1528	ErrorEvent: TErrorEvent;Var ErrorCode:Word);
1529	Begin
1530	ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
1531	End;
1532
1533	Function TServerWinSocket.GetConnections(Index:LongInt):TCustomWinSocket;
1534	Begin
1535	Result:=FConnections[Index];
1536	End;
1537
1538	Function TServerWinSocket.GetActiveConnections:LongInt;
1539	Begin
1540	Result:=FConnections.Count;
1541	End;
1542
1543	Function TServerWinSocket.GetActiveThreads: LongInt;
1544	Var
1545	t:LongInt;
1546	Begin
1547	Result := 0;
1548	For t:=0 To FActiveThreads.Count-1 Do
1549	If TServerClientThread(FActiveThreads[t]).ClientSocket<>Nil Then
1550	Inc(Result);
1551	End;
1552
1553	Function TServerWinSocket.GetIdleThreads: LongInt;
1554	Var
1555	t:LongInt;
1556	Begin
1557	Result := 0;
1558	For t:=0 To FActiveThreads.Count-1 Do
1559	If TServerClientThread(FActiveThreads[t]).ClientSocket=Nil Then
1560	Inc(Result);
1561	End;
1562
1563	Procedure TServerWinSocket.Accept(Socket: TSocket);
1564	Var
1565	ClientSocket: TServerClientWinSocket;
1566	ClientWinSocket: TSocket;
1567	Addr: TSockAddrIn;
1568	Len: LongInt;
1569	Begin
1570	If WinSockHandle=0 Then exit;
1571	Len := SizeOf(TSockAddrIn);
1572	ClientWinSocket := WinSockProcs.accept(Socket, Addr, Len);
1573	If ClientWinSocket>0 Then
1574	Begin
1575	ClientSocket:=GetClientSocket(ClientWinSocket);
1576	If FOnSocketEvent<>Nil Then FOnSocketEvent(Self,ClientSocket,seAccept);
1577	If FServerType=stThreadBlocking Then
1578	Begin
1579	ClientSocket.ASyncStyles := [];
1580	GetServerThread(ClientSocket);
1581	End;
1582	End;
1583	End;
1584
1585	Procedure TServerWinSocket.Listen(Var Name, Address, Service: String; Port: Word;
1586	QueueSize: LongInt);
1587	Begin
1588	Inherited Listen(Name, Address, Service, Port, QueueSize);
1589	If FConnected Then If ServerType = stThreadBlocking Then
1590	FServerAcceptThread := TServerAcceptThread.Create(False, Self);
1591	End;
1592
1593	Procedure TServerWinSocket.Disconnect(Socket: TSocket);
1594	Var
1595	SaveCacheSize: LongInt;
1596	sc:TServerClientThread;
1597	cw:TCustomWinSocket;
1598	Begin
1599	If not FConnected Then exit;
1600
1601	SaveCacheSize := ThreadCacheSize;
1602
1603	Try
1604	ThreadCacheSize := 0;
1605
1606	While FActiveThreads.Count>0 Do
1607	Begin
1608	sc:=TServerClientThread(FActiveThreads.Last);
1609	sc.FreeOnTerminate := False;
1610	sc.Terminate;
1611	sc.FEvent.SetEvent;
1612	If sc.ClientSocket<>Nil Then If sc.ClientSocket.Connected Then sc.ClientSocket.Close;
1613	sc.WaitFor;
1614	sc.Destroy;
1615	End;
1616
1617	While FConnections.Count>0 Do
1618	Begin
1619	cw:=TCustomWinSocket(FConnections.Last);
1620	cw.Destroy;
1621	End;
1622
1623	If FServerAcceptThread <> nil Then FServerAcceptThread.Terminate;
1624	Inherited Disconnect(Socket);
1625	If FServerAcceptThread<>Nil Then
1626	Begin
1627	FServerAcceptThread.Destroy;
1628	FServerAcceptThread:=Nil;
1629	End;
1630	Finally
1631	ThreadCacheSize := SaveCacheSize;
1632	End;
1633	End;
1634
1635	Function TServerWinSocket.DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1636	Begin
1637	Result := TServerClientThread.Create(False, ClientSocket);
1638	End;
1639
1640	Procedure TServerWinSocket.ThreadStart(AThread: TServerClientThread);
1641	Begin
1642	If FOnThreadStart<>Nil Then FOnThreadStart(Self,AThread);
1643	End;
1644
1645	Procedure TServerWinSocket.ThreadEnd(AThread: TServerClientThread);
1646	Begin
1647	If FOnThreadEnd<>Nil Then FOnThreadEnd(Self,AThread);
1648	End;
1649
1650	Procedure TServerWinSocket.SetServerType(Value: TServerType);
1651	Begin
1652	If Value=FServerType Then exit;
1653	If FConnected Then Raise ESocketError.Create('Cannot change socket while active');
1654
1655	FServerType := Value;
1656	If FServerType=stThreadBlocking Then ASyncStyles := []
1657	Else ASyncStyles := [asAccept];
1658	End;
1659
1660	Procedure TServerWinSocket.SetThreadCacheSize(Value: LongInt);
1661	Var
1662	Start,t:LongInt;
1663	sc:TServerClientThread;
1664	Begin
1665	If Value=FThreadCacheSize Then exit;
1666
1667	If Value<FThreadCacheSize Then Start:=Value
1668	Else Start := FThreadCacheSize;
1669
1670	FThreadCacheSize := Value;
1671
1672	For t:=0 To FActiveThreads.Count-1 Do
1673	Begin
1674	sc:=TServerClientThread(FActiveThreads[t]);
1675	sc.KeepInCache:=t<Start;
1676	End;
1677	End;
1678
1679	Function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
1680	Begin
1681	Result:=Nil;
1682	If FOnGetSocket<>Nil Then FOnGetSocket(Self,Socket,Result);
1683	If Result=nil Then Result := TServerClientWinSocket.Create(Socket,Self);
1684	End;
1685
1686	Function TServerWinSocket.GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1687	Var
1688	t:LongInt;
1689	Begin
1690	Result := Nil;
1691
1692	For t:=0 To FActiveThreads.Count-1 Do
1693	Begin
1694	Result:=TServerClientThread(FActiveThreads[t]);
1695	If Result.ClientSocket=Nil Then
1696	Begin
1697	Result.ReActivate(ClientSocket);
1698	break;
1699	End;
1700	End;
1701
1702	If FOnGetThread<>Nil Then FOnGetThread(Self,ClientSocket,Result);
1703	If Result=Nil Then Result:=DoCreateThread(ClientSocket);
1704	End;
1705
1706	Function TServerWinSocket.GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1707	Var
1708	t:LongInt;
1709	Begin
1710	For t:=0 To FActiveThreads.Count-1 Do
1711	Begin
1712	Result:=TServerClientThread(FActiveThreads[t]);
1713	If Result.ClientSocket=ClientSocket Then exit;
1714	End;
1715	Result:=Nil;
1716	End;
1717
1718	Procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
1719	Begin
1720	If FOnClientRead<>Nil Then FOnClientRead(Self,Socket);
1721	End;
1722
1723	Procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
1724	Begin
1725	If FOnClientWrite<>Nil Then FOnClientWrite(Self,Socket);
1726	End;
1727
1728	Procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
1729	Begin
1730	If FOnClientConnect<>Nil Then FOnClientConnect(Self,Socket);
1731	End;
1732
1733	Procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
1734	Begin
1735	If FOnClientDisconnect<>Nil Then FOnClientDisconnect(Self,Socket);
1736	End;
1737
1738	Procedure TServerWinSocket.ClientDisconnected(Socket: TCustomWinSocket);
1739	Begin
1740	If FOnClientDisconnected<>Nil Then FOnClientDisconnected(Self,Socket);
1741	If ServerType=stNonBlocking Then
1742	If Socket.FHandle<>0 Then PostMsg(Socket.FHandle,CM_DEFERFREE,0,0);
1743	End;
1744
1745
1746	Procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
1747	ErrorEvent: TErrorEvent; Var ErrorCode:Word);
1748	Begin
1749	If FOnClientError<>Nil Then FOnClientError(Self,Socket,ErrorEvent,ErrorCode);
1750	End;
1751
1752	{
1753	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1754	º º
1755	º Speed-Pascal/2 Version 2.0 º
1756	º º
1757	º Speed-Pascal Component Classes (SPCC) º
1758	º º
1759	º This section: TServerAcceptThread Class Implementation º
1760	º º
1761	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1762	º º
1763	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1764	}
1765
1766
1767	Constructor TServerAcceptThread.Create(CreateSuspended: Boolean;ASocket: TServerWinSocket);
1768	Begin
1769	FServerSocket := ASocket;
1770	Inherited Create(CreateSuspended);
1771	End;
1772
1773	Procedure TServerAcceptThread.Execute;
1774	Begin
1775	While Not Terminated Do FServerSocket.Accept(FServerSocket.SocketHandle);
1776	End;
1777
1778	{
1779	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1780	º º
1781	º Speed-Pascal/2 Version 2.0 º
1782	º º
1783	º Speed-Pascal Component Classes (SPCC) º
1784	º º
1785	º This section: TServerClientThread Class Implementation º
1786	º º
1787	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1788	º º
1789	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1790	}
1791
1792
1793	Constructor TServerClientThread.Create(CreateSuspended:Boolean;
1794	ASocket:TServerClientWinSocket);
1795	Begin
1796	FreeOnTerminate := True;
1797	FEvent:=TSimpleEvent.Create;
1798	Inherited Create(True);
1799	Priority:=tpHigher;
1800	ReActivate(ASocket);
1801	If not CreateSuspended Then Resume;
1802	End;
1803
1804	Destructor TServerClientThread.Destroy;
1805	Begin
1806	FClientSocket.Destroy;
1807	FEvent.Destroy;
1808	Inherited Destroy;
1809	End;
1810
1811	Procedure TServerClientThread.Execute;
1812	Begin
1813	FServerSocket.ThreadStart(Self);
1814	Try
1815	Try
1816	While True Do
1817	Begin
1818	If StartConnect Then ClientExecute;
1819	If EndConnect Then Break;
1820	End;
1821	Except
1822	On e:Exception Do
1823	Begin
1824	HandleException(e);
1825	KeepInCache := False;
1826	End;
1827	End;
1828	Finally
1829	FServerSocket.ThreadEnd(Self);
1830	End;
1831	End;
1832
1833	Function TServerClientThread.StartConnect:Boolean;
1834	Begin
1835	If FEvent.WaitFor(INFINITE) = wrSignaled Then FEvent.ResetEvent;
1836	Result := not Terminated;
1837	End;
1838
1839	Function TServerClientThread.EndConnect: Boolean;
1840	Begin
1841	FClientSocket.Destroy;
1842	FClientSocket := nil;
1843	Result:=Terminated or Not KeepInCache;
1844	End;
1845
1846	Procedure TServerClientThread.ReActivate(ASocket: TServerClientWinSocket);
1847	Begin
1848	FClientSocket := ASocket;
1849	If FClientSocket<>Nil Then
1850	Begin
1851	FServerSocket := FClientSocket.ServerWinSocket;
1852	If FServerSocket.FActiveThreads.IndexOf(Self)<0 Then
1853	Begin
1854	FServerSocket.FActiveThreads.Add(Self);
1855	If FServerSocket.FActiveThreads.Count<=FServerSocket.FThreadCacheSize Then
1856	KeepInCache:=True;
1857	End;
1858	FClientSocket.OnErrorEvent:=HandleError;
1859	FClientSocket.OnSocketEvent:=HandleEvent;
1860	FEvent.SetEvent;
1861	End;
1862	End;
1863
1864	Procedure TServerClientThread.DoHandleException;
1865	Begin
1866	{$IFDEF OS2}
1867	WinSetCapture(HWND_DESKTOP,0);
1868	{$ENDIF}
1869	If FException Is Exception Then Application.ShowException(FException)
1870	Else Raise FException;
1871	End;
1872
1873	Procedure TServerClientThread.HandleException(e:Exception);
1874	Begin
1875	FException := e;
1876	Try
1877	Synchronize(DoHandleException);
1878	Finally
1879	FException := nil;
1880	End;
1881	End;
1882
1883
1884	Procedure TServerClientThread.DoRead;
1885	Begin
1886	ClientSocket.ServerWinSocket.Event(ClientSocket,seRead);
1887	End;
1888
1889	Procedure TServerClientThread.DoWrite;
1890	Begin
1891	FServerSocket.Event(ClientSocket, seWrite);
1892	End;
1893
1894	Procedure TServerClientThread.DoTerminate;
1895	Begin
1896	If FServerSocket<>Nil Then
1897	Begin
1898	If FServerSocket.FActiveThreads.IndexOf(Self)>=0 Then
1899	FServerSocket.FActiveThreads.Remove(Self);
1900	End;
1901	End;
1902
1903	Procedure TServerClientThread.HandleEvent(Sender:TObject;Socket:TCustomWinSocket;
1904	SocketEvent:TSocketEvent);
1905	Begin
1906	Event(SocketEvent);
1907	End;
1908
1909	Procedure TServerClientThread.Event(SocketEvent: TSocketEvent);
1910	Begin
1911	FServerSocket.ClientEvent(Self,ClientSocket,SocketEvent);
1912	End;
1913
1914	Procedure TServerClientThread.HandleError(Sender:TObject;Socket:TCustomWinSocket;
1915	ErrorEvent:TErrorEvent;Var ErrorCode:Word);
1916	Begin
1917	Error(ErrorEvent, ErrorCode);
1918	End;
1919
1920
1921	Procedure TServerClientThread.Error(ErrorEvent:TErrorEvent;Var ErrorCode:Word);
1922	Begin
1923	FServerSocket.ClientError(Self, ClientSocket, ErrorEvent, ErrorCode);
1924	End;
1925
1926	Const FD_SETSIZE = 64;
1927
1928	Type TFDSET=Record
1929	fd_count:Word;
1930	fd_array:Array[0..FD_SETSIZE-1] Of TSOCKET;
1931	End;
1932
1933	timeval=Record
1934	tv_sec:LongInt;
1935	tv_usec:LongInt;
1936	End;
1937
1938	Procedure FD_ZERO(Var aset:TFDSET);
1939	Begin
1940	aset.fd_count:=0;
1941	End;
1942
1943	Procedure FD_SET(Socket:TSocket;Var FDSet:TFDSet);
1944	Begin
1945	If FDSet.fd_count < FD_SETSIZE Then
1946	Begin
1947	FDSet.fd_array[FDSet.fd_count]:=Socket;
1948	Inc(FDSet.fd_count);
1949	End;
1950	End;
1951
1952	Procedure TServerClientThread.ClientExecute;
1953	Var
1954	FDSet: TFDSet;
1955	aTimeVal: TimeVal;
1956	Begin
1957	If WinSockHandle=0 Then exit;
1958	While not Terminated And ClientSocket.Connected Do
1959	Begin
1960	FD_ZERO(FDSet);
1961	FD_SET(ClientSocket.SocketHandle, FDSet);
1962	aTimeVal.tv_sec := 0;
1963	aTimeVal.tv_usec := 500;
1964	If (WinSockProcs.select(0, FDSet, nil, nil, aTimeVal) > 0) and not Terminated Then
1965	If ClientSocket.ReceiveBuf(FDSet, -1) = 0 Then Break
1966	Else Synchronize(DoRead);
1967	If WinSockProcs.select(0, nil, FDSet, nil, aTimeVal) > 0 Then
1968	If not Terminated Then Synchronize(DoWrite);
1969	End; //While
1970	End;
1971
1972	{
1973	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1974	º º
1975	º Speed-Pascal/2 Version 2.0 º
1976	º º
1977	º Speed-Pascal Component Classes (SPCC) º
1978	º º
1979	º This section: TCustomSocket Class Implementation º
1980	º º
1981	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1982	º º
1983	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1984	}
1985
1986	Procedure TCustomSocket.Open;
1987	Begin
1988	Active := True;
1989	End;
1990
1991	Procedure TCustomSocket.Close;
1992	Begin
1993	Active := False;
1994	End;
1995
1996	Procedure TCustomSocket.SetActive(Value: Boolean);
1997	Var InsideDesigner:Boolean;
1998	Begin
1999	If Value<>FActive Then
2000	Begin
2001	FActive := Value;
2002	Asm
2003	MOV AL,Classes.InsideDesigner
2004	MOV InsideDesigner,AL
2005	End;
2006	If ((not (csLoading In ComponentState))And(not InsideDesigner)) Then
2007	DoActivate(Value);
2008	End;
2009	End;
2010
2011	Procedure TCustomSocket.DoEvent(Sender:TObject;Socket:TCustomWinSocket;
2012	SocketEvent:TSocketEvent);
2013	Begin
2014	Event(Socket,SocketEvent);
2015	End;
2016
2017	Procedure TCustomSocket.DoError(Sender:TObject;Socket:TCustomWinSocket;
2018	ErrorEvent:TErrorEvent;Var ErrorCode:Word);
2019	Begin
2020	Error(Socket,ErrorEvent,ErrorCode);
2021	End;
2022
2023	Procedure TCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
2024	Begin
2025	Case SocketEvent Of
2026	seRead:If FOnRead<>Nil Then FOnRead(Self, Socket);
2027	seWrite:If FOnWrite<>Nil Then FOnWrite(Self, Socket);
2028	seLookup: If Assigned(FOnLookup) Then FOnLookup(Self, Socket);
2029	seAccept:If FOnAccept<>Nil Then FOnAccept(Self,Socket);
2030	seConnecting:If FOnConnecting<>Nil Then FOnConnecting(Self,Socket);
2031	seConnect:
2032	Begin
2033	FActive := True;
2034	If FOnConnect<>Nil Then FOnConnect(Self,Socket);
2035	End;
2036	seDisconnect:
2037	Begin
2038	FActive := False;
2039	If FOnDisconnect<>Nil Then FOnDisconnect(Self,Socket);
2040	End;
2041	seListen:
2042	Begin
2043	FActive := True;
2044	If FOnListen<>Nil Then FOnListen(Self,Socket);
2045	End;
2046	End; //case
2047	End;
2048
2049	Procedure TCustomSocket.Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;
2050	Var ErrorCode:Word);
2051	Begin
2052	If FOnError<>Nil Then FOnError(Self,Socket,ErrorEvent,ErrorCode);
2053	End;
2054
2055	Procedure TCustomSocket.Loaded;
2056	Var InsideDesigner:Boolean;
2057	Begin
2058	Inherited Loaded;
2059	Asm
2060	MOV AL,Classes.InsideDesigner
2061	MOV InsideDesigner,AL
2062	End;
2063	If not InsideDesigner Then DoActivate(FActive);
2064	End;
2065
2066	Procedure TCustomSocket.SetService(Value: String);
2067	Begin
2068	If CompareText(Value,FService)=0 Then exit;
2069
2070	If not (csLoading in ComponentState) and FActive Then
2071	raise ESocketError.Create('Cannot change socket while active');
2072	FService := Value;
2073	End;
2074
2075	Procedure TCustomSocket.SetHost(Value: String);
2076	Begin
2077	If CompareText(Value,FHost)=0 Then exit;
2078
2079	If not (csLoading in ComponentState) and FActive Then
2080	raise ESocketError.Create('Cannot change socket while active');
2081	FHost := Value;
2082	End;
2083
2084	Procedure TCustomSocket.SetAddress(Value: String);
2085	Begin
2086	If CompareText(Value,FAddress)=0 Then exit;
2087
2088	If not (csLoading in ComponentState) and FActive Then
2089	Raise ESocketError.Create('Cannot change socket while active');
2090	FAddress := Value;
2091	End;
2092
2093	Procedure TCustomSocket.SetPort(Value: LongInt);
2094	Begin
2095	If FPort=Value Then exit;
2096
2097	If not (csLoading in ComponentState) and FActive Then
2098	raise ESocketError.Create('Cannot change socket while active');
2099	FPort := Value;
2100	End;
2101
2102	{
2103	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2104	º º
2105	º Speed-Pascal/2 Version 2.0 º
2106	º º
2107	º Speed-Pascal Component Classes (SPCC) º
2108	º º
2109	º This section: TWinSocketStream Class Implementation º
2110	º º
2111	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2112	º º
2113	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2114	}
2115
2116
2117	Constructor TWinSocketStream.Create(ASocket: TCustomWinSocket; TimeOut: Longint);
2118	Begin
2119	If ASocket.ASyncStyles <> [] Then Raise ESocketError.Create('Socket must be blocking');
2120	FSocket := ASocket;
2121	FTimeOut := TimeOut;
2122	FEvent.Create;
2123	Inherited Create;
2124	End;
2125
2126	Destructor TWinSocketStream.Destroy;
2127	Begin
2128	FEvent.Destroy;
2129	Inherited Destroy;
2130	End;
2131
2132	Function TWinSocketStream.Read(Var Buffer;Count:Longint): Longint;
2133	Begin
2134	Result:=0;
2135	If WinSockHandle=0 Then exit;
2136	result:=WinSockProcs.recv(FSocket.SocketHandle,Buffer,Count,0);
2137	If FEvent.WaitFor(FTimeOut)<>wrSignaled Then Result:=0
2138	Else FEvent.ResetEvent;
2139	End;
2140
2141	Function TWinSocketStream.Write(Const Buffer; Count: Longint): Longint;
2142	Begin
2143	Result:=0;
2144	If WinSockHandle=0 Then exit;
2145	result:=WinSockProcs.send(FSocket.SocketHandle,Buffer,Count,0);
2146	If FEvent.WaitFor(FTimeOut)<>wrSignaled Then Result:=0
2147	Else FEvent.ResetEvent;
2148	End;
2149
2150	Function TWinSocketStream.WaitForData(Timeout: Longint): Boolean;
2151	Var
2152	FDSet: TFDSet;
2153	aTimeVal: TimeVal;
2154	Begin
2155	Result:=False;
2156	If WinSockHandle=0 Then exit;
2157	aTimeVal.tv_sec:=Timeout Div 1000;
2158	aTimeVal.tv_usec:=(Timeout Mod 1000)*1000;
2159	FD_ZERO(FDSet);
2160	FD_SET(FSocket.SocketHandle, FDSet);
2161	Result:=WinSockProcs.select(0,FDSet,Nil,Nil,aTimeVal)>0;
2162	End;
2163
2164	Function TWinSocketStream.Seek(Offset: Longint; Origin: Word): Longint;
2165	Begin
2166	Result := 0;
2167	End;
2168
2169	{
2170	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2171	º º
2172	º Speed-Pascal/2 Version 2.0 º
2173	º º
2174	º Speed-Pascal Component Classes (SPCC) º
2175	º º
2176	º This section: TClientSocket Class Implementation º
2177	º º
2178	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2179	º º
2180	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2181	}
2182
2183
2184	Constructor TClientSocket.Create(AOwner:TComponent);
2185	Begin
2186	Inherited Create(AOwner);
2187	FClientSocket.Create(INVALID_SOCKET);
2188	FClientSocket.OnSocketEvent:=DoEvent;
2189	FClientSocket.OnErrorEvent:=DoError;
2190	End;
2191
2192	Destructor TClientSocket.Destroy;
2193	Begin
2194	FClientSocket.Destroy;
2195	Inherited Destroy;
2196	End;
2197
2198	Procedure TClientSocket.DoActivate(Value: Boolean);
2199	Begin
2200	If FClientSocket.Connected=Value Then exit;
2201	If csDesigning In ComponentState Then exit;
2202
2203	If ((Value=False)And(FClientSocket.Connected)) Then FClientSocket.Disconnect(FClientSocket.FSocket)
2204	Else If Value Then FClientSocket.Open(FHost,FAddress,FService,FPort);
2205	End;
2206
2207	Function TClientSocket.GetClientType: TClientType;
2208	Begin
2209	Result := FClientSocket.ClientType;
2210	End;
2211
2212	Procedure TClientSocket.SetClientType(Value: TClientType);
2213	Begin
2214	FClientSocket.ClientType := Value;
2215	End;
2216
2217	{
2218	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2219	º º
2220	º Speed-Pascal/2 Version 2.0 º
2221	º º
2222	º Speed-Pascal Component Classes (SPCC) º
2223	º º
2224	º This section: TServerSocket Class Implementation º
2225	º º
2226	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2227	º º
2228	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2229	}
2230
2231	Constructor TServerSocket.Create(AOwner: TComponent);
2232	Begin
2233	Inherited Create(AOwner);
2234	FServerSocket.Create(INVALID_SOCKET);
2235	FServerSocket.OnSocketEvent:=DoEvent;
2236	FServerSocket.OnErrorEvent:=DoError;
2237	FServerSocket.ThreadCacheSize:=10;
2238	End;
2239
2240	Destructor TServerSocket.Destroy;
2241	Begin
2242	FServerSocket.Destroy;
2243	Inherited Destroy;
2244	End;
2245
2246	Function TServerSocket.GetServerType: TServerType;
2247	Begin
2248	Result:=FServerSocket.ServerType;
2249	End;
2250
2251	Procedure TServerSocket.SetServerType(Value: TServerType);
2252	Begin
2253	FServerSocket.ServerType:=Value;
2254	End;
2255
2256	Function TServerSocket.GetGetThreadEvent: TGetThreadEvent;
2257	Begin
2258	Result:=FServerSocket.OnGetThread;
2259	End;
2260
2261	Procedure TServerSocket.SetGetThreadEvent(Value: TGetThreadEvent);
2262	Begin
2263	FServerSocket.OnGetThread:=Value;
2264	End;
2265
2266	Function TServerSocket.GetGetSocketEvent: TGetSocketEvent;
2267	Begin
2268	Result:=FServerSocket.OnGetSocket;
2269	End;
2270
2271	Procedure TServerSocket.SetGetSocketEvent(Value:TGetSocketEvent);
2272	Begin
2273	FServerSocket.OnGetSocket:=Value;
2274	End;
2275
2276	Function TServerSocket.GetThreadCacheSize:LongInt;
2277	Begin
2278	Result:=FServerSocket.ThreadCacheSize;
2279	End;
2280
2281	Procedure TServerSocket.SetThreadCacheSize(Value:LongInt);
2282	Begin
2283	FServerSocket.ThreadCacheSize:=Value;
2284	End;
2285
2286	Function TServerSocket.GetOnThreadStart:TThreadNotifyEvent;
2287	Begin
2288	Result:=FServerSocket.OnThreadStart;
2289	End;
2290
2291	Function TServerSocket.GetOnThreadEnd:TThreadNotifyEvent;
2292	Begin
2293	Result:=FServerSocket.OnThreadEnd;
2294	End;
2295
2296	Procedure TServerSocket.SetOnThreadStart(Value:TThreadNotifyEvent);
2297	Begin
2298	FServerSocket.OnThreadStart:=Value;
2299	End;
2300
2301	Procedure TServerSocket.SetOnThreadEnd(Value:TThreadNotifyEvent);
2302	Begin
2303	FServerSocket.OnThreadEnd:=Value;
2304	End;
2305
2306	Function TServerSocket.GetOnClientConnect:TSocketNotifyEvent;
2307	Begin
2308	Result:=FServerSocket.OnClientConnect;
2309	End;
2310
2311	Procedure TServerSocket.SetOnClientConnect(Value:TSocketNotifyEvent);
2312	Begin
2313	FServerSocket.OnClientConnect:=Value;
2314	End;
2315
2316	Function TServerSocket.GetOnClientDisconnect:TSocketNotifyEvent;
2317	Begin
2318	Result:=FServerSocket.OnClientDisconnect;
2319	End;
2320
2321	Function TServerSocket.GetOnClientDisconnected:TSocketNotifyEvent;
2322	Begin
2323	Result:=FServerSocket.OnClientDisconnected;
2324	End;
2325
2326
2327	Procedure TServerSocket.SetOnClientDisconnect(Value:TSocketNotifyEvent);
2328	Begin
2329	FServerSocket.OnClientDisconnect:=Value;
2330	End;
2331
2332	Procedure TServerSocket.SetOnClientDisconnected(Value:TSocketNotifyEvent);
2333	Begin
2334	FServerSocket.OnClientDisconnected:=Value;
2335	End;
2336
2337
2338	Function TServerSocket.GetOnClientRead: TSocketNotifyEvent;
2339	Begin
2340	Result:=FServerSocket.OnClientRead;
2341	End;
2342
2343	Procedure TServerSocket.SetOnClientRead(Value:TSocketNotifyEvent);
2344	Begin
2345	FServerSocket.OnClientRead:=Value;
2346	End;
2347
2348	Function TServerSocket.GetOnClientWrite:TSocketNotifyEvent;
2349	Begin
2350	Result:=FServerSocket.OnClientWrite;
2351	End;
2352
2353	Procedure TServerSocket.SetOnClientWrite(Value:TSocketNotifyEvent);
2354	Begin
2355	FServerSocket.OnClientWrite:=Value;
2356	End;
2357
2358	Function TServerSocket.GetOnClientError:TSocketErrorEvent;
2359	Begin
2360	Result:=FServerSocket.OnClientError;
2361	End;
2362
2363	Procedure TServerSocket.SetOnClientError(Value:TSocketErrorEvent);
2364	Begin
2365	FServerSocket.OnClientError:=Value;
2366	End;
2367
2368	Procedure TServerSocket.DoActivate(Value: Boolean);
2369	Begin
2370	If Value=FServerSocket.Connected Then exit;
2371	If csDesigning In ComponentState Then exit;
2372
2373	If ((Value=False)And(FServerSocket.Connected)) Then FServerSocket.Disconnect(FServerSocket.SocketHandle)
2374	Else If Value Then FServerSocket.Listen(FHost,FAddress,FService,FPort,5);
2375	End;
2376
2377	Begin
2378	RegisterClasses([TClientSocket,TServerSocket]);
2379	End.
2380

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format