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

东坡下载 2012年04月12日 13:37:39

      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.