Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 02.10.2013, 05:46
Train-GT Train-GT вне форума
Прохожий
 
Регистрация: 02.10.2013
Сообщения: 1
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Контроль расхода трафика интернет

Здравствуйте! У меня 3G модем с лимитным интернетом. Чтобы не превысить трафик я при каждом завершении сеанса записываю свой расход, но это жутко грамостко и неудобно. Решил сделать простую программу, которая просто будет записывать в label сумму принятых и переданных Мб. Нашел в инете программу, но при запуске в списке всех подключений появляется MS TCP Loopback interface. И если я пишу label.caption:=Traff(TMibIfTable(_ p^).table[i].dwInOctets), то в него вписывается имеено этот MS TCP. А как сделать так, чтобы в лабел выводились показатели только моего WAN интерфейса?
Код программы для удобства ниже:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  ComCtrls, StdCtrls, ToolWin, ExtCtrls, XPMan;



type
 PMibIfRow = ^TMibIfRow;
 TMibIfRow = packed record
    wszName		: array[0..255] of WideChar;
    dwIndex		: DWORD;
    dwType		: DWORD;
    dwMtu		: DWORD;
    dwSpeed		: DWORD;
    dwPhysAddrLen	: DWORD;
    bPhysAddr		: array[1..8] of Byte;
    dwAdminStatus	: DWORD;
    dwOperStatus	: DWORD;
    dwLastChange	: DWORD;
    dwInOctets		: DWORD;
    dwInUcastPkts	: DWORD;
    dwInNUCastPkts	: DWORD;
    dwInDiscards	: DWORD;
    dwInErrors		: DWORD;
    dwInUnknownProtos	: DWORD;
    dwOutOctets		: DWORD;
    dwOutUCastPkts	: DWORD;
    dwOutNUCastPkts	: DWORD;
    dwOutDiscards	: DWORD;
    dwOutErrors		: DWORD;
    dwOutQLen		: DWORD;
    dwDescrLen		: DWORD;
    bDescr		: array[0..255] of Char;
 end;

 pMibIfArray = ^TMIBIFARRAY;
 TMibIfArray = array [0..512] of TMibIfRow;

 PMibIfTable = ^TMibIfTable;
 TMibIfTable = packed record
   dwNumEntries	: DWORD;
   Table    	: TMibIfArray;
 end;

 TMacAddress=array [1..8] of byte;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Bevel1: TBevel;
    Timer1: TTimer;
    XPManifest1: TXPManifest;
    procedure Timer1Timer(Sender: TObject);
  private
    function GetStrMac(Mac:TMacAddress; size:integer):string;
    function GetInterfaceType (types:integer):string;
    function Traff(count:integer):string;
    function SpeedToStr(value:dword):string;
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

  function GetIfTable(pIfTable:PMibIfTable; pdwSize: PULONG;
                bOrder: boolean ): DWORD; stdCall; external 'IPHLPAPI.DLL';
            


implementation

{$R *.dfm}

function TForm1.GetInterfaceType(types: integer): string;
begin
 Result:='Неизвестно';
 case types of
  1: Result:='Other';
  6: Result:='Ethernet';
  9: Result:='Token ring';
  23: Result:='PPP';
  24: Result:='Loopback';
  37: Result:='ATM';
  71: Result:='IEEE 802.11';
  131: Result:= 'Tunnel';
  144: Result:='IEEE 1394 (Firewire)';
 end;
end;

function TForm1.GetStrMac(Mac: TMacAddress; size: integer): string;
var
 i:integer;
begin
 if size = 0 then
  begin
   result:='00-00-00-00-00-00';
   Exit;
  end;

 Result:='';
 for i:=1 to size do
  Result:=Result+IntToHex(Mac[i], 2)+'-';
 Delete(Result, length(Result), 1);
end;

function TForm1.SpeedToStr(value: dword): string;
const
 KB=1000;
 MB=KB*1000;
 GB=MB*1000;
begin
 if Value<KB then
  Result:=FormatFloat('#,##0.00 bps',Value)
 else
  if Value<MB then
   Result:=FormatFloat('#,##0.00 Kbps', Value/KB)
  else
   if Value<GB then
  Result:=FormatFloat('#,##0.00 Mbps', Value/MB)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  _MibIfTable:PMibIfTable;
  _P:Pointer;
   i:integer;
  _buflen:dword;
  _error:dword;
begin
 listview1.Items.Clear;
 _buflen:=sizeof(_MibIfTable^);
 New(_MibIfTable);
 _P:=_MibIfTable;
 _error:=GetIfTable(_MibIfTable, @_buflen, false);

 if _error <> NO_ERROR then
  begin
   ShowMessage('Произошла ошибка!');
   Exit;
  end;


 for i:=0 to TMibIfTable(_P^).dwNumEntries-1 do
  with ListView1.Items.Add do
   begin
    caption:=Trim(TMibIfTable(_p^).table[i].bDescr);
    subitems.Add(GetInterfaceType(TMibIfTable(_P^).table[i].dwtype));
    subitems.Add(GetStrMac(TMacAddress(TMibIfTable(_p^).Table[i].bPhysAddr),TMibIfTable(_p^).table[i].dwPhysAddrLen));
    subitems.add(SpeedToStr(TMibIfTable(_p^).table[i].dwSpeed));
    subitems.Add(Traff(TMibIfTable(_p^).table[i].dwOutOctets));
    subitems.Add(Traff(TMibIfTable(_p^).table[i].dwInOctets)); 
    subitems.Add(IntToStr(TMibIfTable(_p^).table[i].dwOutErrors)); 
    subitems.Add(IntToStr(TMibIfTable(_p^).table[i].dwInErrors));
   end;
 dispose(_MibIfTable);

end;

function TForm1.Traff(count: integer): string;
const
 KB=1024;
 MB=KB*1024;
 GB=MB*1024;
begin
 if Count<KB then
  Result:=FormatFloat('#,##0.00 B', count)
 else
  if count<MB then
   Result:=FormatFloat('#,##0.00 KB', count/KB)
  else
   if count<GB then
    Result:=FormatFloat('#,##0.00 MB', count/MB);
 end;
end.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 22:38.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025