Einzelnen Beitrag anzeigen

Benutzerbild von Ultimator
Ultimator

Registriert seit: 17. Feb 2004
Ort: Coburg
1.860 Beiträge
 
FreePascal / Lazarus
 
#2

Re: Problem bei code umformung für netzwerk auslastung

  Alt 18. Jul 2004, 12:37
Also ich hab für meinen TrafficSpeed-Monitor so gemacht:
Delphi-Quellcode:
unit TM_U;

interface

uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  Dialogs,Winsock,IpExport,IpHlpApi,IpTypes,IpIfConst,IpRtrMib,ExtCtrls,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    Label5: TLabel;
    Label6: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  old: integer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var MibRow: TMibIfRow;
IntfTable: PMibIfTable;
Size: DWORD;
I: Integer;
begin
Size := 0;
if GetIfTable(nil, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
  IntfTable := AllocMem(Size);
  try
    if GetIfTable(IntfTable, Size, True) = NO_ERROR then
    begin
      for I := 0 to IntfTable^.dwNumEntries - 1 do
      begin
     {$R-}MibRow := IntfTable.Table[I];{$R+} 
        if MibRow.dwType <> MIB_IF_TYPE_ETHERNET then Continue; // oder MIB_IF_TYPE_PPP
       if i = 1 then begin // Welche Verbindung

       label2.caption := inttostr(MibRow.dwInOctets div 8 div 1024) +' KB';
        label4.Caption := inttostr(MibRow.dwOutOctets div 8 div 1024) +' KB';
                     end;
  end;
    end;


    finally
    FreeMem(IntfTable);
  end;
end;


procedure TForm1.Timer2Timer(Sender: TObject);
var MibRow: TMibIfRow;
IntfTable: PMibIfTable;
Size: DWORD;
I: Integer;
wert:integer;
begin
Size := 0;
if GetIfTable(nil, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
  IntfTable := AllocMem(Size);
  try
    if GetIfTable(IntfTable, Size, True) = NO_ERROR then
    begin
      for I := 0 to IntfTable^.dwNumEntries - 1 do
      begin
     {$R-}MibRow := IntfTable.Table[I];{$R+} 
        if MibRow.dwType <> MIB_IF_TYPE_ETHERNET then Continue; // oder MIB_IF_TYPE_PPP
       if i = 1 then begin // Welche Verbindung
       wert := MibRow.dwInOctets - old;


                      label1.caption := floattostr(round(Wert /1024 *100)/100) + ' KB/s';
                     old := MibRow.dwInOctets

                     end;
  end;
    end;


    finally
    FreeMem(IntfTable);
  end;

end;


end.
Julian J. Pracht
  Mit Zitat antworten Zitat