source: trunk/Sibyl/Addon/SCKTCOMP.PAS@ 145

Last change on this file since 145 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
12Unit ScktComp;
13
14Interface
15
16Uses SysUtils,Classes,Forms,SyncComp;
17
18{$IFDEF OS2}
19Uses Os2Def,BseDos,BseErr,PmWin;
20{$ENDIF}
21{$IFDEF WIN32}
22Uses WinNT,WinBase,WinUser;
23{$ENDIF}
24
25Const
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
36Type
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
435ThreadVar SocketErrorProc:Procedure(ErrorCode:Word);
436
437Implementation
438
439Const
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
469Uses Forms;
470
471Const
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
531Function SocketErrorMsg(ErrorCode:Word):String;
532Begin
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+'.)';
572End;
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
590Type
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
613Procedure TSocketNotifyControl.CreateWnd; //dummy
614Begin
615 Inherited CreateWnd;
616End;
617
618Procedure TSocketNotifyControl.SetupComponent;
619Begin
620 Inherited SetupComponent;
621 Include (ComponentState, csDetail);
622End;
623
624Procedure TSocketNotifyControl.CMSocketMessage(Var Message: TCMSocketMessage);
625Var
626 ErrorEvent: TErrorEvent;
627Begin
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));
685End;
686
687
688Procedure TSocketNotifyControl.CMDeferFree(Var Message:TMessage);
689Begin
690 If FSocket<>Nil Then FSocket.Destroy;
691 FSocket:=Nil;
692 Message.Handled:=True;
693End;
694
695Const WinSockHandle:LongWord=0;
696
697Const
698 WSADESCRIPTION_LEN =256;
699 WSASYS_STATUS_LEN =128;
700
701Type
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
713Type 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
741Var WinSockProcs:TWinSockProcs;
742
743Function InitWinSock:BOOLEAN;
744Var 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
760Begin
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;
825End;
826
827
828Var
829 aWSAData: WSAData;
830
831Procedure CheckSockError(Socket:TCustomWinSocket;Const Op:String);
832Var ErrorCode:Word;
833Begin
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;
844End;
845
846Procedure CheckSockResult(ResultCode: Integer; Const Op: String);
847Var Ret:LongInt;
848Begin
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));
856End;
857
858Const CallCount:LongInt=0;
859
860Constructor TCustomWinSocket.Create(ASocket: TSocket);
861Var ErrorCode:LongInt;
862 InsideDesigner:Boolean;
863Begin
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;
892End;
893
894Destructor TCustomWinSocket.Destroy;
895Var ErrorCode:LongInt;
896 InsideDesigner:Boolean;
897Begin
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;
936End;
937
938
939Procedure TCustomWinSocket.Accept(Socket: TSocket);
940Begin
941End;
942
943Procedure TCustomWinSocket.Close;
944Begin
945 Disconnect(FSocket);
946End;
947
948Procedure TCustomWinSocket.Connect(Socket: TSocket);
949Begin
950End;
951
952Function TCustomWinSocket.GetHandle:LongWord;
953Begin
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;
962End;
963
964Function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
965Var
966 Size:LongInt;
967Begin
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);
974End;
975
976Function TCustomWinSocket.GetLocalAddress: String;
977Var
978 Size:LongInt;
979 SoIn:TSockAddrIn;
980Begin
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);
990End;
991
992Function TCustomWinSocket.GetRemoteAddress:String;
993Var
994 Size:LongInt;
995 SoIn:TSockAddrIn;
996Begin
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;
1007End;
1008
1009Function TCustomWinSocket.GetLocalHost:String;
1010Var
1011 LocName:CString;
1012Begin
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;
1018End;
1019
1020Type
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
1034Function TCustomWinSocket.GetRemoteHost:String;
1035Var
1036 Size:LongInt;
1037 aHostEnt:PHostEnt;
1038 SoIn:TSockAddrIn;
1039Begin
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;
1050End;
1051
1052Function TCustomWinSocket.GetLocalPort:LongInt;
1053Var
1054 Size:LongInt;
1055 SoIn:TSockAddrIn;
1056Begin
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;
1066End;
1067
1068Function TCustomWinSocket.GetRemotePort: LongInt;
1069Var
1070 Size:LongInt;
1071 SoIn:TSockAddrIn;
1072Begin
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;
1082End;
1083
1084Function TCustomWinSocket.LookupName(Const Name: String): TInAddr;
1085Var
1086 HostEnt: PHostEnt;
1087Begin
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]);
1097End;
1098
1099Type
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
1108Function TCustomWinSocket.LookupService(Const Service: String): LongInt;
1109Var
1110 aServEnt: PServEnt;
1111Begin
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)
1117End;
1118
1119Function TCustomWinSocket.InitSocket(Var Name,Address,Service:String;Port:Word;
1120 Client:Boolean):TSockAddrIn;
1121Begin
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;
1143End;
1144
1145Procedure TCustomWinSocket.Listen(Var Name,Address,Service:String;Port:Word;QueueSize:LongInt);
1146Var
1147 SoIn: TSockAddrIn;
1148 Blocking:LongWord;
1149Begin
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;
1178End;
1179
1180Procedure TCustomWinSocket.Open(Var Name,Address,Service:String;Port:Word);
1181Var
1182 SoIn:TSockAddrIn;
1183 Blocking:LongWord;
1184Begin
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;
1214End;
1215
1216Procedure TCustomWinSocket.Read(Socket: TSocket);
1217Begin
1218 If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
1219 Event(Self, seRead);
1220End;
1221
1222Procedure TCustomWinSocket.Write(Socket: TSocket);
1223Var Stream:TStream;
1224Begin
1225 If ((FSocket<=0)Or(Socket<>FSocket)) Then Exit;
1226 Stream:=FSendStream;
1227 FSendStream:=Nil;
1228 If not SendStream(Stream) Then Event(Self, seWrite);
1229End;
1230
1231
1232Procedure TCustomWinSocket.Disconnect(Socket: TSocket);
1233Begin
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);
1260End;
1261
1262Procedure TCustomWinSocket.Event(Socket:TCustomWinSocket;SocketEvent:TSocketEvent);
1263Begin
1264 If FOnSocketEvent<>Nil Then FOnSocketEvent(Self,Socket,SocketEvent);
1265End;
1266
1267Procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
1268 Var ErrorCode:Word);
1269Begin
1270 If FOnErrorEvent<>Nil Then FOnErrorEvent(Self,Socket,ErrorEvent,ErrorCode);
1271End;
1272
1273Procedure TCustomWinSocket.SendText(Const s: String);
1274Begin
1275 SendBuf(S[1], Length(S));
1276End;
1277
1278Function TCustomWinSocket.SendStream(AStream: TStream): Boolean;
1279Var
1280 BufferBytesLeft:LongInt;
1281 BufferBytesSent:LongInt;
1282 ErrorCode:Word;
1283 Buf:Array[0..4095] of Byte;
1284 StartPos:LongInt;
1285Label ex;
1286Begin
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
1325ex:
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;
1335End;
1336
1337Function TCustomWinSocket.SendStreamThenDrop(AStream: TStream): Boolean;
1338Begin
1339 FDropAfterSend := True;
1340 Result := SendStream(AStream);
1341 If not Result Then FDropAfterSend:=False;
1342End;
1343
1344Function TCustomWinSocket.SendBuf(Var Buf;Count:LongInt):LongInt;
1345Begin
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');
1352End;
1353
1354Procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
1355Var Blocking:LongWord;
1356Begin
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;
1372End;
1373
1374Function TCustomWinSocket.ReceiveBuf(Var Buf; Count: LongInt): LongInt;
1375Begin
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;
1386End;
1387
1388Function TCustomWinSocket.ReceiveLength: LongInt;
1389Var p:Pointer;
1390Begin
1391 p:=Nil;
1392 Result := ReceiveBuf(p^, -1);
1393End;
1394
1395Function TCustomWinSocket.ReceiveText: String;
1396Var p:Pointer;
1397Begin
1398 p:=Nil;
1399 SetLength(Result, ReceiveBuf(p^, -1));
1400 ReceiveBuf(Result[1], Length(Result));
1401End;
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
1417Procedure TClientWinSocket.Connect(Socket: TSocket);
1418Begin
1419 FConnected:=True;
1420 Event(Self, seConnect);
1421End;
1422
1423Procedure TClientWinSocket.SetClientType(Value: TClientType);
1424Begin
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];
1432End;
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
1448Constructor TServerClientWinSocket.Create(Socket: TSocket;ServerWinSocket:TServerWinSocket);
1449Var Blocking:LongWord;
1450Begin
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);
1474End;
1475
1476Destructor TServerClientWinSocket.Destroy;
1477Begin
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;
1484End;
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
1500Constructor TServerWinSocket.Create(ASocket: TSocket);
1501Begin
1502 FConnections.Create;
1503 FActiveThreads.Create;
1504 Inherited Create(ASocket);
1505 FAsyncStyles:=[asAccept];
1506End;
1507
1508Destructor TServerWinSocket.Destroy;
1509Begin
1510 Inherited Destroy;
1511 FConnections.Destroy;
1512 FActiveThreads.Destroy;
1513End;
1514
1515Procedure TServerWinSocket.ClientEvent(Sender:TObject;Socket:TCustomWinSocket;
1516 SocketEvent:TSocketEvent);
1517Begin
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;
1525End;
1526
1527Procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
1528 ErrorEvent: TErrorEvent;Var ErrorCode:Word);
1529Begin
1530 ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
1531End;
1532
1533Function TServerWinSocket.GetConnections(Index:LongInt):TCustomWinSocket;
1534Begin
1535 Result:=FConnections[Index];
1536End;
1537
1538Function TServerWinSocket.GetActiveConnections:LongInt;
1539Begin
1540 Result:=FConnections.Count;
1541End;
1542
1543Function TServerWinSocket.GetActiveThreads: LongInt;
1544Var
1545 t:LongInt;
1546Begin
1547 Result := 0;
1548 For t:=0 To FActiveThreads.Count-1 Do
1549 If TServerClientThread(FActiveThreads[t]).ClientSocket<>Nil Then
1550 Inc(Result);
1551End;
1552
1553Function TServerWinSocket.GetIdleThreads: LongInt;
1554Var
1555 t:LongInt;
1556Begin
1557 Result := 0;
1558 For t:=0 To FActiveThreads.Count-1 Do
1559 If TServerClientThread(FActiveThreads[t]).ClientSocket=Nil Then
1560 Inc(Result);
1561End;
1562
1563Procedure TServerWinSocket.Accept(Socket: TSocket);
1564Var
1565 ClientSocket: TServerClientWinSocket;
1566 ClientWinSocket: TSocket;
1567 Addr: TSockAddrIn;
1568 Len: LongInt;
1569Begin
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;
1583End;
1584
1585Procedure TServerWinSocket.Listen(Var Name, Address, Service: String; Port: Word;
1586 QueueSize: LongInt);
1587Begin
1588 Inherited Listen(Name, Address, Service, Port, QueueSize);
1589 If FConnected Then If ServerType = stThreadBlocking Then
1590 FServerAcceptThread := TServerAcceptThread.Create(False, Self);
1591End;
1592
1593Procedure TServerWinSocket.Disconnect(Socket: TSocket);
1594Var
1595 SaveCacheSize: LongInt;
1596 sc:TServerClientThread;
1597 cw:TCustomWinSocket;
1598Begin
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;
1633End;
1634
1635Function TServerWinSocket.DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1636Begin
1637 Result := TServerClientThread.Create(False, ClientSocket);
1638End;
1639
1640Procedure TServerWinSocket.ThreadStart(AThread: TServerClientThread);
1641Begin
1642 If FOnThreadStart<>Nil Then FOnThreadStart(Self,AThread);
1643End;
1644
1645Procedure TServerWinSocket.ThreadEnd(AThread: TServerClientThread);
1646Begin
1647 If FOnThreadEnd<>Nil Then FOnThreadEnd(Self,AThread);
1648End;
1649
1650Procedure TServerWinSocket.SetServerType(Value: TServerType);
1651Begin
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];
1658End;
1659
1660Procedure TServerWinSocket.SetThreadCacheSize(Value: LongInt);
1661Var
1662 Start,t:LongInt;
1663 sc:TServerClientThread;
1664Begin
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;
1677End;
1678
1679Function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
1680Begin
1681 Result:=Nil;
1682 If FOnGetSocket<>Nil Then FOnGetSocket(Self,Socket,Result);
1683 If Result=nil Then Result := TServerClientWinSocket.Create(Socket,Self);
1684End;
1685
1686Function TServerWinSocket.GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1687Var
1688 t:LongInt;
1689Begin
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);
1704End;
1705
1706Function TServerWinSocket.GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
1707Var
1708 t:LongInt;
1709Begin
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;
1716End;
1717
1718Procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
1719Begin
1720 If FOnClientRead<>Nil Then FOnClientRead(Self,Socket);
1721End;
1722
1723Procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
1724Begin
1725 If FOnClientWrite<>Nil Then FOnClientWrite(Self,Socket);
1726End;
1727
1728Procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
1729Begin
1730 If FOnClientConnect<>Nil Then FOnClientConnect(Self,Socket);
1731End;
1732
1733Procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
1734Begin
1735 If FOnClientDisconnect<>Nil Then FOnClientDisconnect(Self,Socket);
1736End;
1737
1738Procedure TServerWinSocket.ClientDisconnected(Socket: TCustomWinSocket);
1739Begin
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);
1743End;
1744
1745
1746Procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
1747 ErrorEvent: TErrorEvent; Var ErrorCode:Word);
1748Begin
1749 If FOnClientError<>Nil Then FOnClientError(Self,Socket,ErrorEvent,ErrorCode);
1750End;
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
1767Constructor TServerAcceptThread.Create(CreateSuspended: Boolean;ASocket: TServerWinSocket);
1768Begin
1769 FServerSocket := ASocket;
1770 Inherited Create(CreateSuspended);
1771End;
1772
1773Procedure TServerAcceptThread.Execute;
1774Begin
1775 While Not Terminated Do FServerSocket.Accept(FServerSocket.SocketHandle);
1776End;
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
1793Constructor TServerClientThread.Create(CreateSuspended:Boolean;
1794 ASocket:TServerClientWinSocket);
1795Begin
1796 FreeOnTerminate := True;
1797 FEvent:=TSimpleEvent.Create;
1798 Inherited Create(True);
1799 Priority:=tpHigher;
1800 ReActivate(ASocket);
1801 If not CreateSuspended Then Resume;
1802End;
1803
1804Destructor TServerClientThread.Destroy;
1805Begin
1806 FClientSocket.Destroy;
1807 FEvent.Destroy;
1808 Inherited Destroy;
1809End;
1810
1811Procedure TServerClientThread.Execute;
1812Begin
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;
1831End;
1832
1833Function TServerClientThread.StartConnect:Boolean;
1834Begin
1835 If FEvent.WaitFor(INFINITE) = wrSignaled Then FEvent.ResetEvent;
1836 Result := not Terminated;
1837End;
1838
1839Function TServerClientThread.EndConnect: Boolean;
1840Begin
1841 FClientSocket.Destroy;
1842 FClientSocket := nil;
1843 Result:=Terminated or Not KeepInCache;
1844End;
1845
1846Procedure TServerClientThread.ReActivate(ASocket: TServerClientWinSocket);
1847Begin
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;
1862End;
1863
1864Procedure TServerClientThread.DoHandleException;
1865Begin
1866 {$IFDEF OS2}
1867 WinSetCapture(HWND_DESKTOP,0);
1868 {$ENDIF}
1869 If FException Is Exception Then Application.ShowException(FException)
1870 Else Raise FException;
1871End;
1872
1873Procedure TServerClientThread.HandleException(e:Exception);
1874Begin
1875 FException := e;
1876 Try
1877 Synchronize(DoHandleException);
1878 Finally
1879 FException := nil;
1880 End;
1881End;
1882
1883
1884Procedure TServerClientThread.DoRead;
1885Begin
1886 ClientSocket.ServerWinSocket.Event(ClientSocket,seRead);
1887End;
1888
1889Procedure TServerClientThread.DoWrite;
1890Begin
1891 FServerSocket.Event(ClientSocket, seWrite);
1892End;
1893
1894Procedure TServerClientThread.DoTerminate;
1895Begin
1896 If FServerSocket<>Nil Then
1897 Begin
1898 If FServerSocket.FActiveThreads.IndexOf(Self)>=0 Then
1899 FServerSocket.FActiveThreads.Remove(Self);
1900 End;
1901End;
1902
1903Procedure TServerClientThread.HandleEvent(Sender:TObject;Socket:TCustomWinSocket;
1904 SocketEvent:TSocketEvent);
1905Begin
1906 Event(SocketEvent);
1907End;
1908
1909Procedure TServerClientThread.Event(SocketEvent: TSocketEvent);
1910Begin
1911 FServerSocket.ClientEvent(Self,ClientSocket,SocketEvent);
1912End;
1913
1914Procedure TServerClientThread.HandleError(Sender:TObject;Socket:TCustomWinSocket;
1915 ErrorEvent:TErrorEvent;Var ErrorCode:Word);
1916Begin
1917 Error(ErrorEvent, ErrorCode);
1918End;
1919
1920
1921Procedure TServerClientThread.Error(ErrorEvent:TErrorEvent;Var ErrorCode:Word);
1922Begin
1923 FServerSocket.ClientError(Self, ClientSocket, ErrorEvent, ErrorCode);
1924End;
1925
1926Const FD_SETSIZE = 64;
1927
1928Type 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
1938Procedure FD_ZERO(Var aset:TFDSET);
1939Begin
1940 aset.fd_count:=0;
1941End;
1942
1943Procedure FD_SET(Socket:TSocket;Var FDSet:TFDSet);
1944Begin
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;
1950End;
1951
1952Procedure TServerClientThread.ClientExecute;
1953Var
1954 FDSet: TFDSet;
1955 aTimeVal: TimeVal;
1956Begin
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
1970End;
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
1986Procedure TCustomSocket.Open;
1987Begin
1988 Active := True;
1989End;
1990
1991Procedure TCustomSocket.Close;
1992Begin
1993 Active := False;
1994End;
1995
1996Procedure TCustomSocket.SetActive(Value: Boolean);
1997Var InsideDesigner:Boolean;
1998Begin
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;
2009End;
2010
2011Procedure TCustomSocket.DoEvent(Sender:TObject;Socket:TCustomWinSocket;
2012 SocketEvent:TSocketEvent);
2013Begin
2014 Event(Socket,SocketEvent);
2015End;
2016
2017Procedure TCustomSocket.DoError(Sender:TObject;Socket:TCustomWinSocket;
2018 ErrorEvent:TErrorEvent;Var ErrorCode:Word);
2019Begin
2020 Error(Socket,ErrorEvent,ErrorCode);
2021End;
2022
2023Procedure TCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
2024Begin
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
2047End;
2048
2049Procedure TCustomSocket.Error(Socket:TCustomWinSocket;ErrorEvent:TErrorEvent;
2050 Var ErrorCode:Word);
2051Begin
2052 If FOnError<>Nil Then FOnError(Self,Socket,ErrorEvent,ErrorCode);
2053End;
2054
2055Procedure TCustomSocket.Loaded;
2056Var InsideDesigner:Boolean;
2057Begin
2058 Inherited Loaded;
2059 Asm
2060 MOV AL,Classes.InsideDesigner
2061 MOV InsideDesigner,AL
2062 End;
2063 If not InsideDesigner Then DoActivate(FActive);
2064End;
2065
2066Procedure TCustomSocket.SetService(Value: String);
2067Begin
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;
2073End;
2074
2075Procedure TCustomSocket.SetHost(Value: String);
2076Begin
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;
2082End;
2083
2084Procedure TCustomSocket.SetAddress(Value: String);
2085Begin
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;
2091End;
2092
2093Procedure TCustomSocket.SetPort(Value: LongInt);
2094Begin
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;
2100End;
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
2117Constructor TWinSocketStream.Create(ASocket: TCustomWinSocket; TimeOut: Longint);
2118Begin
2119 If ASocket.ASyncStyles <> [] Then Raise ESocketError.Create('Socket must be blocking');
2120 FSocket := ASocket;
2121 FTimeOut := TimeOut;
2122 FEvent.Create;
2123 Inherited Create;
2124End;
2125
2126Destructor TWinSocketStream.Destroy;
2127Begin
2128 FEvent.Destroy;
2129 Inherited Destroy;
2130End;
2131
2132Function TWinSocketStream.Read(Var Buffer;Count:Longint): Longint;
2133Begin
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;
2139End;
2140
2141Function TWinSocketStream.Write(Const Buffer; Count: Longint): Longint;
2142Begin
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;
2148End;
2149
2150Function TWinSocketStream.WaitForData(Timeout: Longint): Boolean;
2151Var
2152 FDSet: TFDSet;
2153 aTimeVal: TimeVal;
2154Begin
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;
2162End;
2163
2164Function TWinSocketStream.Seek(Offset: Longint; Origin: Word): Longint;
2165Begin
2166 Result := 0;
2167End;
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
2184Constructor TClientSocket.Create(AOwner:TComponent);
2185Begin
2186 Inherited Create(AOwner);
2187 FClientSocket.Create(INVALID_SOCKET);
2188 FClientSocket.OnSocketEvent:=DoEvent;
2189 FClientSocket.OnErrorEvent:=DoError;
2190End;
2191
2192Destructor TClientSocket.Destroy;
2193Begin
2194 FClientSocket.Destroy;
2195 Inherited Destroy;
2196End;
2197
2198Procedure TClientSocket.DoActivate(Value: Boolean);
2199Begin
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);
2205End;
2206
2207Function TClientSocket.GetClientType: TClientType;
2208Begin
2209 Result := FClientSocket.ClientType;
2210End;
2211
2212Procedure TClientSocket.SetClientType(Value: TClientType);
2213Begin
2214 FClientSocket.ClientType := Value;
2215End;
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
2231Constructor TServerSocket.Create(AOwner: TComponent);
2232Begin
2233 Inherited Create(AOwner);
2234 FServerSocket.Create(INVALID_SOCKET);
2235 FServerSocket.OnSocketEvent:=DoEvent;
2236 FServerSocket.OnErrorEvent:=DoError;
2237 FServerSocket.ThreadCacheSize:=10;
2238End;
2239
2240Destructor TServerSocket.Destroy;
2241Begin
2242 FServerSocket.Destroy;
2243 Inherited Destroy;
2244End;
2245
2246Function TServerSocket.GetServerType: TServerType;
2247Begin
2248 Result:=FServerSocket.ServerType;
2249End;
2250
2251Procedure TServerSocket.SetServerType(Value: TServerType);
2252Begin
2253 FServerSocket.ServerType:=Value;
2254End;
2255
2256Function TServerSocket.GetGetThreadEvent: TGetThreadEvent;
2257Begin
2258 Result:=FServerSocket.OnGetThread;
2259End;
2260
2261Procedure TServerSocket.SetGetThreadEvent(Value: TGetThreadEvent);
2262Begin
2263 FServerSocket.OnGetThread:=Value;
2264End;
2265
2266Function TServerSocket.GetGetSocketEvent: TGetSocketEvent;
2267Begin
2268 Result:=FServerSocket.OnGetSocket;
2269End;
2270
2271Procedure TServerSocket.SetGetSocketEvent(Value:TGetSocketEvent);
2272Begin
2273 FServerSocket.OnGetSocket:=Value;
2274End;
2275
2276Function TServerSocket.GetThreadCacheSize:LongInt;
2277Begin
2278 Result:=FServerSocket.ThreadCacheSize;
2279End;
2280
2281Procedure TServerSocket.SetThreadCacheSize(Value:LongInt);
2282Begin
2283 FServerSocket.ThreadCacheSize:=Value;
2284End;
2285
2286Function TServerSocket.GetOnThreadStart:TThreadNotifyEvent;
2287Begin
2288 Result:=FServerSocket.OnThreadStart;
2289End;
2290
2291Function TServerSocket.GetOnThreadEnd:TThreadNotifyEvent;
2292Begin
2293 Result:=FServerSocket.OnThreadEnd;
2294End;
2295
2296Procedure TServerSocket.SetOnThreadStart(Value:TThreadNotifyEvent);
2297Begin
2298 FServerSocket.OnThreadStart:=Value;
2299End;
2300
2301Procedure TServerSocket.SetOnThreadEnd(Value:TThreadNotifyEvent);
2302Begin
2303 FServerSocket.OnThreadEnd:=Value;
2304End;
2305
2306Function TServerSocket.GetOnClientConnect:TSocketNotifyEvent;
2307Begin
2308 Result:=FServerSocket.OnClientConnect;
2309End;
2310
2311Procedure TServerSocket.SetOnClientConnect(Value:TSocketNotifyEvent);
2312Begin
2313 FServerSocket.OnClientConnect:=Value;
2314End;
2315
2316Function TServerSocket.GetOnClientDisconnect:TSocketNotifyEvent;
2317Begin
2318 Result:=FServerSocket.OnClientDisconnect;
2319End;
2320
2321Function TServerSocket.GetOnClientDisconnected:TSocketNotifyEvent;
2322Begin
2323 Result:=FServerSocket.OnClientDisconnected;
2324End;
2325
2326
2327Procedure TServerSocket.SetOnClientDisconnect(Value:TSocketNotifyEvent);
2328Begin
2329 FServerSocket.OnClientDisconnect:=Value;
2330End;
2331
2332Procedure TServerSocket.SetOnClientDisconnected(Value:TSocketNotifyEvent);
2333Begin
2334 FServerSocket.OnClientDisconnected:=Value;
2335End;
2336
2337
2338Function TServerSocket.GetOnClientRead: TSocketNotifyEvent;
2339Begin
2340 Result:=FServerSocket.OnClientRead;
2341End;
2342
2343Procedure TServerSocket.SetOnClientRead(Value:TSocketNotifyEvent);
2344Begin
2345 FServerSocket.OnClientRead:=Value;
2346End;
2347
2348Function TServerSocket.GetOnClientWrite:TSocketNotifyEvent;
2349Begin
2350 Result:=FServerSocket.OnClientWrite;
2351End;
2352
2353Procedure TServerSocket.SetOnClientWrite(Value:TSocketNotifyEvent);
2354Begin
2355 FServerSocket.OnClientWrite:=Value;
2356End;
2357
2358Function TServerSocket.GetOnClientError:TSocketErrorEvent;
2359Begin
2360 Result:=FServerSocket.OnClientError;
2361End;
2362
2363Procedure TServerSocket.SetOnClientError(Value:TSocketErrorEvent);
2364Begin
2365 FServerSocket.OnClientError:=Value;
2366End;
2367
2368Procedure TServerSocket.DoActivate(Value: Boolean);
2369Begin
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);
2375End;
2376
2377Begin
2378 RegisterClasses([TClientSocket,TServerSocket]);
2379End.
2380
Note: See TracBrowser for help on using the repository browser.