Changeset 13 for trunk


Ignore:
Timestamp:
Feb 11, 2008, 2:14:42 PM (17 years ago)
Author:
george
Message:

Opraveno: Načítání seznamu síťových adaptérů na Linuxu.
Přidáno: Úpravy pro potřeby ladění problému s nepřijímáním UDP paketů.

Location:
trunk
Files:
2 added
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/SunriseChat.dpr

    r12 r13  
    55uses
    66  Forms,
     7  Dialogs,
    78  UMainWindow in 'UMainWindow.pas' {MainWindow},
    89  UAutoRegistry in 'UAutoRegistry.pas',
    … …  
    1617  ULocalization in 'ULocalization.pas' {Localization: TDataModule},
    1718  UTextFileStream in 'UTextFileStream.pas',
    18   UJobProgressView in 'UJobProgressView.pas' {JobProgressView};
     19  UJobProgressView in 'UJobProgressView.pas' {JobProgressView},
     20  UProtocolMessageLog in 'UProtocolMessageLog.pas' {ProtocolMessageLogForm};
    1921
    2022{$R *.res}
    … …  
    2729  Application.CreateForm(TLogExceptions, LogExceptions);
    2830  Application.CreateForm(TJobProgressView, JobProgressView);
     31  Application.CreateForm(TProtocolMessageLogForm, ProtocolMessageLogForm);
    2932  LogExceptions.AppVersion := ClientVersion;
    3033  LogExceptions.AppReleaseDate := ClientReleaseDate;

  • trunk/SunriseChatCoreUnit.pas

    r12 r13  
    170170implementation
    171171
     172uses
     173  UProtocolMessageLog;
     174
    172175procedure Register;
    173176begin
    … …  
    279282        Seq := StrToInt(Parse);       // sequence command number
    280283
    281 
     284        ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: ' + Text);
    282285        // Load source user data
    283286        if SameClientId(TargetUser.Id, LocalUser.Id) then begin
    … …  
    298301        if Seq <> (SourceUser.Sequence + 1) then ErrorCount := ErrorCount + 1;
    299302        Sequence := Seq;
     303        ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UpdateUser ');
    300304        UpdateUser(SourceUser);
    301305
    … …  
    442446              if (Part <> Nick) and (NickTime <> 0) then AddMessage(aeUserChangeNick, nil, [Nick, Part]);
    443447              FNick := Part;
     448              ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UserInfo ' + FNick);
    444449              NickTime := StrToDateTime(Parse);
    445450              Color := StrToInt(Parse);
    … …  
    587592      end;
    588593    end;
     594    if Assigned(ProtocolMessageLogForm) then
     595      ProtocolMessageLogForm.Memo1.Lines.Add('SendCommand: ' + Data);
    589596    if Assigned(FOnSendCommand) then FOnSendCommand(Data + #13);
    590597  end;
    … …  
    637644end;
    638645
    639 procedure TSunriseChatCore.AddMessage(MessageEventType: TAppEventType; Room: TRoom; const Args: array of const);
     646procedure TSunriseChatCore.AddMessage(MessageEventType: TAppEventType;
     647  Room: TRoom; const Args: array of const);
    640648var
    641649  NewRoomLine: TRoomLine;

  • trunk/SunriseChatCoreUtils.pas

    r11 r13  
    6060end;
    6161
    62 function Explode(Separator: Char;
    63   Data: string): TArrayOfString;
     62function Explode(Separator: Char; Data: string): TArrayOfString;
    6463begin
    65   SetLength(Result,0);
    66   while Pos(Separator,Data)>0 do begin
    67     SetLength(Result, Length(Result)+1);
    68     Result[High(Result)]:= Copy(Data,1,Pos(Separator,Data)-1);
    69     Delete(Data,1,Pos(Separator,Data));
     64  SetLength(Result, 0);
     65  while Pos(Separator, Data) > 0 do begin
     66    SetLength(Result, Length(Result) + 1);
     67    Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1);
     68    Delete(Data, 1, Pos(Separator, Data));
    7069  end;
    71   SetLength(Result, Length(Result)+1);
    72   Result[High(Result)]:= Data;
     70  SetLength(Result, Length(Result) + 1);
     71  Result[High(Result)] := Data;
    7372end;
    7473

  • trunk/SunriseChatNetworkCoreUnit.pas

    r11 r13  
    8080
    8181uses
    82   IpHlpApi, IpTypes;
     82  IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog;
    8383
    8484procedure Register;
    … …  
    137137  if Sender.Socket.InBufferSize > 0 then begin
    138138    Data := Sender.Socket.ReadAvailable;
     139    ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data);
    139140    if Pos(#13, Data) > 0 then begin
    140141      repeat
    … …  
    151152var
    152153  Text: string;
     154  I: Integer;
    153155begin
    154156  if Sender.Socket.InBufferSize > 0 then begin
    155157    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);
    156161    if BroadcastType = btGlobal then
    157162      fndUDPClientSocket1.Broadcast(IntToStr(UDPPort), Text) else
    … …  
    166171  Address : TSockAddr;
    167172  I: Integer;
    168   LocalIPs: TInAddrArray;
    169 begin
     173begin
     174  ProtocolMessageLogForm.Memo1.Lines.Add('UDBClientDataAvailable: ' + Text);
    170175  if FConnected then begin
    171176    Sender.ReadPacket(Text, Address);
    172     for I := 0 to fndTCPServer1.ClientCount-1 do
     177    for I := 0 to fndTCPServer1.ClientCount - 1 do
    173178      with fndTCPServer1.Client[I] do Socket.SendStr(Text);
    174179  end;
    … …  
    192197var
    193198  I, II: Integer;
    194   Status: Cardinal;
    195199  AdaptersList : array of IP_ADAPTER_INFO;
    196200  BufSize: Cardinal;
    … …  
    218222    // Windows NT/2000/XP/Vista
    219223    BufSize := 0;
    220     Status := GetAdaptersInfo(@AdaptersList[0], BufSize);
     224    GetAdaptersInfo(@AdaptersList[0], BufSize);
    221225    SetLength(AdaptersList, BufSize div SizeOf(IP_ADAPTER_INFO));
    222     Status := GetAdaptersInfo(@AdaptersList[0], BufSize);
     226    GetAdaptersInfo(@AdaptersList[0], BufSize);
    223227    for I := 0 to High(AdaptersList) do with AdaptersList[I] do begin
    224       NewNetworkInterface := TNetworkInterface.Create(Self);
    225       with NewNetworkInterface do begin
    226         IPAddress := IpAddressList.IPAddress.S;
    227         SubNetMask := IpAddressList.IPMask.s;
    228         GUID := AdapterName;
    229         Name := Description;
    230         SubnetParts := Explode('.', SubNetMask);
    231         IPParts := Explode('.', IPAddress);
    232         for II := 0 to 3 do
    233           IPParts[II] := IntToStr(StrToInt(IPParts[II]) or (StrToInt(SubnetParts[II]) xor $ff));
    234         BroadcastIPAddress := IPParts[0]+'.'+IPParts[1]+'.'+IPParts[2]+'.'+IPParts[3];
     228      if IpAddressList.IPAddress.S <> '' then begin
     229        NewNetworkInterface := TNetworkInterface.Create(Self);
     230        with NewNetworkInterface do begin
     231          IPAddress := IpAddressList.IPAddress.S;
     232          SubNetMask := IpAddressList.IPMask.s;
     233          GUID := AdapterName;
     234          Name := Description;
     235          if Name = '' then Name := 'Network adapter ' + IntToStr(I);
     236          SubnetParts := Explode('.', SubNetMask);
     237          IPParts := Explode('.', IPAddress);
     238          for II := 0 to 3 do
     239            IPParts[II] := IntToStr(StrToInt(IPParts[II]) or (StrToInt(SubnetParts[II]) xor $ff));
     240          BroadcastIPAddress := IPParts[0]+'.'+IPParts[1]+'.'+IPParts[2]+'.'+IPParts[3];
     241        end;
     242        NetworkInterfaces.Add(NewNetworkInterface);
    235243      end;
    236       NetworkInterfaces.Add(NewNetworkInterface);
    237244    end;
    238245  end else begin

  • trunk/UAutoRegistry.pas

    r2 r13  
    3030
    3131implementation
     32
     33uses
     34  Dialogs, SysUtils;
    3235
    3336constructor TAutoRegistry.Create(Path: string);
    … …  
    8285      OpenKey(FPath, True);
    8386      for I:= 0 to High(FItems) do with FItems[I] do begin
    84         if Typ=1 then WriteInteger(Nazev,Integer(Data^)) else
    85         if Typ=3 then WriteBool(Nazev,Boolean(Data^)) else
    86         if Typ=4 then WriteFloat(Nazev,real(Data^)) else
    87         if Typ=2 then WriteString(Nazev,string(Data^));
     87        if Typ = 1 then WriteInteger(Nazev,Integer(Data^)) else
     88        if Typ = 3 then WriteBool(Nazev,Boolean(Data^)) else
     89        if Typ = 4 then WriteFloat(Nazev, real(Data^)) else
     90        if Typ = 2 then WriteString(Nazev, string(Data^));
    8891      end;
    8992    finally

  • trunk/UMainWindow.dfm

    r12 r13  
    33  Top = 296
    44  Caption = 'SunriseChat'
    5   ClientHeight = 352
     5  ClientHeight = 372
    66  ClientWidth = 471
    77  Color = clBtnFace
    … …  
    2828    Top = 0
    2929    Width = 471
    30     Height = 352
     30    Height = 372
    3131    Align = alClient
    3232    BevelOuter = bvNone
    3333    FullRepaint = False
    3434    TabOrder = 0
     35    ExplicitHeight = 352
    3536    object Splitter3: TSplitter
    3637      Left = 323
    3738      Top = 0
    3839      Width = 2
    39       Height = 322
     40      Height = 342
    4041      Align = alRight
    4142      ExplicitLeft = 322
    … …  
    4445    object Panel4: TPanel
    4546      Left = 0
    46       Top = 322
     47      Top = 342
    4748      Width = 471
    4849      Height = 30
    … …  
    5152      FullRepaint = False
    5253      TabOrder = 0
     54      ExplicitTop = 322
    5355      DesignSize = (
    5456        471
    … …  
    8991      Top = 0
    9092      Width = 26
    91       Height = 322
     93      Height = 342
    9294      Align = alRight
    9395      BevelOuter = bvNone
    9496      TabOrder = 1
     97      ExplicitHeight = 322
    9598      object ToolBar1: TToolBar
    9699        Left = 0
    97         Top = 168
     100        Top = 188
    98101        Width = 26
    99102        Height = 154
    … …  
    106109        TabOrder = 0
    107110        Transparent = False
     111        ExplicitTop = 168
    108112        object ToolButton1: TToolButton
    109113          Left = 0
    … …  
    178182      Top = 0
    179183      Width = 120
    180       Height = 322
     184      Height = 342
    181185      Align = alRight
    182186      BevelOuter = bvNone
    183187      FullRepaint = False
    184188      TabOrder = 2
     189      ExplicitHeight = 322
    185190      DesignSize = (
    186191        120
    187         322)
     192        342)
    188193      object Label1: TLabel
    189194        Left = 2
    … …  
    197202        Top = 20
    198203        Width = 116
    199         Height = 299
     204        Height = 319
    200205        Hint = 'Seznam online u'#382'ivatel'#367
    201206        Anchors = [akLeft, akTop, akRight, akBottom]
    … …  
    212217        OnClick = ListView1Click
    213218        OnInfoTip = ListView1InfoTip
     219        ExplicitHeight = 299
    214220      end
    215221    end
    … …  
    218224      Top = 0
    219225      Width = 323
    220       Height = 322
     226      Height = 342
    221227      Align = alClient
    222228      BevelOuter = bvNone
    223229      FullRepaint = False
    224230      TabOrder = 3
     231      ExplicitHeight = 322
    225232      DesignSize = (
    226233        323
    227         322)
     234        342)
    228235      object Label2: TLabel
    229236        Left = 8
    … …  
    246253        Top = 0
    247254        Width = 317
    248         Height = 230
     255        Height = 250
    249256        ActivePage = TabSheet1
    250257        Anchors = [akLeft, akTop, akRight, akBottom]
    … …  
    259266        TabOrder = 1
    260267        OnChange = TabControl1Change
     268        ExplicitHeight = 230
    261269        object TabSheet1: TTabSheet
    262270          Caption = 'TabSheet1'
    … …  
    268276          ImageIndex = 1
    269277          ParentFont = False
     278          ExplicitHeight = 201
    270279        end
    271280      end
    … …  
    274283        Top = 20
    275284        Width = 317
    276         Height = 300
     285        Height = 320
    277286        Anchors = [akLeft, akTop, akRight, akBottom]
    278287        BevelOuter = bvNone
    … …  
    282291        TabOrder = 0
    283292        OnResize = Panel6Resize
     293        ExplicitHeight = 300
    284294        object ListView2: TListView
    285295          Left = 0
    286296          Top = 0
    287297          Width = 317
    288           Height = 300
     298          Height = 320
    289299          Align = alClient
    290300          Columns = <>
    291301          TabOrder = 1
     302          ExplicitHeight = 300
    292303        end
    293304        object RichView1: TRichView
    … …  
    19131924      Action = ActionAbout
    19141925    end
     1926    object Log1: TMenuItem
     1927      Caption = 'Log'
     1928      OnClick = Log1Click
     1929    end
    19151930  end
    19161931  object PopupMenu5: TPopupMenu
    … …  
    20032018    Top = 112
    20042019  end
     2020  object fndUDPSocket1: TfndUDPSocket
     2021    Left = 48
     2022    Top = 216
     2023  end
     2024  object fndUDPClientSocket1: TfndUDPClientSocket
     2025    Left = 144
     2026    Top = 232
     2027  end
    20052028end

  • trunk/UMainWindow.pas

    r12 r13  
    179179    OpenDialog1: TOpenDialog;
    180180    XPManifest1: TXPManifest;
     181    Log1: TMenuItem;
     182    fndUDPSocket1: TfndUDPSocket;
     183    fndUDPClientSocket1: TfndUDPClientSocket;
    181184    procedure FormCreate(Sender: TObject);
     185    procedure FormShow(Sender: TObject);
    182186    procedure Vloitsovodkaz1Click(Sender: TObject);
    183187    procedure RichView1Jump(Sender: TObject; id: Integer);
    … …  
    185189    procedure Koprovar1Click(Sender: TObject);
    186190    procedure Button1Click(Sender: TObject);
    187     procedure FormShow(Sender: TObject);
    188191    procedure Timer1Timer(Sender: TObject);
    189192    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    … …  
    241244    procedure FormDestroy(Sender: TObject);
    242245    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     246    procedure Log1Click(Sender: TObject);
    243247  private
    244248    CloseEnabled: Boolean;
    … …  
    331335
    332336uses UInfoWindow, UAboutWindow, UOptionsWindow, UNetworkTest, UNewRoom,
    333   DateUtils, ULocalization, UJobProgressView, MMSystem;
     337  DateUtils, ULocalization, UJobProgressView, MMSystem, UProtocolMessageLog;
    334338
    335339{$R *.dfm}
    … …  
    402406    MaxRoomLines := 100;
    403407  end;
     408
    404409
    405410  SettingsName := '';
    … …  
    14891494    if Assigned(JobProgressView) then JobProgressView.Progress := I / AppUserEventsCount;
    14901495  end;
     1496end;
     1497
     1498procedure TMainWindow.Log1Click(Sender: TObject);
     1499begin
     1500  ProtocolMessageLogForm.Show;
    14911501end;
    14921502

  • trunk/UNetworkTest.pas

    r12 r13  
    226226  3: begin
    227227    // Show all items
    228     for I:= 1 to High(Devices) do with Devices[I] do begin
    229       Item:= ListView1.Items.Add;
    230       Item.Caption:= Name;
     228    for I := 1 to High(Devices) do with Devices[I] do begin
     229      Item := ListView1.Items.Add;
     230      Item.Caption := Name;
    231231      with Item.SubItems do begin
    232232        Add(IP);
    … …  
    238238  end;
    239239  ListView1.Items.EndUpdate;
    240   if ListView1.Items.Count > 4 then Height:= ListView1.Items.Count*14 + 97
    241     else Height:= 4*14 + 97;
    242   if Height > (Screen.Height-50) then Height:= (Screen.Height-50);
     240  if ListView1.Items.Count > 4 then Height := ListView1.Items.Count * 14 + 97
     241    else Height := 4 * 14 + 97;
     242  if Height > (Screen.Height - 50) then Height := (Screen.Height - 50);
    243243end;
    244244
    … …  
    250250procedure TNetworkTest.SpinEdit1Change(Sender: TObject);
    251251begin
    252   MainWindow.PingTimeout:= SpinEdit1.Value;
     252  MainWindow.PingTimeout := SpinEdit1.Value;
    253253end;
    254254
Note: See TracChangeset for help on using the changeset viewer.