1 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2 
  3 Author:       Fran鏾is PIETTE
  4 Object:       Demo program to show how to use TWSocket object is a very
  5               simple server program. This server just wait for a client to
  6               connect, then send ‘Hello‘. When the user click on the
  7               disconnect button, the client is disconnected.
  8 Creation:     September 19, 1996
  9 Version:      2.02
 10 EMail:        francois.piette@overbyte.be  http://www.overbyte.be
 11 Support:      Use the mailing list twsocket@elists.org
 12               Follow "support" link at http://www.overbyte.be for subscription.
 13 Legal issues: Copyright (C) 1996-2010 by Fran鏾is PIETTE
 14               Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
 15               <francois.piette@overbytet.be>
 16 
 17               This software is provided ‘as-is‘, without any express or
 18               implied warranty.  In no event will the author be held liable
 19               for any  damages arising from the use of this software.
 20 
 21               Permission is granted to anyone to use this software for any
 22               purpose, including commercial applications, and to alter it
 23               and redistribute it freely, subject to the following
 24               restrictions:
 25 
 26               1. The origin of this software must not be misrepresented,
 27                  you must not claim that you wrote the original software.
 28                  If you use this software in a product, an acknowledgment
 29                  in the product documentation would be appreciated but is
 30                  not required.
 31 
 32               2. Altered source versions must be plainly marked as such, and
 33                  must not be misrepresented as being the original software.
 34 
 35               3. This notice may not be removed or altered from any source
 36                  distribution.
 37 
 38 Updates:
 39 Mar 19, 1997  Use enhanced TWSocket object
 40 Sep 06, 1997  Beautified
 41 Aug 20, 1999  V2.02 Changed comment to correctly talk about interface use.
 42 
 43  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
 44 unit OverbyteIcsSrv5;
 45 
 46 {$J+}
 47 
 48 interface
 49 
 50 uses
 51   SysUtils, Windows, Messages, Classes, Graphics,
 52   Controls, Forms, Dialogs, OverbyteIcsWSocket, Winsock, StdCtrls,
 53   OverbyteIcsWndControl;
 54 
 55 type
 56   TServerForm = class(TForm)
 57     SrvSocket: TWSocket;
 58     InfoLabel: TLabel;
 59     CliSocket: TWSocket;
 60     DisconnectButton: TButton;
 61     procedure SrvSocketSessionAvailable(Sender: TObject; Error: Word);
 62     procedure FormShow(Sender: TObject);
 63     procedure DisconnectButtonClick(Sender: TObject);
 64     procedure CliSocketSessionClosed(Sender: TObject; Error: Word);
 65     procedure FormCreate(Sender: TObject);
 66     procedure SrvSocketBgException(Sender: TObject; E: Exception;
 67       var CanClose: Boolean);
 68   end;
 69 
 70 var
 71   ServerForm: TServerForm;
 72 
 73 implementation
 74 
 75 {$R *.DFM}
 76 
 77 
 78 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
 79 procedure TServerForm.FormShow(Sender: TObject);
 80 const
 81     FirstTime : Boolean = TRUE;
 82 begin
 83     if FirstTime then begin
 84         FirstTime         := FALSE;            { Do it only once !          }
 85         SrvSocket.Addr    := ‘0.0.0.0‘;        { Use any interface          }
 86         SrvSocket.Listen;                      { Start listening for client }
 87         InfoLabel.Caption := ‘Waiting for client‘;
 88     end;
 89 end;
 90 
 91 
 92 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
 93 {* This event handler is called once a client has connected the server.    *}
 94 procedure TServerForm.SrvSocketSessionAvailable(Sender: TObject; Error: Word);
 95 var
 96     NewHSocket : TSocket;
 97     PeerName   : TSockAddrIn;
 98     Peer       : String;
 99 begin
100     { We need to accept the client connection }
101     NewHSocket := SrvSocket.Accept;
102 
103     { And then associate this connection with our client socket }
104     CliSocket.Dup(NewHSocket);
105 
106     { Wants to know who is connected to display on screen }
107     CliSocket.GetPeerName(PeerName, Sizeof(PeerName));
108 
109     { User likes to see internet address in dot notation }
110     Peer := IntToStr(ord(PeerName.sin_addr.S_un_b.s_b1)) + ‘.‘ +
111             IntToStr(ord(PeerName.sin_addr.S_un_b.s_b2)) + ‘.‘ +
112             IntToStr(ord(PeerName.sin_addr.S_un_b.s_b3)) + ‘.‘ +
113             IntToStr(ord(PeerName.sin_addr.S_un_b.s_b4));
114     InfoLabel.Caption := ‘Remote ‘ + Peer + ‘ connected‘;
115 
116     { Send a welcome message to the client }
117     CliSocket.SendStr(‘Hello‘ + #13 + #10);
118 
119     { Enable the server user to disconect the client }
120     DisconnectButton.Enabled := TRUE;
121 end;
122 
123 
124 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
125 {* This event handler is called once the user clicks on Ddisconnect        *}
126 procedure TServerForm.DisconnectButtonClick(Sender: TObject);
127 begin
128     CliSocket.ShutDown(2);                    { Shut the communication down }
129     CliSocket.Close;                          { Close the communication     }
130 end;
131 
132 
133 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
134 {* This event handler is called once the client connection is broken.      *}
135 {* Either by the client or the server.                                     *}
136 procedure TServerForm.CliSocketSessionClosed(Sender: TObject; Error: Word);
137 begin
138     DisconnectButton.Enabled := FALSE;
139     InfoLabel.Caption := ‘Waiting for client‘;{ Inform the user             }
140 end;
141 
142 
143 {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
144 
145 procedure TServerForm.FormCreate(Sender: TObject);
146 begin
147 
148 end;
149 
150 procedure TServerForm.SrvSocketBgException(Sender: TObject; E: Exception;
151   var CanClose: Boolean);
152 begin
153 
154 end;
155 
156 end.