Thema: Delphi TRAFFIC V0.1

Einzelnen Beitrag anzeigen

Synollus

Registriert seit: 29. Dez 2008
49 Beiträge
 
#4

Re: TRAFFIC V0.1

  Alt 31. Dez 2008, 17:19
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.

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.
  Mit Zitat antworten Zitat