source: trunk/UNetworkTest.pas

Last change on this file was 13, checked in by george, 16 years ago

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ů.

  • Property svn:executable set to *
File size: 6.6 KB
Line 
1unit UNetworkTest;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, UPing, ComCtrls, StdCtrls, cUtils, cWinSock, Spin;
8
9type
10 TPingList = class(TThread)
11 private
12 { Private declarations }
13 protected
14 procedure Execute; override;
15 end;
16
17 TNetworkTest = class(TForm)
18 Button1: TButton;
19 ListView1: TListView;
20 Button2: TButton;
21 SpinEdit1: TSpinEdit;
22 Label1: TLabel;
23 ComboBox1: TComboBox;
24 procedure Button1Click(Sender: TObject);
25 procedure FormCreate(Sender: TObject);
26 procedure FormShow(Sender: TObject);
27 procedure Button2Click(Sender: TObject);
28 procedure CheckBox1Click(Sender: TObject);
29 procedure SpinEdit1Change(Sender: TObject);
30 procedure ComboBox1Change(Sender: TObject);
31 procedure FormDestroy(Sender: TObject);
32 private
33 { Private declarations }
34 public
35 PingList: TPingList;
36 Devices: array of record
37 ID: Integer;
38 IP: string;
39 Name: string;
40 Place: string;
41 Parent: Integer;
42 Sort: Integer;
43 end;
44 LocalPCID: Integer;
45 procedure RefreshList;
46 function IndexByID(WantedID: Integer): Integer;
47 end;
48
49var
50 NetworkTest: TNetworkTest;
51
52implementation
53
54uses UMainWindow, ULocalization;
55
56{$R *.dfm}
57
58procedure TNetworkTest.Button1Click(Sender: TObject);
59begin
60 Close;
61end;
62
63procedure TNetworkTest.FormCreate(Sender: TObject);
64
65var
66 Soubor: TextFile;
67 Row: string;
68
69const
70 NetworkFileName = 'Network.cfg';
71
72function Parse: string;
73begin
74 Result:= Copy(Row,1,Pos(':',Row)-1);
75 Delete(Row,1,Length(Result)+1);
76end;
77
78begin
79 if MainWindow.OnTop then FormStyle := fsStayOnTop else FormStyle := fsNormal;
80 try
81 PingList := TPingList.Create(True);
82 ChDir(ExtractFileDir(Application.ExeName));
83 AssignFile(Soubor, NetworkFileName);
84 if FileExists(NetworkFileName) then Reset(Soubor) else begin
85 Rewrite(Soubor);
86 CloseFile(Soubor);
87 AssignFile(Soubor, NetworkFileName);
88 Reset(Soubor);
89 end;
90 SetLength(Devices, 1);
91 while not Eof(Soubor) do begin
92 ReadLn(Soubor, Row);
93 SetLength(Devices, Length(Devices) + 1);
94 with MainWindow.SunriseChatNetworkCore1, Devices[High(Devices)] do begin
95 TryStrToInt(Parse,ID);
96 TryStrToInt(Parse, Parent);
97 Name := Parse;
98 IP := Parse;
99 //ShowMessage(IntToStr(networkInterfaceIndex));
100 //+' '+IntToStr(Length(NetworkInterfaces)));
101 if IP = ActiveNetworkInterface.IPAddress then
102 LocalPCID := ID;
103 Place := Parse;
104 TryStrToInt(Row, Sort);
105 end;
106 end;
107 finally
108 CloseFile(Soubor);
109 SpinEdit1.Value:= MainWindow.PingTimeout;
110 end;
111end;
112
113procedure TNetworkTest.FormDestroy(Sender: TObject);
114begin
115 PingList.Free;
116end;
117
118procedure TNetworkTest.FormShow(Sender: TObject);
119begin
120 ComboBox1.Visible:= MainWindow.ServiceFunction;
121 RefreshList;
122 PingList.Resume;
123 with Localization do begin
124 Button2.Caption:= Item('PerformTest');
125 Button1.Caption:= Item('Close');
126 //CheckBox1.Caption:= Item('ShowAllHosts');
127 NetworkTest.Caption:= Item('NetworkTest');
128 ListView1.Columns[0].Caption:= Item('Host');
129 ListView1.Columns[1].Caption:= Item('IPAddress');
130 ListView1.Columns[2].Caption:= Item('Location');
131 ListView1.Columns[3].Caption:= Item('Status');
132 end;
133end;
134
135{ TPingList }
136
137procedure TPingList.Execute;
138var
139 I: Integer;
140begin
141 with NetworkTest do begin
142 ListView1.SetFocus;
143// ListView1.Items.BeginUpdate;
144 for I:= 0 to ListView1.Items.Count-1 do with ListView1.Items[I] do begin
145 Selected:= True;
146 Focused:= True;
147 if Ping(SubItems[0],MainWindow.PingTimeout) then SubItems[2]:= 'Ok' else SubItems[2]:= 'Nedostupný';
148 Focused:= False;
149 Selected:= False;
150 if Terminated then Break;
151 end;
152// ListView1.Items.EndUpdate;
153 Button2.Enabled:= True;
154 Button2.Caption:= Localization.Item('PerformTest');
155 ComboBox1.Enabled:= True;
156 end;
157end;
158
159procedure TNetworkTest.Button2Click(Sender: TObject);
160begin
161 with Localization do
162 if Button2.Caption = Item('PerformTest') then begin
163 Button2.Caption:= Item('Break');
164 ComboBox1.Enabled:= False;
165 ListView1.SetFocus;
166 PingList.Free;
167 PingList:= TPingList.Create(True);
168 PingList.Resume;
169 end else begin
170 PingList.Terminate;
171 Button2.Caption:= Item('PerformTest');
172 Button2.Enabled:= False;
173 end;
174end;
175
176procedure TNetworkTest.RefreshList;
177var
178 I: Integer;
179 Item: TListItem;
180begin
181 ListView1.Items.BeginUpdate;
182 ListView1.Items.Clear;
183 case ComboBox1.ItemIndex of
184 0: begin
185 // Show only devices between this computer and internet
186 I:= IndexByID(LocalPCID);
187 while I<>0 do with Devices[I] do begin
188 Item:= ListView1.Items.Add;
189 Item.Caption:= Name;
190 with Item.SubItems do begin
191 Add(IP);
192 Add(Place);
193 Add('');
194 end;
195 I:= IndexByID(Devices[I].Parent);
196 end;
197 end;
198 1: begin
199 // Show hosts
200 for I:= 1 to High(Devices) do with Devices[I] do
201 if Sort = 0 then
202 begin
203 Item:= ListView1.Items.Add;
204 Item.Caption:= Name;
205 with Item.SubItems do begin
206 Add(IP);
207 Add(Place);
208 Add('');
209 end;
210 end;
211 end;
212 2: begin
213 // Show only devices
214 for I:= 1 to High(Devices) do with Devices[I] do
215 if Sort = 1 then
216 begin
217 Item:= ListView1.Items.Add;
218 Item.Caption:= Name;
219 with Item.SubItems do begin
220 Add(IP);
221 Add(Place);
222 Add('');
223 end;
224 end;
225 end;
226 3: begin
227 // 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;
231 with Item.SubItems do begin
232 Add(IP);
233 Add(Place);
234 Add('');
235 end;
236 end;
237 end;
238 end;
239 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);
243end;
244
245procedure TNetworkTest.CheckBox1Click(Sender: TObject);
246begin
247 RefreshList;
248end;
249
250procedure TNetworkTest.SpinEdit1Change(Sender: TObject);
251begin
252 MainWindow.PingTimeout := SpinEdit1.Value;
253end;
254
255procedure TNetworkTest.ComboBox1Change(Sender: TObject);
256begin
257 RefreshList;
258end;
259
260function TNetworkTest.IndexByID(WantedID: Integer): Integer;
261var
262 I: Integer;
263begin
264 for I:= 0 to High(Devices) do if Devices[I].ID = WantedID then Break;
265 Result:= I;
266end;
267
268end.
Note: See TracBrowser for help on using the repository browser.