delphi ICS控件示例解读-白红宇

delphi ICS控件示例解读

阅读量：5235 次

发布时间：2019-06-14

本文共 6329 字，大约阅读时间需要 21 分钟。

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               
      
        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 begin100     {
      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 begin128     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 begin138     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 begin147 148 end;149 150 procedure TServerForm.SrvSocketBgException(Sender: TObject; E: Exception;151   var CanClose: Boolean);152 begin153 154 end;155 156 end.