unit1.pas

一款用delphy编写的关于网络流量检测的软件 能轻松的监测本机的网络流量信息

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls, Buttons,
  iphlpapi;

type
  TForm1 = class(TForm)
    Chart1: TChart;
    Timer1: TTimer;
    Series2: TLineSeries;
    Series1: TLineSeries;
    procedure getPacketCounts(VAR packetsIn, packetsOut: LongInt);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



var
  Form1: TForm1;

CONST
   MaxTime = 3*60; // 2 minutes
   MaxVal  = MaxTime;  // two reads per second

TYPE
  TifTable = Record
             nRows   : LongInt;
             ifRow   : Array[1..20] of MIB_IFROW;
             end;
  Tdebug   = Array[0..$FF] of byte;

VAR
  pIfTable           : ^TifTable;
  L : Record
      buffSize       : LongInt;
      IPboard        : LongInt;
      cCode          : LongInt;
      pIn, pOut      : LongInt;
      end;
  P : Integer;
  dataIn, dataOut : Array[0..MaxVal+1] of Integer;

implementation

{$R *.dfm}

procedure TForm1.getPacketCounts(VAR packetsIn, packetsOut: LongInt);
VAR
  xIn, xOut : LongInt;
begin
   if (L.IPboard<=0) then exit;
   ZeroMemory(pIfTable, L.buffSize);

   // get IP info
   L.cCode := GetIfTable(pIfTable, L.buffSize, 1);
   if L.cCode<>ERROR_SUCCESS then exit;

   // get packet counts
   xIn  := pIfTable^.ifRow[L.IPboard].dwInOctets;
   xOut := pIfTable^.ifRow[L.IPboard].dwOutOctets;

   // calc new packets
   packetsOut := xOut - L.pOut;  if packetsOut<0 then packetsOut := 0;
   packetsIn  := xIn - L.pIn;    if packetsIn<0  then packetsIn := 0;

   // save new base
   L.pIn      := xIn;
   L.pOut     := xOut;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
   i : Integer;
begin
   // shift all values left
   if p>=MaxVal then begin
      Move(dataOut[1], dataOut[0], MaxVal*sizeOf(Integer));
      Move(dataIn[1],  dataIn[0],  MaxVal*sizeOf(Integer));
      end;
   // latest value
   getPacketCounts(dataIn[P], dataOut[P]);

   // display all values
   for i := 0 to MaxVal do begin
       Chart1.SeriesList.Series[0].YValue[i] := dataOut[i];
       Chart1.SeriesList.Series[1].YValue[i] := dataIn[i];
       end;
   if p<MaxVal then inc(P);
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
   i : Integer;
begin
   pIfTable := nil;
   ZeroMemory(@L,    sizeOf(L));

   // request the size for the table to retrieve
   L.cCode := GetIfTable(pIfTable, L.buffSize, 1);
   if (L.buffSize<=0) or (L.buffSize>sizeOf(TifTable)) then begin
      ShowMessage('Cannot retrieve IP Info');
      Timer1.Enabled := false;
      end;

   L.IPboard := -1;

   // allocate memory 
   GetMem(pIfTable, L.buffSize);
   ZeroMemory(pIfTable, L.buffSize);

   // retrieve the IP board info
   L.cCode := GetIfTable(pIfTable, L.buffSize, 1);
   if L.cCode=ERROR_SUCCESS then begin
      for i := 1 to pIfTable^.nRows do begin
          // locate an actual board (not the virtual loopback)
          if pIfTable^.ifRow[i].dwPhysAddrLen > 0 then begin
             L.IPboard := i;
             Chart1.Title.Text.Clear;
             Chart1.Title.Text.Add('IP LAN Activity');
             Chart1.Title.Text.Add(StrPas(@pIfTable^.ifRow[i].bDescr));
             break;
             end;
          end;
     end;

   // initialize packet counts
   getPacketCounts(dataIn[P], dataOut[P]);

   // initialize values
   for i := 0 to MaxVal do begin
       dataOut[i] := 0;
       dataIn[i]  := 0;
       Chart1.SeriesList.Series[0].Add(dataOut[i], '', clRed);
       Chart1.SeriesList.Series[1].Add(dataIn[i],  '', clGreen);
       end;

   Timer1.Enabled := true;
   P := 0;
end;

end.