最近想弄一个和360流量监控差不多的小程序，没办法单独提取出来，找来找去也没有合适的替代品，突然对其原理产生兴趣 ，从网上找到一个Delphi写的程序，质量不错，仅供大家参考一下吧，监控流量一般可以使用底层NDIS驱动来实现，需要驱动开发技术，比较复杂，所以这个程序使用的是iphelper所提供的api接口来获得流量信息，这个是运行时的截图。

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','http://delphi.about.com',nil,nil,SW_SHOWNORMAL);
end;

procedure TMainForm.StaticText1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open','mailto:delphi.guide@about.com',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.