Changeset 15 for trunk/SunriseChatNetworkCoreUnit.pas
- Timestamp:
- Feb 18, 2008, 2:00:19 PM (17 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 6 6 Network.cfg 7 7 Error.txt 8 ProjectGroup1.bdsgroup 9 ProjectGroup1.bdsgroup.local
-
- Property svn:ignore
-
trunk/SunriseChatNetworkCoreUnit.pas
r13 r15 7 7 Forms, StdCtrls, ExtCtrls, SunriseChatCoreUtils, DateUtils, SunriseChatCoreUnit, 8 8 cWindows, cSockets, cSocketsUDP, cTCPClient, cTCPServer, cUtils, WinSock, 9 cWinSock, Registry, UEthernetAddress; 9 cWinSock, Registry, UEthernetAddress, IdUDPBase, IdUDPServer, IdUDPClient, 10 IdBaseComponent, IdComponent, IdGlobal, IdSocketHandle, IdCustomTCPServer, 11 IdTCPServer, IdTCPConnection, IdTCPClient, IdContext, IdAntiFreeze; 10 12 11 13 const 12 14 DefaultUdpPort = 55557; 15 BroadcastIPAddress = '255.255.255.255'; 13 16 14 17 type … … 16 19 17 20 TSunriseChatNetworkCore = class; 21 22 TReadingThread = class(TThread) 23 protected 24 FConnection: TIdTCPConnection; 25 FParent: TSunriseChatNetworkCore; 26 procedure Execute; override; 27 public 28 constructor Create(AParent: TSunriseChatNetworkCore; AConnection: TIdTCPConnection); reintroduce; 29 end; 18 30 19 31 TNetworkInterface = class … … 33 45 TSunriseChatNetworkCore = class(TSunriseChatCore) 34 46 private 35 fndTCPServer1: TfndTCPServer; 36 fndTCPClient1: TfndTCPClient; 37 fndUDPClientSocket1: TfndUDPClientSocket; 47 IdTCPServer1: TIdTCPServer; 48 IdTCPClient1: TIdTCPClient; 49 IdUDPServer1: TIdUDPServer; 50 IdUDPClient1: TIdUDPClient; 38 51 FConnected: Boolean; 39 52 FOnChangeNetworkState: TClassMethod; … … 44 57 FAutoReconnect: Boolean; 45 58 FTimer2: TTimer; 59 FReadingThread: TReadingThread; 46 60 procedure Timer2Timer(Sender: TObject); 47 procedure fndTCPServer1DataAvailable(Sender: TTCPServerClient);48 procedure fndTCPClient1DataAvailable(Sender: ATCPClient);49 procedure fndUDPClientSocket1DataAvailable(Sender: AUDPSocket);50 procedure fndTCPClient1Close(Sender: ATCPClient);51 61 function GetLocalIPAddress: string; 52 62 procedure SetLocalIPAddress(const Value: string); … … 55 65 procedure StopNetwork; 56 66 procedure SendCommandToNetwork(const S: string); 67 procedure IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); 68 procedure IdTCPServer1Execute(AContext: TIdContext); 69 procedure IdTCPClient1Connected(Sender: TObject); 70 procedure IdTCPClient1Disconnect(Sender: TObject); 71 procedure SetAutoReconnect(const Value: Boolean); 57 72 property OnSendCommand; 58 procedure SetAutoReconnect(const Value: Boolean);59 73 public 60 NetworkInterfaces: TList; // of TNetworkInterface;74 NetworkInterfaces: TList; // TList<TNetworkInterface>; 61 75 constructor Create(AOwner: TComponent); override; 62 76 function IPAddrToStr(Addr: Cardinal): string; … … 80 94 81 95 uses 82 IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog ;96 IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog, IdIOHandlerSocket; 83 97 84 98 procedure Register; 85 99 begin 86 100 RegisterComponents('Chronosoft', [TSunriseChatNetworkCore]); 101 end; 102 103 { TReadingThread } 104 105 constructor TReadingThread.Create(AParent: TSunriseChatNetworkCore; 106 AConnection: TIdTCPConnection); 107 begin 108 FConnection := AConnection; 109 FParent := AParent; 110 inherited Create(False); 111 end; 112 113 procedure TReadingThread.Execute; 114 var 115 Text: string; 116 begin 117 try 118 while not Terminated and FConnection.Connected do 119 begin 120 Text := FConnection.IOHandler.Readln; 121 //ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data); 122 FParent.ProcessCommand(Text); 123 end; 124 except 125 end; 87 126 end; 88 127 … … 93 132 inherited; 94 133 NetworkInterfaces := TList.Create; 95 fndTCPServer1 := TfndTCPServer.Create(Self); 96 fndTCPServer1.OnDataAvailable := fndTCPServer1DataAvailable; 97 fndTCPClient1 := TfndTCPClient.Create(Self); 98 fndTCPClient1.OnDataAvailable := fndTCPClient1DataAvailable; 99 fndTCPClient1.OnClose := fndTCPClient1Close; 100 fndUDPClientSocket1 := TfndUDPClientSocket.Create(Self); 101 fndUDPClientSocket1.OnDataAvailable := fndUDPClientSocket1DataAvailable; 134 IdTCPServer1 := TIdTCPServer.Create(Self); 135 IdTCPServer1.OnExecute := IdTCPServer1Execute; 136 IdTCPClient1 := TIdTCPClient.Create(Self); 137 IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect; 138 IdTCPClient1.OnConnected := IdTCPClient1Connected; 139 IdUDPServer1 := TIdUDPServer.Create(Self); 140 IdUDPServer1.OnUDPRead := IdUDPServer1UDPRead; 141 IdUDPClient1 := TIdUDPClient.Create(Self); 102 142 FUdpPort := DefaultUdpPort; 103 143 FActive := False; … … 112 152 I: Integer; 113 153 begin 114 fndTCPClient1.OnClose := nil; 154 // IdTCPClient1.OnDisconnected := nil; 155 OnChangeNetworkState := nil; 115 156 Active := False; 116 157 for I := 0 to NetworkInterfaces.Count - 1 do 117 158 TNetworkInterface(NetworkInterfaces[I]).Free; 118 159 NetworkInterfaces.Free; 160 IdTCPServer1.Destroy; 161 IdTCPClient1.Destroy; 162 IdUDPServer1.Destroy; 163 IdUDPClient1.Destroy; 119 164 inherited; 120 165 end; 121 166 122 procedure TSunriseChatNetworkCore.fndTCPClient1Close(Sender: ATCPClient); 167 procedure TSunriseChatNetworkCore.IdTCPClient1Connected(Sender: TObject); 168 begin 169 FReadingThread := TReadingThread.Create(Self, IdTCPClient1); 170 FReadingThread.FreeOnTerminate := True; 171 end; 172 173 procedure TSunriseChatNetworkCore.IdTCPClient1Disconnect(Sender: TObject); 123 174 begin 124 175 FConnected := False; … … 130 181 end; 131 182 132 procedure TSunriseChatNetworkCore.fndTCPClient1DataAvailable( 133 Sender: ATCPClient); 134 var 135 Data, Text: string; 136 begin 137 if Sender.Socket.InBufferSize > 0 then begin 138 Data := Sender.Socket.ReadAvailable; 139 ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data); 140 if Pos(#13, Data) > 0 then begin 141 repeat 142 Text := Copy(Data, 1, Pos(#13, Data)-1); 143 Delete(Data, 1, Length(Text)+1); 144 ProcessCommand(Text); 145 until (Data = '') or (Pos(#13, Data) = 0); 146 end else ProcessCommand(Data); 147 end; 148 end; 149 150 procedure TSunriseChatNetworkCore.fndTCPServer1DataAvailable( 151 Sender: TTCPServerClient); 183 procedure TSunriseChatNetworkCore.IdTCPServer1Execute(AContext: TIdContext); 184 var 185 Text: string; 186 begin 187 Text := AContext.Connection.IOHandler.ReadLn; 188 (* 189 if AContext.Connection.Connected then begin 190 Text := ''; // AContext.Connection.IOHandler.AllData; 191 *) 192 // ProtocolMessageLogForm.Memo1.Lines.Add('TCPServerDataAvailable: ' + Text); 193 if BroadcastType = btGlobal then 194 IdUDPClient1.Broadcast(Text, UDPPort) else 195 IdUDPClient1.Send(FActiveNetworkInterface.BroadcastIPAddress, UDPPort, Text); 196 // end; 197 end; 198 199 procedure TSunriseChatNetworkCore.IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); 152 200 var 153 201 Text: string; 154 202 I: Integer; 155 begin 156 if Sender.Socket.InBufferSize > 0 then begin 157 Text := Sender.Socket.ReadAvailable; 158 for I := 0 to fndTCPServer1.ClientCount - 1 do 159 fndTCPServer1.Client[I].Socket.SendStr(Text); 160 ProtocolMessageLogForm.Memo1.Lines.Add('TCPServerDataAvailable: ' + Text); 161 if BroadcastType = btGlobal then 162 fndUDPClientSocket1.Broadcast(IntToStr(UDPPort), Text) else 163 fndUDPClientSocket1.SendStr(Text); 164 end; 165 end; 166 167 procedure TSunriseChatNetworkCore.fndUDPClientSocket1DataAvailable( 168 Sender: AUDPSocket); 169 var 170 Text: string; 171 Address : TSockAddr; 172 I: Integer; 173 begin 174 ProtocolMessageLogForm.Memo1.Lines.Add('UDBClientDataAvailable: ' + Text); 203 ClientList: TList; 204 begin 205 SetLength(Text, Length(AData)); 206 for I := 0 to Length(AData) - 1 do 207 Text[I + 1] := Chr(AData[I]); 208 //ProtocolMessageLogForm.Memo1.Lines.Add('UDPServerDataAvailable: ' + Text); 209 210 // Send data to all clients 175 211 if FConnected then begin 176 Sender.ReadPacket(Text, Address); 177 for I := 0 to fndTCPServer1.ClientCount - 1 do 178 with fndTCPServer1.Client[I] do Socket.SendStr(Text); 212 ClientList := IdTCPServer1.Contexts.LockList; 213 try 214 for I := 0 to ClientList.Count - 1 do 215 TIdContext(ClientList.Items[I]).Connection.IOHandler.WriteLn(Text); 216 finally 217 IdTCPServer1.Contexts.UnlockList; 218 end; 179 219 end; 180 220 end; … … 274 314 procedure TSunriseChatNetworkCore.SendCommandToNetwork(const S: string); 275 315 begin 276 if FConnected then fndTCPClient1.Socket.SendStr(S);316 if FConnected then IdTCPClient1.IOHandler.WriteLn(S); 277 317 end; 278 318 … … 301 341 var 302 342 I, II: Integer; 343 SocketBinding: TIdSocketHandle; 303 344 const 304 345 Stav: array [0..6] of string = ('Closed', 'Resolving', 'Resolved', 'Connecting', 305 346 'Negotiating', 'Connected', 'Listening'); 306 347 begin 307 fndTCPClient1.OnClose:= nil;348 IdTCPClient1.OnDisconnected := nil; 308 349 FConnected := False; 309 350 try 310 fndTCPClient1.Active := False;311 with fndTCPServer1 do begin351 IdTCPClient1.Disconnect; 352 with IdTCPServer1 do begin 312 353 Active := False; 313 ListenPort := IntToStr(UDPPort+1); 314 LocalHost := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 354 SocketBinding := IdTCPServer1.Bindings.Add; 355 SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine); 356 SocketBinding.Port := UDPPort + 1; 315 357 try 316 358 Active := True; … … 318 360 end; 319 361 // ShowMessage(Stav[Integer(fndTCPServer1.Socket.State)]); 320 321 fndUDPClientSocket1.Terminate; 322 fndUDPClientSocket1.LocalHost := IPAddrToStr(LocalUser.Id.Machine); 323 fndUDPClientSocket1.LocalPort := IntToStr(UDPPort); 324 fndUDPClientSocket1.Host := FActiveNetworkInterface.BroadcastIPAddress; 325 fndUDPClientSocket1.Port := IntToStr(UDPPort); 326 fndUDPClientSocket1.BroadcastOption := True; 362 end; 363 IdUDPServer1.Active := False; 364 SocketBinding := IdUDPServer1.Bindings.Add; 365 SocketBinding.IP := IPAddrToStr(LocalUser.Id.Machine); 366 SocketBinding.Port := UDPPort; 367 IdUDPServer1.BroadcastEnabled := True; 327 368 try 328 fndUDPClientSocket1.Bind;369 IdUDPServer1.Active := True; 329 370 except 330 // on EWinSock do begin 331 // ShowMessage('Nelze inicializovat síť!'); 332 // Application.Terminate; 333 // end; 334 end; 335 end; 336 with fndTCPClient1 do begin 337 Active := False; 371 end; 372 IdUDPClient1.Disconnect; 373 IdUDPClient1.Host := FActiveNetworkInterface.BroadcastIPAddress; 374 IdUDPClient1.Port := UdpPort; 375 IdUDPClient1.BroadcastEnabled := True; 376 try 377 IdUDPClient1.Connect; 378 except 379 end; 380 with IdTCPClient1 do begin 381 Disconnect; 338 382 Host := IPAddrToStr(LocalUser.Id.Machine); // 'localhost'; 339 Port := IntToStr(UDPPort + 1); 340 LocalHost := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 383 Port := UDPPort + 1; 384 BoundIP := IPAddrToStr(LocalUser.Id.Machine); //'localhost'; 385 Connect; 386 (* 341 387 I := 2; 342 388 repeat 343 Active := False;344 LocalPort := IntToStr(UDPPort+I);389 Disconnect; 390 //BoundPort := UDPPort + I; 345 391 I := I + 1; 346 392 try 347 Active := True;393 Connect; 348 394 except 349 395 end; 350 396 II := 0; 351 while ( Socket.State in [ssResolving, ssNegotiating, ssConnecting]) and (II<100) do begin397 while (not Connected and (II < 100)) do begin 352 398 Application.ProcessMessages; 353 //Sleep(10);399 Sleep(10); 354 400 II := II + 1; 355 401 end; 356 402 // ShowMessage(Stav[Integer(fndTCPClient1.Socket.State)]); 357 until (Socket.State in [ssConnected, ssResolved]) or (I>30); //or (fndTCPServer1.Socket.State = ssClosed); 358 FConnected := not (fndUDPClientSocket1.Bound xor (fndTCPServer1.Socket.State = ssListening)) and 359 (fndTCPClient1.Socket.State in [ssConnected, ssResolved]); 403 until (Connected) or (I > 30); //or (fndTCPServer1.Socket.State = ssClosed); 404 *) 405 FConnected := IdUDPServer1.Active and IdUDPClient1.Active and 406 IdTCPServer1.Active and IdTCPClient1.Connected; 360 407 //ShowMessage(IntToStr(Integer(fndTCPClient1.Socket.State))+','+BoolToStr(fndUDPClientSocket1.Bound) 361 408 //+','+BoolToStr(FConnected)+','+BoolToStr(fndTCPClient1.Socket.Connected)); … … 367 414 end; 368 415 finally 369 fndTCPClient1.OnClose := fndTCPClient1Close;416 IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect; 370 417 end; 371 418 end; … … 374 421 begin 375 422 FAutoReconnect := False; 376 fndTCPClient1.Active := False;; 377 fndTCPServer1.Active := False; 378 fndUDPClientSocket1.Bound := False; 423 if IdTCPClient1.Connected then IdTCPClient1.Disconnect; 424 IdTCPServer1.Active := False; 425 IdUDPClient1.Active := False; 426 IdUDPServer1.Active := False; 379 427 end; 380 428
Note:
See TracChangeset
for help on using the changeset viewer.