Delphi中用IPHelperAPI实现电脑流量监控

interface

uses

Windows, Graphics, ExtCtrls, Controls, StdCtrls, Buttons, Tabs,

ComCtrls, Classes, SysUtils, Forms, dialogs,

TrafficUnit, IPHelper, IPHLPAPI, ShellAPI;

type

TMainForm = class(TForm)

pnlMain: TPanel;

pnlBottom: TPanel;

pc: TPageControl;

tsAbout: TTabSheet;

tsTraffic: TTabSheet;

ExitButton: TButton;

TrafficTabs: TTabSet;

GroupBox: TGroupBox;

ledAdapterDescription: TLabeledEdit;

UnFreezeButton: TBitBtn;

FreezeButton: TBitBtn;

ClearCountersButton: TBitBtn;

ledMACAddress: TLabeledEdit;

gbIN: TGroupBox;

ledOctInSec: TLabeledEdit;

ledAvgINSec: TLabeledEdit;

ledPeakINSec: TLabeledEdit;

ledTotalIN: TLabeledEdit;

gbOUT: TGroupBox;

ledOctOUTSec: TLabeledEdit;

ledAvgOUTSec: TLabeledEdit;

ledPeakOUTSec: TLabeledEdit;

ledTotalOUT: TLabeledEdit;

Timer: TTimer;

gbTime: TGroupBox;

ledStartedAt: TLabeledEdit;

ledActiveFor: TLabeledEdit;

RemoveInactiveButton: TBitBtn;

StatusText: TStaticText;

cbOnTop: TCheckBox;

Panel3: TPanel;

ProductName: TLabel;

lblURL: TLabel;

Label3: TLabel;

ProgramIcon: TImage;

StaticText1: TStaticText;

ledSpeed: TLabeledEdit;

procedure TimerTimer(Sender: TObject);

procedure ClearCountersButtonClick(Sender: TObject);

procedure cbOnTopClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure TrafficTabsChange(Sender: TObject; NewTab: Integer;

var AllowChange: Boolean);

procedure ExitButtonClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FreezeButtonClick(Sender: TObject);

procedure UnFreezeButtonClick(Sender: TObject);

procedure RemoveInactiveButtonClick(Sender: TObject);

procedure lblURLClick(Sender: TObject);

procedure StaticText1Click(Sender: TObject);

procedure pcChange(Sender: TObject);

procedure ledAdapterDescriptionChange(Sender: TObject);

private

procedure HandleNewAdapter(ATraffic : TTraffic);

procedure HandleFreeze(ATraffic : TTraffic);

procedure HandleUnFreeze(ATraffic : TTraffic);

function LocateTraffic(AdapterIndex : DWord) : TTraffic;

procedure ProcessMIBData;

procedure ClearDisplay;

procedure RefreshDisplay;

public

{ Public declarations }

end;

var

MainForm: TMainForm;

ActiveTraffic : TTraffic;

implementation

{$R *.dfm}

procedure TMainForm.ClearDisplay;

var

j:integer;

begin

TrafficTabs.Tabs.Clear;

StatusText.Caption:='';

for j:= 0 to GroupBox.ControlCount-1 do

begin

if GroupBox.Controls[j] is TCustomEdit then

TCustomEdit(GroupBox.Controls[j]).Text := '';

end;

end; (*ClearDisplay*)

procedure TMainForm.TimerTimer(Sender: TObject);

begin

Timer.Enabled := False;

ProcessMIBData;

Timer.Enabled := True;

end; (*TimerTimer*)

procedure TMainForm.ClearCountersButtonClick(Sender: TObject);

begin

ActiveTraffic.Reset;

RefreshDisplay;

end;

procedure TMainForm.cbOnTopClick(Sender: TObject);

begin

if cbOnTop.Checked = true then

FormStyle := fsSTAYONTOP

else

FormStyle := fsNORMAL;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

var

i : integer;

begin

Timer.OnTimer := nil;

ActiveTraffic := nil;

for i:= 0 to -1 + TrafficTabs.Tabs.Count do

TrafficTabs.Tabs.Objects[i].Free;

end;

procedure TMainForm.TrafficTabsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);

begin

if NewTab = -1 then

ActiveTraffic := nil

else

ActiveTraffic := TTraffic(TrafficTabs.Tabs.Objects[NewTab]);

RefreshDisplay;

end;

procedure TMainForm.ExitButtonClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

//do NOT change

Timer.Interval := 1000; // all calculatoins on 1 sec.

//remove design time testing data

ClearDisplay;

ActiveTraffic := nil;

pcChange(Sender);

Timer.Enabled := True;

end;

procedure TMainForm.RefreshDisplay;

begin

if not Assigned(ActiveTraffic) then

begin

ClearDisplay;

Exit;

end;

with ActiveTraffic do

begin

FreezeButton.Visible := Connected;

UnFreezeButton.Visible := Connected;

ClearCountersButton.Visible := Connected;

RemoveInactiveButton.Visible := not Connected;

FreezeButton.Enabled := Running;

UnFreezeButton.Enabled := not Running;

ledAdapterDescription.Text := Description;

ledMACAddress.Text := MAC;

ledSpeed.Text := BitsToFriendlyString(Speed);

ledOctInSec.Text := BytesToFriendlyString(InPerSec);

ledPeakInSec.Text := BytesToFriendlyString(PeakInPerSec);

ledAvgINSec.Text := BytesToFriendlyString(AverageInPerSec);

ledTotalIN.Text := BytesToFriendlyString(InTotal);

ledOctOUTSec.Text := BytesToFriendlyString(OutPerSec);

ledPeakOUTSec.Text := BytesToFriendlyString(PeakOutPerSec);

ledAvgOUTSec.Text := BytesToFriendlyString(AverageOutPerSec);

ledTotalOUT.Text := BytesToFriendlyString(OutTotal);

self.ledStartedAt.Text := DateTimeToStr(StartedAt);

self.ledActiveFor.Text := FriendlyRunningTime;

StatusText.Caption := GetStatus;

end;//with

end; (*RefreshDisplay*)

procedure TMainForm.ProcessMIBData;

var

MibArr : IpHlpAPI.TMIBIfArray;

i : integer;

ATraffic : TTraffic;

begin

Get_IfTableMIB(MibArr); // get current MIB data

//Mark not Found as NOT Connected

for i:= 0 to -1 + TrafficTabs.Tabs.Count do

begin

ATraffic := TTraffic(TrafficTabs.Tabs.Objects[i]);

if ATraffic.Connected then ATraffic.Found := False;

end;

// ATraffic := nil;

//process

if Length(MibArr) > 0 then

begin

for i := Low(MIBArr) to High(MIBArr) do

begin

ATraffic := LocateTraffic(MIBArr[i].dwIndex);

if Assigned(ATraffic) then

begin

//already connected

ATraffic.NewCycle(MIBArr[i].dwInOctets, MIBArr[i].dwOutOctets, MIBArr[i].dwSpeed);

end

else

begin

//New one!

ATraffic := TTraffic.Create(MIBArr[i], HandleNewAdapter);

ATraffic.Found := True;

ATraffic.OnFreeze := HandleFreeze;

ATraffic.OnUnFreeze := HandleUnFreeze;

end;

end;

end;

//Mark not Found as Inactive

for i:= 0 to -1 + TrafficTabs.Tabs.Count do

if NOT TTraffic(TrafficTabs.Tabs.Objects[i]).Found then

TTraffic(TrafficTabs.Tabs.Objects[i]).MarkDisconnected;

RefreshDisplay;

end; (*ProcessMIBData*)

function TMainForm.LocateTraffic(AdapterIndex : DWord): TTraffic;

var

j : cardinal;

ATraffic : TTraffic;

begin

Result := nil;

if TrafficTabs.Tabs.Count = 0 then Exit;

for j:= 0 to -1 + TrafficTabs.Tabs.Count do

begin

ATraffic := TTraffic(TrafficTabs.Tabs.Objects[j]);

if ATraffic.InterfaceIndex = AdapterIndex then

begin

Result := ATraffic;

Result.Found := True;

Break;

end;

end;

end; (*LocateAdapter*)

procedure TMainForm.HandleNewAdapter(ATraffic: TTraffic);

begin

//add adapter

TrafficTabs.Tabs.AddObject(ATraffic.IP, ATraffic);

//select it

TrafficTabs.TabIndex := -1 + TrafficTabs.Tabs.Count;

end; (*HandleNewAdapter*)

procedure TMainForm.FreezeButtonClick(Sender: TObject);

begin

ActiveTraffic.Freeze;

end;

procedure TMainForm.UnFreezeButtonClick(Sender: TObject);

begin

ActiveTraffic.UnFreeze;

end;

procedure TMainForm.HandleFreeze(ATraffic: TTraffic);

begin

self.FreezeButton.Enabled := ATraffic.Running;

self.UnFreezeButton.Enabled := not ATraffic.Running;

end;

procedure TMainForm.HandleUnFreeze(ATraffic: TTraffic);

begin

self.FreezeButton.Enabled := ATraffic.Running;

self.UnFreezeButton.Enabled := not ATraffic.Running;

end;

procedure TMainForm.RemoveInactiveButtonClick(Sender: TObject);

begin

If not ActiveTraffic.Connected then //just checking

begin

ActiveTraffic.Free;

ActiveTraffic := nil;

TrafficTabs.Tabs.Delete(TrafficTabs.TabIndex);

TrafficTabs.SelectNext(False);

end;

RefreshDisplay;

end; (*RemoveInactiveButtonClick*)

procedure TMainForm.lblURLClick(Sender: TObject);

begin

ShellExecute(Handle, 'open','',nil,nil,SW_SHOWNORMAL);

end;

procedure TMainForm.StaticText1Click(Sender: TObject);

begin

ShellExecute(Handle, 'open','mailto:',nil,nil,SW_SHOWNORMAL);

end;

procedure TMainForm.pcChange(Sender: TObject);

begin

pnlBottom.Visible := pc.ActivePage = tsTraffic;

end;

procedure TMainForm.ledAdapterDescriptionChange(Sender: TObject);

begin

//testing - not working since GroupBox is disabled

ledAdapterDescription.Hint := ledAdapterDescription.Text;

ledAdapterDescription.ShowHint := Canvas.TextWidth(ledAdapterDescription.Text) > ledAdapterDescription.ClientWidth;

end;

end.