[s4sh81]

Stelle hier mal für alle einen kleinen Traffic Monitor Source online.
Hat einen kleinen Haken, da bei der Auswahl der Netzwerkkarte bei BytesIn und BytesOut ein hoher Wert zustande kommt.

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    combobox1: TComboBox;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  old: integer;
  old1 : integer;
  BytesIn, BytesOut :integer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var MibRow: TMibIfRow;
IntfTable: PMibIfTable;
Size: DWORD;
I, J: Integer;
begin
  with combobox1 do begin
  if combobox1.itemindex = 0 then J := 0;
  if combobox1.itemindex = 1 then J := 1;
  if combobox1.itemindex = 2 then J := 2;
  if combobox1.itemindex = 3 then J := 3;
  if combobox1.itemindex = 4 then J := 4;
end;
//Auswahl der Netzwerkkarte

try
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 = j then begin
BytesIn := MibRow.dwInOctets - old;
label1.caption := floattostr(round(BytesIn /1024 *100)/100) + ' KB/s';
old := MibRow.dwInOctets;

BytesOut := MibRow.dwOutOctets - old1;
label2.Caption := floattostr(round(BytesOut /1024 *100)/100) + ' KB/s';
old1 := MibRow.dwOutOctets;
end;
end;
end;
except
on erangeerror do
begin
timer1.Enabled:=false;
showmessage('Ein Treiberproblem ist aufgetreten! Starten Sie den Computer neu.');
end;
end;
finally
FreeMem(IntfTable);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var MibRow: TMibIfRow;
    IntfTable: PMibIfTable;
    Size: DWORD;
    I : Integer;
begin
BytesIn := 0;
BytesOut := 0;
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+}
      combobox1.items.Add(PChar(@MibRow.bDescr[0]) + ' @ ' + InttoStr(MibRow.dwSpeed div 1000000)+ ' MBit/s');
      end;
    end;
  finally
  FreeMem(IntfTable);
end;
end;

end.

Hai s4sh81,

Du solltest deinen Code noch einmal überarbeiten. Zum einen gibt es dort Komponenten die offenbar überhaupt nicht verwendet werden (z.B. Timer2) und zum anderen solltest Du den Code einigermassen formatieren. So kann man ja überhaupt nicht erkennen was, wo anfängt und aufhört.

BTW:

markieren

Delphi-Quellcode:

begin
  if combobox1.itemindex = 0 then J := 0;
  if combobox1.itemindex = 1 then J := 1;
...

ist doch das gleiche wie:
j:= combobx1.itemindex; Und Du solltest angeben welche Komponenten/Units benötigt werden. IpExport kennt mein Delphi zum Beispiel nicht.

Ich habe es mal schnell formatiert (so könntest du es machen, es gibt sicher noch unzählige andere Möglichkeiten ). Ich würde dir aber raten, deine Komponenten zu benennen und den Code mehr zu formatieren.

Wenn du mal mehr als 30 Buttons hast und den Code ausdruckst, wirst du viel Spaß beim Suchen haben. Dasselbe gilt natürlich auch für Timer & Co.

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    combobox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  BytesIn, BytesOut, Old, Old1: Integer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  MibRow: TMibIfRow;
  IntfTable: PMibIfTable;
  Size: DWORD;
  I, J: Integer;
begin
  J := ComboBox1.ItemIndex;
  //Auswahl der Netzwerkkarte
  Try
    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 = J then
                begin
                  BytesIn := MibRow.dwInOctets - Old;
                  Label1.caption := FloatToStr(Round(BytesIn / 1024 * 100) / 100) + ' KB/s';
                  Old := MibRow.dwInOctets;
                  BytesOut := MibRow.dwOutOctets - Old1;
                  Label2.Caption := FloatToStr(Round(BytesOut / 1024 * 100) / 100) + ' KB/s';
                  Old1 := MibRow.dwOutOctets;
                end;
            end;
        end;
    Except
      On ERangeError do
        begin
          Timer1.Enabled := False;
          ShowMessage('Ein Treiberproblem ist aufgetreten! Starten Sie den Computer neu.');
        end;
    end;
  Finally
    FreeMem(IntfTable);
  end;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
var
  MibRow: TMibIfRow;
  IntfTable: PMibIfTable;
  Size: DWORD;
  I: Integer;
begin
  BytesIn := 0;
  BytesOut := 0;
  Size := 0;
  If GetIfTable(nil, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
  IntfTable := AllocMem(Size);
  Try
    If GetIfTable(IntfTable, Size, True) = NO_ERROR then
      For I := 0 to IntfTable^.dwNumEntries - 1 do
        begin
          {$R-}MibRow := IntfTable.Table[I];{$R+}
          ComboBox1.Items.Add(PChar(@MibRow.bDescr[0]) + ' @ ' + InttoStr(MibRow.dwSpeed div 1000000) + ' MBit/s');
        end;
  Finally
    FreeMem(IntfTable);
  end;
end;

end.

Um das ganze hier mal etwas sinnvoller zu machen, sind hier mal alle benötigten Dateien zusammen mit dem Quellcode. Dann macht das ganze vielleicht nicht nur spass, sondern ist auch noch brauchbar.

Vielleicht ist ein Blick hierhin auch ganz interessant (wobei ich gerade feststellen musste, dass dort die main.dfm fehlt. Blöder geht es nimmer! was soll so etwas?).

Als allererstes ein Dankeschön an diejenigen,
die mein Programm weiterentwickelt haben.

Allerdings ist das Hauptproblem immernoch das gleiche,
da ich bei der Auswahl der Netzwerkkarte einen hohen Wert bekomme.

Das Programm startet bei mir jetzt mit der Broadcom karte mit 0 KB/s
Wechsel ich zum Wlan ist der wert beim download bei 10000 und beim upload bei 1000, fällt dann auf 0 KB/s und zeigt mir realtiv genau den Traffic an.
wechsel ich auf eine andere Karte sind die werte im Minusbereich und bleiben bei 0 KB/s stehen, da ich nichts sende.

Könnte einer von euch vielleicht mal danach gucken?

Ansonsten Happy New Year

Das liegt vermutlich an den Old-Werten. Die gehören dann ja nicht zur gewählten Netzwerkkarte. Setzte sie doch bei einem Wechsel auf 0.

Habe es bisher versucht, bytesin und die old werte auf 0 zu setzen.
allerdings bleibt das problem weiterhin bestehen.

aber mal eine ganz andere frage.
die anzeige des traffics ist ja schon ganz gut.
wie realisiere ich nun eine auswertung der daten, ala
am tag x wurde soviel geladen und am nächsten soviel.

mach ich das mit einer datenbank oder gibt es eine andere möglichkeit?

Schick schonmal ein Dankeschön vorweg.

Gruß S4SH