demos/clientserver/KOLForm.pas

   1 { KOL MCK } // Do not remove this line!
   2 {$DEFINE KOL_MCK}
   3 unit KOLForm;
   4
   5 interface
   6
   7 {$IFDEF KOL_MCK}
   8 uses Windows, Messages, ShellAPI, KOL, KOLSocket {$IFNDEF KOL_MCK}, mirror, Classes,  mckCtrls, Controls, mckObjs,  mckSocket, {$ENDIF}, Sockets, WinSock;{$ELSE}
   9 {$ENDIF}
  10
  11 type
  12
  13   {$IFDEF KOL_MCK}
  14   {$I MCKfakeClasses.inc}
  15   PForm1 = ^TForm1;
  16   TForm1 = object(TObj)
  17     Form: PControl;
  18   {$ELSE not_KOL_MCK}
  19   TForm1 = class(TForm)
  20   {$ENDIF KOL_MCK}
  21     KOLProject: TKOLProject;
  22     KOLForm1: TKOLForm;
  23     KOLApplet1: TKOLApplet;
  24     Button1: TKOLButton;
  25     EditBox1: TKOLEditBox;
  26     Timer1: TKOLTimer;
  27     Button2: TKOLButton;
  28     ListView1: TKOLListView;
  29     Panel1: TKOLPanel;
  30     RichEdit1: TKOLRichEdit;
  31     ServerSocket: TKOLSocket;
  32     ClientSocket: TKOLSocket;
  33     Button3: TKOLButton;
  34     EditBox2: TKOLEditBox;
  35     Button4: TKOLButton;
  36
  37     procedure ServerSocketAccept(SocketMessage: TWMSocket);
  38     procedure ServerSocketClose(SocketMessage: TWMSocket);
  39     procedure ServerSocketListen(SocketMessage: TWMSocket);
  40     procedure ServerSocketError(SocketMessage: TWMSocket);
  41
  42     procedure AddSocket(fSocket: PClientSocket);
  43     procedure ServerSend(fString: string);
  44     procedure BroadCast(fString: string);
  45     procedure ServerConnect;
  46     procedure ServerDisconnect;
  47     procedure SockError(Err: String);
  48     procedure ServerCloseConnect;
  49     procedure SrvClosing;
  50     procedure FreeGarbage;
  51
  52     procedure ClientConnect;
  53     procedure ClientDisconnect;
  54
  55     procedure KOLForm1FormCreate(Sender: PObj);
  56     procedure KOLTimer1Timer(Sender: PObj);
  57     procedure KOLForm1Destroy(Sender: PObj);
  58     procedure Button1Click(Sender: PObj);
  59     procedure Button2Click(Sender: PObj);
  60     procedure EditBox1KeyUp(Sender: PControl; var Key: Integer;
  61       Shift: Cardinal);
  62     procedure ClientSocketConnect(SocketMessage: TWMSocket);
  63     procedure ClientSocketRead(SocketMessage: TWMSocket);
  64     procedure Button3Click(Sender: PObj);
  65     procedure ClientSocketError(SocketMessage: TWMSocket);
  66     procedure ClientSocketClose(SocketMessage: TWMSocket);
  67     procedure Button4Click(Sender: PObj);
  68
  69   private
  70     { Private declarations }
  71     ingarbage: boolean;
  72   public
  73 //    m_ServerSocket: PAsyncSocket;
  74     m_GarbageList: PList;
  75     { Public declarations }
  76   end;
  77 var
  78   Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
  79   constat: boolean = false;
  80   constatc: boolean = false;
  81   ClntSrv: Integer = 0;
  82
  83 {$IFDEF KOL_MCK}
  84 procedure NewForm1( var Result: PForm1; AParent: PControl );
  85 {$ENDIF}
  86
  87 implementation
  88
  89 {$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}
  90
  91 {$IFDEF KOL_MCK}
  92 {$I KOLForm_1.inc}
  93 {$ENDIF}
  94
  95
  96
  97 procedure TForm1.KOLForm1FormCreate(Sender: PObj);
  98 begin
  99 Form.StatusPanelRightX[0]:=75;
 100 Form.StatusPanelRightX[1]:=Form.StatusPanelRightX[0]+90;
 101 m_GarbageList:=NewList;
 102 end;
 103
 104
 105 // TODO: SERVER
 106 //Connecting
 107 procedure TForm1.ServerConnect;
 108 begin
 109 Form.StatusText[0]:=PChar('Connected ['+Int2Str(ListView1.Count)+']');
 110 Form.StatusText[1]:='Server'; /////
 111 Button1.Enabled:=True;
 112 EditBox1.Enabled:=True;
 113 EditBox1.Color:=clWindow;
 114 ClntSrv:=1;
 115 end;
 116
 117
 118
 119 procedure TForm1.ServerDisconnect;
 120 begin
 121 if ListView1.Count>0 then
 122    Form.StatusText[0]:=PChar('Connected ['+Int2Str(ListView1.Count)+']')
 123    else
 124    begin
 125    Form.StatusText[0]:=PChar('Disconnected');
 126    Form.StatusText[1]:=''; /////
 127    Button1.Enabled:=False;
 128    EditBox1.Enabled:=False;
 129    EditBox1.Color:=clBtnFace;
 130    ClntSrv:=0;
 131    end;
 132 end;
 133
 134
 135
 136 procedure TForm1.ServerSocketAccept(SocketMessage: TWMSocket);
 137 var
 138   tempSocket: PClientSocket;
 139
 140 begin
 141 tempSocket:=NewClientSocket;
 142 ServerSocket.DoAccept(PAsyncSocket(tempSocket));
 143 AddSocket(tempSocket);
 144 ServerConnect;
 145 end;
 146
 147
 148
 149 procedure TForm1.ServerSocketClose(SocketMessage: TWMSocket);
 150 begin
 151 ServerDisconnect;
 152 end;
 153
 154
 155 // Removing this null procedure wil give you exept situation
 156 procedure TForm1.ServerSocketListen(SocketMessage: TWMSocket);
 157 begin
 158 //
 159 end;
 160
 161
 162
 163 procedure TForm1.ServerSocketError(SocketMessage: TWMSocket);
 164 begin
 165 SockError(ServerSocket.ErrToStr(SocketMessage.SocketError));
 166 end;
 167
 168
 169 // Post Socket Errr Message
 170 procedure TForm1.SockError;
 171 begin
 172 Form.StatusText[2]:=PChar(Err);
 173 end;
 174
 175
 176
 177 procedure TForm1.AddSocket;
 178 var
 179   ipadd: String;
 180
 181 begin
 182 ipadd:=fSocket.DoGetHostByAddr(PChar(fSocket.IPAddress));
 183 if (ipadd = '') then ipadd:=fSocket.IPAddress;
 184 ListView1.LVAdd(Int2Str(dword(fSocket)), 0, [], 0, 0, dword(fSocket));
 185 end;
 186
 187
 188
 189 procedure TForm1.BroadCast;
 190 begin
 191 RichEdit1.Add(fString+#13#10);
 192 end;
 193
 194
 195
 196 procedure TForm1.ServerSend;
 197 var
 198   i: integer;
 199   t: PClientSocket;
 200
 201 begin
 202 for i:=0 to ListView1.Count-1 do
 203    begin
 204    t:=PClientSocket(ListView1.LVItemData[i]);
 205    t.SendString(fString);
 206    end;
 207 end;
 208
 209
 210 // Close All Connected Clients
 211 procedure TForm1.ServerCloseConnect;
 212 var
 213   i: integer;
 214
 215 begin
 216 for i:=0 to ListView1.Count-1 do
 217    begin
 218    SrvClosing;
 219    end;
 220 end;
 221
 222
 223 //Sub program Closing all clients
 224 procedure TForm1.SrvClosing;
 225 var
 226   t: PClientSocket;
 227
 228 begin
 229 t:=PClientSocket(ListView1.LVItemData[0]);
 230 t.DoClose;
 231 end;
 232
 233
 234
 235 procedure TForm1.FreeGarbage;
 236 var
 237   t: PClientSocket;
 238
 239 begin
 240 if ingarbage then exit;
 241 ingarbage:=true;
 242 while m_GarbageList.Count>0 do
 243    begin
 244    t:=m_GarbageList.Items[0];
 245    t.Free;
 246    m_GarbageList.Delete(0);
 247    end;
 248 ingarbage:=false;
 249 end;
 250
 251
 252
 253 procedure TForm1.KOLTimer1Timer(Sender: PObj);
 254 begin
 255 FreeGarbage;
 256 end;
 257
 258
 259
 260 // TODO: CLIENT
 261
 262 procedure TForm1.ClientConnect;
 263 begin
 264 {ClientSocket.DoClose;
 265 ClientSocket.IPAddress := '127.0.0.1';
 266 ClientSocket.DoConnect;}
 267 Form.StatusText[0]:='Connected';
 268 Form.StatusText[1]:='Client';
 269 Form.StatusText[2]:='';
 270 Button1.Enabled:=True;
 271 EditBox1.Enabled:=True;
 272 EditBox1.Color:=clWindow;
 273 Button3.Caption:='Discnnect';
 274 constatc:=True;
 275 ClntSrv:=2;
 276 end;
 277
 278
 279
 280 procedure TForm1.ClientDisconnect;
 281 begin
 282 Form.StatusText[0]:='Disconnected';
 283 Form.StatusText[1]:='';
 284 Form.StatusText[2]:='';
 285 Button1.Enabled:=False;
 286 EditBox1.Enabled:=False;
 287 EditBox1.Color:=clBtnFace;
 288 Button3.Caption:='Connect';
 289 constatc:=False;
 290 ClntSrv:=0;
 291 //if ClientSocket <> nil then ClientSocket.DoClose;
 292 end;
 293
 294
 295 procedure TForm1.ClientSocketConnect(SocketMessage: TWMSocket);
 296 begin
 297 ClientConnect;
 298 end;
 299
 300
 301 procedure TForm1.ClientSocketClose(SocketMessage: TWMSocket);
 302 begin
 303 ClientDisconnect;
 304 end;
 305
 306
 307 procedure TForm1.ClientSocketRead(SocketMessage: TWMSocket);
 308 var
 309   c: char;
 310 begin
 311 //c:=''[1]; // might not have been initialized :)
 312 RichEdit1.Add(ClientSocket.ReadLine(c)+#13+#10);
 313 //Socket1.(RichEdit1.Add);
 314 //ReceiveText);
 315 end;
 316
 317
 318
 319
 320 // END OF CLIENT-SERVER EVENT
 321
 322 // Client/Server - POST MESSAGE 1-Server; 2-Client;
 323 procedure TForm1.Button1Click(Sender: PObj);
 324 var
 325   s: string;
 326 begin
 327 //RichEdit1.Add(m_ServerSocket.LocalIP);
 328 if Length(EditBox1.Text)>0 then
 329    begin
 330    if ClntSrv=1 then
 331       begin
 332       s:='Server: '+EditBox1.Text;
 333       EditBox1.Text:='';
 334       Form1.ServerSend(s);
 335       RichEdit1.Add(s+#13#10);
 336       end;
 337    if ClntSrv=2 then
 338       begin
 339       s:='Client: '+EditBox1.Text;
 340       EditBox1.Text:='';
 341       ClientSocket.SendString(s);
 342       RichEdit1.Add(s+#13#10);
 343       end;
 344    end;
 345 end;
 346
 347
 348
 349 procedure TForm1.EditBox1KeyUp(Sender: PControl; var Key: Integer;
 350   Shift: Cardinal);
 351 begin
 352 if Key=VK_RETURN then Button1Click(nil);
 353 end;
 354
 355
 356 // Server LISTEN
 357 procedure TForm1.Button2Click(Sender: PObj);
 358 begin
 359 Form.StatusText[2]:='';
 360 if not constat then
 361    begin
 362 //   Form.StatusText[2]:='';
 363    ServerSocket.DoListen;
 364    Button2.Caption:='Stop';
 365    Button3.Enabled:=False;
 366    ClntSrv:=1;
 367    constat:= not constat;
 368    end
 369    else
 370    begin
 371 //   Form.StatusText[2]:='';
 372    ServerCloseConnect;
 373    ServerSocket.DoClose;
 374    Button2.Caption:='Listen';
 375    Button3.Enabled:=True;
 376    ClntSrv:=0;
 377    constat:= not constat;
 378    end;
 379 end;
 380
 381
 382 // Client Connect
 383 procedure TForm1.Button3Click(Sender: PObj);
 384 begin
 385 if not constatc then
 386    begin
 387    ClientSocket.IPAddress:=EditBox2.Text;
 388    ClientSocket.DoConnect;
 389    Button3.Caption:='Disconnect';
 390    constatc:= not constatc;
 391    ClientDisconnect;
 392    end
 393    else
 394    begin
 395    ClientSocket.DoClose;
 396    Button3.Caption:='Connect';
 397    constatc:= not constatc;
 398    ClientDisconnect;
 399    end;
 400 end;
 401
 402
 403
 404 procedure TForm1.KOLForm1Destroy(Sender: PObj);
 405 begin
 406 if ClntSrv=1 then
 407    begin
 408    ServerCloseConnect;
 409    FreeGarbage;
 410    ServerSocket.Free;
 411    m_GarbageList.Free;
 412    end;
 413 if ClntSrv=2 then
 414    begin
 415    ClientSocket.DoClose;
 416    end;
 417 end;
 418
 419
 420 procedure TForm1.ClientSocketError(SocketMessage: TWMSocket);
 421 begin
 422 SockError(ClientSocket.ErrToStr(SocketMessage.SocketError));
 423 end;
 424
 425
 426 procedure TForm1.Button4Click(Sender: PObj);
 427
 428 var
 429   Name: TSockAddrIn;
 430   len: integer;
 431   str: String;
 432 //  sock: TAsyncSocket;
 433
 434 begin
 435 GetSockName(ClientSocket.m_Handle, Name, len);
 436 str:=int2str(ord(Name.sin_addr.S_un_b.s_b1))+'.'+
 437       int2str(ord(Name.sin_addr.S_un_b.s_b2))+'.'+
 438       int2str(ord(Name.sin_addr.S_un_b.s_b3))+'.'+
 439       int2str(ord(Name.sin_addr.S_un_b.s_b4));
 440
 441 //str:=sock.LocalIP;
 442 EditBox2.Text:=str;
 443 end;
 444
 445 end.
 446