Keskustelu: Ohjelmointikysymykset: Pascal: (Delphi) Kertokaas...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    labUPLOAD: TLabel;
    labDOWNLOAD: TLabel;
    timMAIN: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    procedure timMAINTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  MAX_ROWS=32;

type
  TrIFROW=record
    FName:array[0..511] of Byte;                                                // interface caption
    FIndex:Cardinal;                                                            // index of the interfaces
    FType:Longint;                                                              // type of interface
    FMTU:Longint;                                                               // max transmission unit
    FSpeed:Longint;                                                             // speed of the interfaces
    FPhysAddrLen:Longint;                                                       // length of physical address
    FPhysAddr:array[0..7] of Byte;                                              // physical address of adapter
    FAdminStatus:Longint;                                                       // administrative status
    FOperStatus:Longint;                                                        // operational status
    FLastChange:Longint;                                                        // read time operational status changed
    FInOctets:Longint;                                                          // octets received
    FInUcastPkts:Longint;                                                       // unicast packets received
    FInNUcastPkts:Longint;                                                      // non unicast packets received
    FInDiscards:Longint;                                                        // received packets discarded
    FInErrors:Longint;                                                          // erroneous packets received
    FInUnknownProtos:Longint;                                                   // unknown protocol packets received
    FOutOctets:Longint;                                                         // octets sent
    FOutUcastPkts:Longint;                                                      // unicast packets sent
    FOutNUcastPkts:Longint;                                                     // non unicast packets sent
    FOutDiscards:Longint;                                                       // outgoing packets discarded
    FOutErrors:Longint;                                                         // erroneous packets sent
    FOutQLen:Longint;                                                           // output queue length
    FLength:Longint;                                                            // length of bDescr more member
    FDescription:array[0..255] of Char;                                         // interface description
end;

  TrIFTABLE=record
    FCount:LongInt;                                                             // number of interfaces
    FRows:array[0..MAX_ROWS] of TrIFROW;                                        // more than 20 should be it however!
  end;


var
  Form1: TForm1;

function GetIfTable(pIfRowTable:Pointer;var pdwSize:Longint;dwCode:Longint):Longint;stdcall;external 'IPHlpAPI.dll' name 'GetIfTable';

implementation

{$R *.dfm}

const
  FirstRun:Boolean=True;
  LastUL:Integer=0;
  LastDL:Integer=0;

procedure TForm1.timMAINTimer(Sender: TObject);
var
  Table:TrIFTABLE;
  Error:DWORD;
  Size:Longint;
begin
  Error:=GetIfTable(@Table,Size,1);
  Error:=GetIfTable(@Table,Size,1);

  if not FirstRun then

  begin
    labUPLOAD.Caption:='Lähetysnopeus: '+FloatToStrF((Table.FRows[1].FOutOctets-LastUL)/1024,ffFixed,10,2)+' kt/s';
    labDOWNLOAD.Caption:='Latausnopeus: '+FloatToStrF((Table.FRows[1].FInOctets-LastDL)/1024,ffFixed,10,2)+' kt/s';
  end else FirstRun:=False;

  LastUL:=Table.FRows[1].FOutOctets;
  LastDL:=Table.FRows[1].FInOctets;

end;

end.