source: tags/2.10/UNetworkTest.pas

unit UNetworkTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UPing, ComCtrls, StdCtrls, cUtils, cWinSock, Spin;

type
  TPingList = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

  TNetworkTest = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    PingList: TPingList;
    Devices: array of record
      ID: Integer;
      IP: string;
      Name: string;
      Place: string;
      Parent: Integer;
      Sort: Integer;
    end;
    LocalPCID: Integer;
    procedure RefreshList;
    function IndexByID(WantedID: Integer): Integer;
  end;

var
  NetworkTest: TNetworkTest;

implementation

uses UMainWindow, ULocalization, USunriseChatCore;

{$R *.dfm}

procedure TNetworkTest.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TNetworkTest.FormCreate(Sender: TObject);

var
  Soubor: TextFile;
  Row: string;

function Parse: string;
begin
  Result:= Copy(Row,1,Pos(':',Row)-1);
  Delete(Row,1,Length(Result)+1);
end;

begin
  if MainWindow.OnTop then FormStyle:= fsStayOnTop else FormStyle:= fsNormal;
  try
    PingList:= TPingList.Create(True);
    ChDir(ExtractFileDir(Application.ExeName));
    AssignFile(Soubor,'Network.cfg');
    Reset(Soubor);
    SetLength(Devices,1);
    while not Eof(Soubor) do begin
      ReadLn(Soubor,Row);
      SetLength(Devices,Length(Devices)+1);
      with SunriseChatCore, Devices[High(Devices)] do begin
        TryStrToInt(Parse,ID);
        TryStrToInt(Parse,Parent);
        Name:= Parse;
        IP:= Parse;
        if IP = NetworkInterfaces[NetworkInterfaceIndex].IPAddress then
          LocalPCID:= ID;
        Place:= Parse;
        TryStrToInt(Row,Sort);
      end;
     end;
  finally
    CloseFile(Soubor);
    SpinEdit1.Value:= MainWindow.PingTimeout;
  end;
end;

procedure TNetworkTest.FormShow(Sender: TObject);
begin
  ComboBox1.Visible:= MainWindow.ServiceFunction;
  RefreshList;
  PingList.Resume;
  with Localization do begin
    Button2.Caption:= Item('PerformTest');
    Button1.Caption:= Item('Close');
    //CheckBox1.Caption:= Item('ShowAllHosts');
    NetworkTest.Caption:= Item('NetworkTest');
    ListView1.Columns[0].Caption:= Item('Host');
    ListView1.Columns[1].Caption:= Item('IPAddress');
    ListView1.Columns[2].Caption:= Item('Location');
    ListView1.Columns[3].Caption:= Item('Status');
  end;
end;

{ TPingList }

procedure TPingList.Execute;
var
  I: Integer;
begin
  with NetworkTest do begin
    ListView1.SetFocus;
//    ListView1.Items.BeginUpdate;
    for I:= 0 to ListView1.Items.Count-1 do with ListView1.Items[I] do begin
      Selected:= True;
      Focused:= True;
      if Ping(SubItems[0],MainWindow.PingTimeout) then SubItems[2]:= 'Ok' else SubItems[2]:= 'Nedostupný';
      Focused:= False;
      Selected:= False;
      if Terminated then Break;
    end;
//    ListView1.Items.EndUpdate;
    Button2.Enabled:= True;
    Button2.Caption:= Localization.Item('PerformTest');
    ComboBox1.Enabled:= True;
  end;
end;

procedure TNetworkTest.Button2Click(Sender: TObject);
begin
  with Localization do
  if Button2.Caption = Item('PerformTest') then begin
    Button2.Caption:= Item('Break');
    ComboBox1.Enabled:= False;
    ListView1.SetFocus;
    PingList.Free;
    PingList:= TPingList.Create(True);
    PingList.Resume;
  end else begin
    PingList.Terminate;
    Button2.Caption:= Item('PerformTest');
    Button2.Enabled:= False;
  end;
end;

procedure TNetworkTest.RefreshList;
var
  I: Integer;
  Item: TListItem;
begin
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  case ComboBox1.ItemIndex of
  0: begin
    // Show only devices between this computer and internet
    I:= IndexByID(LocalPCID);
    while I<>0 do with Devices[I] do begin
      Item:= ListView1.Items.Add;
      Item.Caption:= Name;
      with Item.SubItems do begin
        Add(IP);
        Add(Place);
        Add('');
      end;
      I:= IndexByID(Devices[I].Parent);
    end;
  end;
  1: begin
    // Show hosts
    for I:= 1 to High(Devices) do with Devices[I] do
    if Sort = 0 then
    begin
      Item:= ListView1.Items.Add;
      Item.Caption:= Name;
      with Item.SubItems do begin
        Add(IP);
        Add(Place);
        Add('');
      end;
    end;
  end;
  2: begin
    // Show only devices
    for I:= 1 to High(Devices) do with Devices[I] do
    if Sort = 1 then
    begin
      Item:= ListView1.Items.Add;
      Item.Caption:= Name;
      with Item.SubItems do begin
        Add(IP);
        Add(Place);
        Add('');
      end;
    end;
  end;
  3: begin
    // Show all items
    for I:= 1 to High(Devices) do with Devices[I] do begin
      Item:= ListView1.Items.Add;
      Item.Caption:= Name;
      with Item.SubItems do begin
        Add(IP);
        Add(Place);
        Add('');
      end;
    end;
  end;
  end;
  ListView1.Items.EndUpdate;
  if ListView1.Items.Count > 4 then Height:= ListView1.Items.Count*14 + 97
    else Height:= 4*14 + 97;
  if Height > (Screen.Height-50) then Height:= (Screen.Height-50);
end;

procedure TNetworkTest.CheckBox1Click(Sender: TObject);
begin
  RefreshList;
end;

procedure TNetworkTest.SpinEdit1Change(Sender: TObject);
begin
  MainWindow.PingTimeout:= SpinEdit1.Value;
end;

procedure TNetworkTest.ComboBox1Change(Sender: TObject);
begin
  RefreshList;
end;

function TNetworkTest.IndexByID(WantedID: Integer): Integer;
var
  I: Integer;
begin
  for I:= 0 to High(Devices) do if Devices[I].ID = WantedID then Break;
  Result:= I;
end;

end.