Ignore:
Timestamp:
Feb 18, 2008, 2:00:19 PM (16 years ago)
Author:
george
Message:

Přepracováno: Změna síťových komponent z fundamentals sockets na Indy. Prozatím ne dostatečně funkční.
Typografikcé úpravy.

Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        66Network.cfg
        77Error.txt
         8ProjectGroup1.bdsgroup
         9ProjectGroup1.bdsgroup.local

  • trunk/SunriseChatNetworkCoreUnit.pas

    r13 r15  
    77  Forms, StdCtrls, ExtCtrls, SunriseChatCoreUtils, DateUtils, SunriseChatCoreUnit,
    88  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;
    1012
    1113const
    1214  DefaultUdpPort = 55557;
     15  BroadcastIPAddress = '255.255.255.255';
    1316
    1417type
    … …  
    1619
    1720  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;
    1830
    1931  TNetworkInterface = class
    … …  
    3345  TSunriseChatNetworkCore = class(TSunriseChatCore)
    3446  private
    35     fndTCPServer1: TfndTCPServer;
    36     fndTCPClient1: TfndTCPClient;
    37     fndUDPClientSocket1: TfndUDPClientSocket;
     47    IdTCPServer1: TIdTCPServer;
     48    IdTCPClient1: TIdTCPClient;
     49    IdUDPServer1: TIdUDPServer;
     50    IdUDPClient1: TIdUDPClient;
    3851    FConnected: Boolean;
    3952    FOnChangeNetworkState: TClassMethod;
    … …  
    4457    FAutoReconnect: Boolean;
    4558    FTimer2: TTimer;
     59    FReadingThread: TReadingThread;
    4660    procedure Timer2Timer(Sender: TObject);
    47     procedure fndTCPServer1DataAvailable(Sender: TTCPServerClient);
    48     procedure fndTCPClient1DataAvailable(Sender: ATCPClient);
    49     procedure fndUDPClientSocket1DataAvailable(Sender: AUDPSocket);
    50     procedure fndTCPClient1Close(Sender: ATCPClient);
    5161    function GetLocalIPAddress: string;
    5262    procedure SetLocalIPAddress(const Value: string);
    … …  
    5565    procedure StopNetwork;
    5666    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);
    5772    property OnSendCommand;
    58     procedure SetAutoReconnect(const Value: Boolean);
    5973  public
    60     NetworkInterfaces: TList; // of TNetworkInterface;
     74    NetworkInterfaces: TList; // TList<TNetworkInterface>;
    6175    constructor Create(AOwner: TComponent); override;
    6276    function IPAddrToStr(Addr: Cardinal): string;
    … …  
    8094
    8195uses
    82   IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog;
     96  IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog, IdIOHandlerSocket;
    8397
    8498procedure Register;
    8599begin
    86100  RegisterComponents('Chronosoft', [TSunriseChatNetworkCore]);
     101end;
     102
     103{ TReadingThread }
     104
     105constructor TReadingThread.Create(AParent: TSunriseChatNetworkCore;
     106  AConnection: TIdTCPConnection);
     107begin
     108  FConnection := AConnection;
     109  FParent := AParent;
     110  inherited Create(False);
     111end;
     112
     113procedure TReadingThread.Execute;
     114var
     115  Text: string;
     116begin
     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;
    87126end;
    88127
    … …  
    93132  inherited;
    94133  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);
    102142  FUdpPort := DefaultUdpPort;
    103143  FActive := False;
    … …  
    112152  I: Integer;
    113153begin
    114   fndTCPClient1.OnClose := nil;
     154//  IdTCPClient1.OnDisconnected := nil;
     155  OnChangeNetworkState := nil;
    115156  Active := False;
    116157  for I := 0 to NetworkInterfaces.Count - 1 do
    117158    TNetworkInterface(NetworkInterfaces[I]).Free;
    118159  NetworkInterfaces.Free;
     160  IdTCPServer1.Destroy;
     161  IdTCPClient1.Destroy;
     162  IdUDPServer1.Destroy;
     163  IdUDPClient1.Destroy;
    119164  inherited;
    120165end;
    121166
    122 procedure TSunriseChatNetworkCore.fndTCPClient1Close(Sender: ATCPClient);
     167procedure TSunriseChatNetworkCore.IdTCPClient1Connected(Sender: TObject);
     168begin
     169  FReadingThread := TReadingThread.Create(Self, IdTCPClient1);
     170  FReadingThread.FreeOnTerminate := True;
     171end;
     172
     173procedure TSunriseChatNetworkCore.IdTCPClient1Disconnect(Sender: TObject);
    123174begin
    124175  FConnected := False;
    … …  
    130181end;
    131182
    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);
     183procedure TSunriseChatNetworkCore.IdTCPServer1Execute(AContext: TIdContext);
     184var
     185  Text: string;
     186begin
     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;
     197end;
     198
     199procedure TSunriseChatNetworkCore.IdUDPServer1UDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
    152200var
    153201  Text: string;
    154202  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;
     204begin
     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
    175211  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;
    179219  end;
    180220end;
    … …  
    274314procedure TSunriseChatNetworkCore.SendCommandToNetwork(const S: string);
    275315begin
    276   if FConnected then fndTCPClient1.Socket.SendStr(S);
     316  if FConnected then IdTCPClient1.IOHandler.WriteLn(S);
    277317end;
    278318
    … …  
    301341var
    302342  I, II: Integer;
     343  SocketBinding: TIdSocketHandle;
    303344const
    304345  Stav: array [0..6] of string = ('Closed', 'Resolving', 'Resolved', 'Connecting',
    305346                  'Negotiating', 'Connected', 'Listening');
    306347begin
    307   fndTCPClient1.OnClose := nil;
     348  IdTCPClient1.OnDisconnected := nil;
    308349  FConnected := False;
    309350  try
    310     fndTCPClient1.Active := False;
    311     with fndTCPServer1 do begin
     351    IdTCPClient1.Disconnect;
     352    with IdTCPServer1 do begin
    312353      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;
    315357      try
    316358        Active := True;
    … …  
    318360      end;
    319361  //  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;
    327368      try
    328         fndUDPClientSocket1.Bind;
     369        IdUDPServer1.Active := True;
    329370      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;
    338382      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(*
    341387      I := 2;
    342388      repeat
    343         Active := False;
    344         LocalPort := IntToStr(UDPPort+I);
     389        Disconnect;
     390        //BoundPort := UDPPort + I;
    345391        I := I + 1;
    346392        try
    347           Active := True;
     393          Connect;
    348394        except
    349395        end;
    350396        II := 0;
    351         while (Socket.State in [ssResolving, ssNegotiating, ssConnecting]) and (II<100) do begin
     397        while (not Connected and (II < 100)) do begin
    352398          Application.ProcessMessages;
    353           //Sleep(10);
     399          Sleep(10);
    354400          II := II + 1;
    355401        end;
    356402  //     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;
    360407      //ShowMessage(IntToStr(Integer(fndTCPClient1.Socket.State))+','+BoolToStr(fndUDPClientSocket1.Bound)
    361408      //+','+BoolToStr(FConnected)+','+BoolToStr(fndTCPClient1.Socket.Connected));
    … …  
    367414    end;
    368415  finally
    369     fndTCPClient1.OnClose := fndTCPClient1Close;
     416    IdTCPClient1.OnDisconnected := IdTCPClient1Disconnect;
    370417  end;
    371418end;
    … …  
    374421begin
    375422  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;
    379427end;
    380428
Note: See TracChangeset for help on using the changeset viewer.