Delphi流量监控源代码


Delphi流量监控源代码

最近想弄一个和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.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678