units/ics/ics_server_demo/Unit1.~pas

   1 { KOL MCK } // Do not remove this line!\r
   2 {$DEFINE KOL_MCK}\r
   3 unit Unit1;\r
   4 \r
   5 interface\r
   6 \r
   7 {$IFDEF KOL_MCK}\r
   8 uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Classes,\r
   9   Controls, mckCtrls {$ENDIF},KOLWSocket,WinSock;\r
  10 {$ELSE}\r
  11 {$I uses.inc}\r
  12   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\r
  13   Dialogs;\r
  14 {$ENDIF}\r
  15 \r
  16 type\r
  17   {$IFDEF KOL_MCK}\r
  18   {$I MCKfakeClasses.inc}\r
  19   {$IFDEF KOLCLASSES} TForm1 = class; PForm1 = TForm1; {$ELSE OBJECTS} PForm1 = ^TForm1; {$ENDIF CLASSES/OBJECTS}\r
  20   {$IFDEF KOLCLASSES}{$I TForm1.inc}{$ELSE} TForm1 = object(TObj) {$ENDIF}\r
  21     Form: PControl;\r
  22   {$ELSE not_KOL_MCK}\r
  23   TForm1 = class(TForm)\r
  24   {$ENDIF KOL_MCK}\r
  25     KOLProject1: TKOLProject;\r
  26     KOLForm1: TKOLForm;\r
  27     DisconnectButton: TKOLButton;\r
  28     InfoLabel: TKOLLabel;\r
  29     procedure KOLForm1Show(Sender: PObj);\r
  30     procedure KOLForm1FormCreate(Sender: PObj);\r
  31     procedure DisconnectButtonClick(Sender: PObj);\r
  32     procedure KOLForm1KeyDown(Sender: PControl; var Key: Integer;\r
  33       Shift: Cardinal);\r
  34   private\r
  35     { Private declarations }\r
  36   public\r
  37     { Public declarations }\r
  38     procedure SrvSocketSessionAvailable(Sender: PObj; Error: Word);\r
  39     procedure CliSocketSessionClosed(Sender: PObj; Error: Word);\r
  40   end;\r
  41 \r
  42 var\r
  43   Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;\r
  44     SrvSocket: PWSocket;\r
  45     CliSocket: PWSocket;\r
  46     FirstTime:Boolean=true;\r
  47 \r
  48 {$IFDEF KOL_MCK}\r
  49 procedure NewForm1( var Result: PForm1; AParent: PControl );\r
  50 {$ENDIF}\r
  51 \r
  52 implementation\r
  53 \r
  54 {$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}\r
  55 \r
  56 {$IFDEF KOL_MCK}\r
  57 {$I Unit1_1.inc}\r
  58 {$ENDIF}\r
  59 \r
  60 procedure TForm1.SrvSocketSessionAvailable(Sender: PObj; Error: Word);\r
  61 var\r
  62     NewHSocket : TSocket;\r
  63     PeerName   : TSockAddrIn;\r
  64     Peer       : String;\r
  65 begin\r
  66     { We need to accept the client connection }\r
  67     NewHSocket := SrvSocket.Accept;\r
  68 \r
  69     { And then associate this connection with our client socket }\r
  70     CliSocket.Dup(NewHSocket);\r
  71 \r
  72     { Wants to know who is connected to display on screen }\r
  73     CliSocket.GetPeerName(PeerName, Sizeof(PeerName));\r
  74 \r
  75     { User likes to see internet address in dot notation }\r
  76     Peer := Int2Str(ord(PeerName.sin_addr.S_un_b.s_b1)) + '.' +\r
  77             Int2Str(ord(PeerName.sin_addr.S_un_b.s_b2)) + '.' +\r
  78             Int2Str(ord(PeerName.sin_addr.S_un_b.s_b3)) + '.' +\r
  79             Int2Str(ord(PeerName.sin_addr.S_un_b.s_b4));\r
  80     InfoLabel.Caption := 'Remote ' + Peer + ' connected';\r
  81 \r
  82     { Send a welcome message to the client }\r
  83     CliSocket.SendStr('Hello' + #13 + #10);\r
  84 \r
  85     { Enable the server user to disconect the client }\r
  86     DisconnectButton.Enabled := TRUE;\r
  87 end;\r
  88 \r
  89 procedure TForm1.CliSocketSessionClosed(Sender: PObj; Error: Word);\r
  90 begin\r
  91     DisconnectButton.Enabled := FALSE;\r
  92     InfoLabel.Caption := 'Waiting for client';{ Inform the user             }\r
  93 end;\r
  94 \r
  95 procedure TForm1.KOLForm1Show(Sender: PObj);\r
  96 \r
  97 begin\r
  98     if FirstTime then\r
  99     begin\r
 100         FirstTime         := FALSE;            { Do it only once !          }\r
 101         SrvSocket.Addr    := '0.0.0.0';        { Use any interface          }\r
 102         SrvSocket.Listen;                      { Start listening for client }\r
 103         InfoLabel.Caption := 'Waiting for client';\r
 104     end;\r
 105 end;\r
 106 \r
 107 procedure TForm1.KOLForm1FormCreate(Sender: PObj);\r
 108 begin\r
 109   SrvSocket:=NewWSocket(nil);\r
 110   SrvSocket.Port:='telnet';\r
 111   CliSocket:=NewWSocket(nil);\r
 112   CliSocket.Port:='telnet';\r
 113 \r
 114   SrvSocket.OnSessionAvailable:=SrvSocketSessionAvailable;\r
 115  CliSocket.OnSessionClosed:=CliSocketSessionClosed;\r
 116 end;\r
 117 \r
 118 procedure TForm1.DisconnectButtonClick(Sender: PObj);\r
 119 begin\r
 120     CliSocket.ShutDown(2);                    { Shut the communication down }\r
 121     CliSocket.Close;                          { Close the communication     }\r
 122 end;\r
 123 \r
 124 \r
 125 procedure TForm1.KOLForm1KeyDown(Sender: PControl; var Key: Integer;\r
 126   Shift: Cardinal);\r
 127 begin\r
 128   ShowMessage(Int2Str(Shift));\r
 129 end;\r
 130 \r
 131 end.\r
 132 \r
 133 \r