Changeset 13
- Timestamp:
- Feb 11, 2008, 2:14:42 PM (17 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/SunriseChat.dpr
r12 r13 5 5 uses 6 6 Forms, 7 Dialogs, 7 8 UMainWindow in 'UMainWindow.pas' {MainWindow}, 8 9 UAutoRegistry in 'UAutoRegistry.pas', … … 16 17 ULocalization in 'ULocalization.pas' {Localization: TDataModule}, 17 18 UTextFileStream in 'UTextFileStream.pas', 18 UJobProgressView in 'UJobProgressView.pas' {JobProgressView}; 19 UJobProgressView in 'UJobProgressView.pas' {JobProgressView}, 20 UProtocolMessageLog in 'UProtocolMessageLog.pas' {ProtocolMessageLogForm}; 19 21 20 22 {$R *.res} … … 27 29 Application.CreateForm(TLogExceptions, LogExceptions); 28 30 Application.CreateForm(TJobProgressView, JobProgressView); 31 Application.CreateForm(TProtocolMessageLogForm, ProtocolMessageLogForm); 29 32 LogExceptions.AppVersion := ClientVersion; 30 33 LogExceptions.AppReleaseDate := ClientReleaseDate; -
trunk/SunriseChatCoreUnit.pas
r12 r13 170 170 implementation 171 171 172 uses 173 UProtocolMessageLog; 174 172 175 procedure Register; 173 176 begin … … 279 282 Seq := StrToInt(Parse); // sequence command number 280 283 281 284 ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: ' + Text); 282 285 // Load source user data 283 286 if SameClientId(TargetUser.Id, LocalUser.Id) then begin … … 298 301 if Seq <> (SourceUser.Sequence + 1) then ErrorCount := ErrorCount + 1; 299 302 Sequence := Seq; 303 ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UpdateUser '); 300 304 UpdateUser(SourceUser); 301 305 … … 442 446 if (Part <> Nick) and (NickTime <> 0) then AddMessage(aeUserChangeNick, nil, [Nick, Part]); 443 447 FNick := Part; 448 ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UserInfo ' + FNick); 444 449 NickTime := StrToDateTime(Parse); 445 450 Color := StrToInt(Parse); … … 587 592 end; 588 593 end; 594 if Assigned(ProtocolMessageLogForm) then 595 ProtocolMessageLogForm.Memo1.Lines.Add('SendCommand: ' + Data); 589 596 if Assigned(FOnSendCommand) then FOnSendCommand(Data + #13); 590 597 end; … … 637 644 end; 638 645 639 procedure TSunriseChatCore.AddMessage(MessageEventType: TAppEventType; Room: TRoom; const Args: array of const); 646 procedure TSunriseChatCore.AddMessage(MessageEventType: TAppEventType; 647 Room: TRoom; const Args: array of const); 640 648 var 641 649 NewRoomLine: TRoomLine; -
trunk/SunriseChatCoreUtils.pas
r11 r13 60 60 end; 61 61 62 function Explode(Separator: Char; 63 Data: string): TArrayOfString; 62 function Explode(Separator: Char; Data: string): TArrayOfString; 64 63 begin 65 SetLength(Result, 0);66 while Pos(Separator, Data)>0 do begin67 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)); 70 69 end; 71 SetLength(Result, Length(Result) +1);72 Result[High(Result)] := Data;70 SetLength(Result, Length(Result) + 1); 71 Result[High(Result)] := Data; 73 72 end; 74 73 -
trunk/SunriseChatNetworkCoreUnit.pas
r11 r13 80 80 81 81 uses 82 IpHlpApi, IpTypes ;82 IpHlpApi, IpTypes, Dialogs, UProtocolMessageLog; 83 83 84 84 procedure Register; … … 137 137 if Sender.Socket.InBufferSize > 0 then begin 138 138 Data := Sender.Socket.ReadAvailable; 139 ProtocolMessageLogForm.Memo1.Lines.Add('TCPClientDataAvailable: ' + Data); 139 140 if Pos(#13, Data) > 0 then begin 140 141 repeat … … 151 152 var 152 153 Text: string; 154 I: Integer; 153 155 begin 154 156 if Sender.Socket.InBufferSize > 0 then begin 155 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); 156 161 if BroadcastType = btGlobal then 157 162 fndUDPClientSocket1.Broadcast(IntToStr(UDPPort), Text) else … … 166 171 Address : TSockAddr; 167 172 I: Integer; 168 LocalIPs: TInAddrArray; 169 begin 173 begin 174 ProtocolMessageLogForm.Memo1.Lines.Add('UDBClientDataAvailable: ' + Text); 170 175 if FConnected then begin 171 176 Sender.ReadPacket(Text, Address); 172 for I := 0 to fndTCPServer1.ClientCount -1 do177 for I := 0 to fndTCPServer1.ClientCount - 1 do 173 178 with fndTCPServer1.Client[I] do Socket.SendStr(Text); 174 179 end; … … 192 197 var 193 198 I, II: Integer; 194 Status: Cardinal;195 199 AdaptersList : array of IP_ADAPTER_INFO; 196 200 BufSize: Cardinal; … … 218 222 // Windows NT/2000/XP/Vista 219 223 BufSize := 0; 220 Status :=GetAdaptersInfo(@AdaptersList[0], BufSize);224 GetAdaptersInfo(@AdaptersList[0], BufSize); 221 225 SetLength(AdaptersList, BufSize div SizeOf(IP_ADAPTER_INFO)); 222 Status :=GetAdaptersInfo(@AdaptersList[0], BufSize);226 GetAdaptersInfo(@AdaptersList[0], BufSize); 223 227 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); 235 243 end; 236 NetworkInterfaces.Add(NewNetworkInterface);237 244 end; 238 245 end else begin -
trunk/UAutoRegistry.pas
r2 r13 30 30 31 31 implementation 32 33 uses 34 Dialogs, SysUtils; 32 35 33 36 constructor TAutoRegistry.Create(Path: string); … … 82 85 OpenKey(FPath, True); 83 86 for I:= 0 to High(FItems) do with FItems[I] do begin 84 if Typ =1 then WriteInteger(Nazev,Integer(Data^)) else85 if Typ =3 then WriteBool(Nazev,Boolean(Data^)) else86 if Typ =4 then WriteFloat(Nazev,real(Data^)) else87 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^)); 88 91 end; 89 92 finally -
trunk/UMainWindow.dfm
r12 r13 3 3 Top = 296 4 4 Caption = 'SunriseChat' 5 ClientHeight = 3 525 ClientHeight = 372 6 6 ClientWidth = 471 7 7 Color = clBtnFace … … 28 28 Top = 0 29 29 Width = 471 30 Height = 3 5230 Height = 372 31 31 Align = alClient 32 32 BevelOuter = bvNone 33 33 FullRepaint = False 34 34 TabOrder = 0 35 ExplicitHeight = 352 35 36 object Splitter3: TSplitter 36 37 Left = 323 37 38 Top = 0 38 39 Width = 2 39 Height = 3 2240 Height = 342 40 41 Align = alRight 41 42 ExplicitLeft = 322 … … 44 45 object Panel4: TPanel 45 46 Left = 0 46 Top = 3 2247 Top = 342 47 48 Width = 471 48 49 Height = 30 … … 51 52 FullRepaint = False 52 53 TabOrder = 0 54 ExplicitTop = 322 53 55 DesignSize = ( 54 56 471 … … 89 91 Top = 0 90 92 Width = 26 91 Height = 3 2293 Height = 342 92 94 Align = alRight 93 95 BevelOuter = bvNone 94 96 TabOrder = 1 97 ExplicitHeight = 322 95 98 object ToolBar1: TToolBar 96 99 Left = 0 97 Top = 1 68100 Top = 188 98 101 Width = 26 99 102 Height = 154 … … 106 109 TabOrder = 0 107 110 Transparent = False 111 ExplicitTop = 168 108 112 object ToolButton1: TToolButton 109 113 Left = 0 … … 178 182 Top = 0 179 183 Width = 120 180 Height = 3 22184 Height = 342 181 185 Align = alRight 182 186 BevelOuter = bvNone 183 187 FullRepaint = False 184 188 TabOrder = 2 189 ExplicitHeight = 322 185 190 DesignSize = ( 186 191 120 187 3 22)192 342) 188 193 object Label1: TLabel 189 194 Left = 2 … … 197 202 Top = 20 198 203 Width = 116 199 Height = 299204 Height = 319 200 205 Hint = 'Seznam online u'#382'ivatel'#367 201 206 Anchors = [akLeft, akTop, akRight, akBottom] … … 212 217 OnClick = ListView1Click 213 218 OnInfoTip = ListView1InfoTip 219 ExplicitHeight = 299 214 220 end 215 221 end … … 218 224 Top = 0 219 225 Width = 323 220 Height = 3 22226 Height = 342 221 227 Align = alClient 222 228 BevelOuter = bvNone 223 229 FullRepaint = False 224 230 TabOrder = 3 231 ExplicitHeight = 322 225 232 DesignSize = ( 226 233 323 227 3 22)234 342) 228 235 object Label2: TLabel 229 236 Left = 8 … … 246 253 Top = 0 247 254 Width = 317 248 Height = 2 30255 Height = 250 249 256 ActivePage = TabSheet1 250 257 Anchors = [akLeft, akTop, akRight, akBottom] … … 259 266 TabOrder = 1 260 267 OnChange = TabControl1Change 268 ExplicitHeight = 230 261 269 object TabSheet1: TTabSheet 262 270 Caption = 'TabSheet1' … … 268 276 ImageIndex = 1 269 277 ParentFont = False 278 ExplicitHeight = 201 270 279 end 271 280 end … … 274 283 Top = 20 275 284 Width = 317 276 Height = 3 00285 Height = 320 277 286 Anchors = [akLeft, akTop, akRight, akBottom] 278 287 BevelOuter = bvNone … … 282 291 TabOrder = 0 283 292 OnResize = Panel6Resize 293 ExplicitHeight = 300 284 294 object ListView2: TListView 285 295 Left = 0 286 296 Top = 0 287 297 Width = 317 288 Height = 3 00298 Height = 320 289 299 Align = alClient 290 300 Columns = <> 291 301 TabOrder = 1 302 ExplicitHeight = 300 292 303 end 293 304 object RichView1: TRichView … … 1913 1924 Action = ActionAbout 1914 1925 end 1926 object Log1: TMenuItem 1927 Caption = 'Log' 1928 OnClick = Log1Click 1929 end 1915 1930 end 1916 1931 object PopupMenu5: TPopupMenu … … 2003 2018 Top = 112 2004 2019 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 2005 2028 end -
trunk/UMainWindow.pas
r12 r13 179 179 OpenDialog1: TOpenDialog; 180 180 XPManifest1: TXPManifest; 181 Log1: TMenuItem; 182 fndUDPSocket1: TfndUDPSocket; 183 fndUDPClientSocket1: TfndUDPClientSocket; 181 184 procedure FormCreate(Sender: TObject); 185 procedure FormShow(Sender: TObject); 182 186 procedure Vloitsovodkaz1Click(Sender: TObject); 183 187 procedure RichView1Jump(Sender: TObject; id: Integer); … … 185 189 procedure Koprovar1Click(Sender: TObject); 186 190 procedure Button1Click(Sender: TObject); 187 procedure FormShow(Sender: TObject);188 191 procedure Timer1Timer(Sender: TObject); 189 192 procedure ComboBox1KeyPress(Sender: TObject; var Key: Char); … … 241 244 procedure FormDestroy(Sender: TObject); 242 245 procedure FormClose(Sender: TObject; var Action: TCloseAction); 246 procedure Log1Click(Sender: TObject); 243 247 private 244 248 CloseEnabled: Boolean; … … 331 335 332 336 uses UInfoWindow, UAboutWindow, UOptionsWindow, UNetworkTest, UNewRoom, 333 DateUtils, ULocalization, UJobProgressView, MMSystem ;337 DateUtils, ULocalization, UJobProgressView, MMSystem, UProtocolMessageLog; 334 338 335 339 {$R *.dfm} … … 402 406 MaxRoomLines := 100; 403 407 end; 408 404 409 405 410 SettingsName := ''; … … 1489 1494 if Assigned(JobProgressView) then JobProgressView.Progress := I / AppUserEventsCount; 1490 1495 end; 1496 end; 1497 1498 procedure TMainWindow.Log1Click(Sender: TObject); 1499 begin 1500 ProtocolMessageLogForm.Show; 1491 1501 end; 1492 1502 -
trunk/UNetworkTest.pas
r12 r13 226 226 3: begin 227 227 // Show all items 228 for I := 1 to High(Devices) do with Devices[I] do begin229 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; 231 231 with Item.SubItems do begin 232 232 Add(IP); … … 238 238 end; 239 239 ListView1.Items.EndUpdate; 240 if ListView1.Items.Count > 4 then Height := ListView1.Items.Count*14 + 97241 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); 243 243 end; 244 244 … … 250 250 procedure TNetworkTest.SpinEdit1Change(Sender: TObject); 251 251 begin 252 MainWindow.PingTimeout := SpinEdit1.Value;252 MainWindow.PingTimeout := SpinEdit1.Value; 253 253 end; 254 254
Note:
See TracChangeset
for help on using the changeset viewer.