source: trunk/UNetworkTest.pas

unit UNetworkTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UPing, ComCtrls, StdCtrls, cUtils, cWinSock, Spin,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

const
  NetworkListFile = 'NetworkList.txt';
  NetworkListURL = 'http://centrala.zdechov.net/sunrisechat/network.php';

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;
    IdHTTP1: TIdHTTP;
    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);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  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;
    function IndexByName(Name: string): Integer;
  end;

var
  NetworkTest: TNetworkTest;

implementation

uses  Math, UMainForm;

{$R *.dfm}

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

procedure TNetworkTest.FormCreate(Sender: TObject);
var
  Soubor: TextFile;
  Row: string;
  Hostname: string;
  LocalIp: string;
  WSAErr: string;

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

function NetworkListFilename: string;
begin
  Result := CommonAppDataPath + '\' + Creator + '\' + ApplicationName;
  if not DirectoryExists(Result) then
    ForceDirectories(Result);

  Result := Result + '\' + NetworkListFile;
end;

begin
  PingList := TPingList.Create(True);
  ChDir(ExtractFileDir(Application.ExeName));

  HostName := 'default';
  GetIPFromHost(Hostname, LocalIp, WSAErr);
  if LocalIp <> '127.0.0.1' then
  // Update list from internet
  if (Trunc(Now) <> Trunc(MainForm.NetworkTestLastUpdate)) or
  (not FileExists(NetworkListFilename)) then try
     Row := IdHTTP1.Get(NetworkListURL);
     AssignFile(Soubor, NetworkListFilename);
     Rewrite(Soubor);
     Write(Soubor, Row);
     CloseFile(Soubor);
   finally
   end;

  // Load from file
  try
    AssignFile(Soubor, NetworkListFilename);
    Reset(Soubor);
    SetLength(Devices, 1);
    while not Eof(Soubor) do begin
      ReadLn(Soubor, Row);
      SetLength(Devices, Length(Devices) + 1);
      with Devices[High(Devices)] do begin
        TryStrToInt(Parse,ID);
        TryStrToInt(Parse, Parent);
        Name := Parse;
        IP := Parse;
        //ShowMessage(IntToStr(networkInterfaceIndex));
        //+' '+IntToStr(Length(NetworkInterfaces)));
        //if IP = ActiveNetworkInterface.IPAddress then
        // LocalPCID := ID;
        Place := Parse;
        TryStrToInt(Row, Sort);
      end;
     end;
  finally
    CloseFile(Soubor);
    SpinEdit1.Value := MainForm.PingTimeout;
  end;
end;

procedure TNetworkTest.FormShow(Sender: TObject);
begin
  SpinEdit1.Value := MainForm.PingTimeout;
  RefreshList;
  PingList.Resume;
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], MainForm.PingTimeout) then SubItems[2] := 'Ok' else SubItems[2] := 'Nedostupný';
      Focused := False;
      Selected := False;
      if Terminated then Break;
    end;
//    ListView1.Items.EndUpdate;
    Button2.Enabled := True;
    ComboBox1.Enabled := True;
    Button2.Caption := 'Otestovat';
  end;
end;

procedure TNetworkTest.Button2Click(Sender: TObject);
 begin
  if Button2.Caption = 'Otestovat' then
  begin
    Button2.Caption := 'Pøerušit';
    ComboBox1.Enabled := False;
    ListView1.SetFocus;
    PingList.Free;
    PingList := TPingList.Create(True);
    PingList.Resume;
  end else begin
    PingList.Terminate;
    Button2.Caption := 'Otestovat';
    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 := IndexByName(GetComputerNetName);
    while (I <> 0) and (I < 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;
      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 * 15 + 97
    else Height := 4 * 15 + 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
  MainForm.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;

function TNetworkTest.IndexByName(Name: string): Integer;
begin
  Name := UpperCase(Name);
  for Result := 0 to High(Devices) do
    if Devices[Result].Name = Name then Break;
end;

procedure TNetworkTest.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  MainForm.PingTimeout := SpinEdit1.Value;
end;

end.