Автоматизированная система контроля трафика локально-вычислительной сети

В Object Pascal есть два вида подпрограмм: процедуры и функции. Функция отличается от процедуры только тем, что ее идентификатор можно наряду с константами и переменными использовать в выражениях, т. к. функция имеет выходной результат определенного типа. Если, например, определена функция

Function MyFunction: Integer;

и переменная var

X: Integer;

то возможен такой оператор присваивания:

Х := 2*MyFunction-l;

Имя процедуры нельзя использовать в выражении, т. к. процедура не имеет связанного с нею результата:

Procedure MyProcedure;

…

X := 2*MyProcedure-l; // Ошибка!

2.5 Типы данных

Типы в Object Pascal играют огромную роль. Связано это с тем, что лежащий в его основе язык Pascal был специально придуман как средство обучения студентов программированию. Поскольку начинающий программист легко может допустить ошибку или неточно описать свои действия, компилятор Pascal должен был иметь средства контроля за действиями программиста, чтобы вовремя предостеречь его от последствий неверных действий. Первоначально типы как раз и предназначались для того, чтобы программист явно указывал компилятору, какого размера память нужна ему в программе и что он собирается делать с этой памятью. Практика применения типов показала их высокую эффективность для защиты программы от случайных ошибок, так что практически все современные языки программирования в той или иной степени реализуют механизм типов. В Object Pascal значение типов возросло в еще большей степени, т. к. с их помощью определяются классы - основной инструмент программиста.

Свое знакомство с типами можно начать со строкового типа String. Этот тип определяет участок памяти переменной длины, каждый байт которого содержит один символ. Для символов в Object Pascal используется тип Char, таким образом, String - это цепочка следующих друг за другом символов Char. Каждый символ в String пронумерован, причем первый символ имеет номер 1. Программист может обращаться к любому символу строки, указывая его порядковый номер в квадратных скобках сразу за именем переменной:

var // Начало раздела описания переменных

S: String;

// Объявление переменной строкового типа

Begin

// Начало раздела исполняемых операторов

S := 'Строка символов';

// Переменная S содержит

// значение ”Строка символов”

S[6] := 'и'; // Теперь переменная содержит значение

// ”Строки символов”

end;

// Конец раздела исполняемых операторов

Программист обязан объявить любой вводимый им идентификатор. Идентификатор s неизвестен Delphi - он введен нами для переменной строкового типа. После его объявления в разделе переменных Delphi выделит для него начальную область памяти минимальной длины и будет контролировать использование этого идентификатора в разделе исполняемых операторов. Например, если в этом разделе встретится выражение

2*S-1

компилятор сразу забьет тревогу, так как строка не может быть участником математических вычислений: она предназначена для хранения символов, а не чисел.

В первом операторе присваивания в переменную s будет помещено значение строковой константы строка символов'. Строковые константы содержат произвольные символы, заключенные в обрамляющие апострофы, причем сами апострофы не входят в значение константы, поэтому после присваивания переменная примет значение Строка символов без апострофов (если понадобится включить в текстовую константу апостроф, он удваивается: ' символ ' ' - апостроф'). После первого присваивания s будет занимать участок памяти длиной 15 байт - по одному байту на каждый символ значения. На самом деле переменная строкового типа всегда имеет длину 4 байта, которые используются для указания на область памяти, в которой помещается сама строка символов. Переменность размера области памяти, выделяемой для размещения строки символов, - характерная особенность типа string. Если бы, например, во втором операторе мы обратились не к 6-му по счету символу, а ко всей строке в целом:

S := 'и';

эта переменная стала бы занимать 1 байт, а следующие за ним 14 байтов оказались бы свободными. Длина строковой переменной в программе меняется автоматически при каждом присваивании переменной нового значения и может составлять от 0 до 2 Гбайт[Для версии Delphi 1 тип String соответствует “короткой” строке, длина которой не может превышать 255 байт.] (1 Гигабайт (Гбайт) соответствует константе Gbyte). Над строковым типом определена операция сцепления (+):

S := 'Object'+' Pascal';// S содержит “Object Pascal” .[21].

2.6 Описание пользовательского интерфейса

От множества программ по контролю трафика, «Автоматизированную систему контроля трафика ЛВС» отличает бесплатный статус. Кроме этого, программа имеет еще одно достоинство - русскоязычный интерфейс, который способствует ее быстрому освоению. «Автоматизированная система контроля трафика ЛВС» имеет простой, интересный и понятный пользователю любого уровня интерфейс.

Программа «Автоматизированная система контроля трафика ЛВС» имеет очень быструю загрузку, совместима со всеми версиями Windows. Также программа отображает:

- Адаптер с помощью которого устройство подключено к сети.

- MAC - Адрес устройства.

- Скорость передачи данных.

- Фиксирует дату, время и продолжительность работы программы.

- Программа посчитывает входящий и исходящий трафик, определяя пик загруженности сети, среднее количество преданной/принятой информации, и её общее количество.

- Программа имеет удобные вкладки, на которых отображаются IP - Адреса.

- Программный продукт имеет функцию отображения поверх всех окон.

Функциональные возможности программы реализованы с помощью следующих режимов:

- «Заморозить» - для заморозки подключения программы.

- «Разморозить» - Для разморозки подключения.

- «Отчистить» - для обнуления всех полей программы.

- «Выход» - для выхода из программы.

Одно из основных достоинств программного продукта «Автоматизированная система контроля трафика ЛВС», это минимальные системные требования:

- Операционная система Windows 98

- Оперативная память 64 MB

- Видеокарта 32 MB

- Требуемое свободное место на жестком диске 5 MB

- Оптические устройства Клавиатура, мышь.

В данное время программа «Автоматизированная система контроля трафика ЛВС» имеет большую актуальность, в связи с распространением локальных и интернет сетей.

Данный программный продукт имеет универсальный характер применения для предприятий с Интернет - подключением или использованием локальной сети. Так же программа имеет уровень защищённости, т.е. сбои при учёте трафика невозможны или сведены к минимуму. Программа может получить большое распространение в связи с бесплатным статусом, а также имеет открытый исходный код, поэтому любой квалифицированный пользователь в состоянии адаптировать программу к ряду функций. которые имеют для него более высокий приоритет. При создании программного продукта «Автоматизированная система контроля трафика ЛВС» была использована операционная система Linux, поскольку она использует открытый исходный код позволяющий адаптировать ряд функций операционной системы под индивидуальность пользователя, в отличии от операционной системой Windows. Данный программный продукт сочетает в себе все выше перечисленные функции, воплощая в себе вариант открытой и доступной программы, рассчитанной на квалифицированного пользователя.

Приложение «Автоматизированная система контроля трафика ЛВС Client version» предназначено для контроля и учёта входящего и исходящего трафиков локальной вычислительной сети. При двойном щелчке по ярлыку программы открывается приветственное окно представленное на рисунке 1.



Рисунок 1. Приветственное окно программы

Далее открывается основная форма приложения, которая имеет 3 вкладки:

– Мониторинг трафика представленный на рисунке 2.

– Соединение представленный на рисунке 3.

– О программе представленный на рисунке 4.

Рисунок 2. Мониторинг трафика



Рисунок 3. Соединение

Рисунок 4. О программе

Приложение «Автоматизированная система контроля трафика ЛВС Server version» предназначено для приёма и сбора информации о клиентах, контроля и учёта входящего и исходящего трафика локальной вычислительной сети. При двойном щелчке по ярлыку программы открывается приветственное окно представленное на рисунке 5.

Рис 5. Приветственное окно программы

Далее открывается основная форма приложения, которая имеет 3 вкладки:

– Мониторинг, представлена на рисунке 6.

– График, представлена на рисунке 7.

– О программе, представлена на рисунке 8.



Рисунок 6. Мониторинг сети

Рисунок 7. Графическое представление трафиков



Рис 8. О программе

2.7 Описание программных модулей

2.7.1 Описание модуля Unit1

Модуль Unit1 служит для отображения приветственного окна (Листинг 1).

Листинг 1.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, jpeg, ExtCtrls;

type

Tlogo = class(TForm)

Image1: TImage;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

logo: Tlogo;

implementation

{$R *.dfm}

procedure Tlogo.FormCreate(Sender: TObject);

begin

Position:=poScreenCenter;

FormStyle:=fsStayOnTop;

BorderStyle:=bsNone;

BorderIcons:=[];

end;

end.

2.7.2 Описание модуля TrafficUnit

Модуль TrafficUnit предназначен для учёта входящего и исходящего трафиков ( Листинг 2).

Листинг 2.

unit TrafficUnit;

interface

uses SysUtils, Windows, IPHelper, IPHLPAPI;

type

TTraffic = Class;

TNewInstanceEvent = procedure(Sender :TTraffic) of object;

TFreezeEvent = procedure(Sender :TTraffic) of object;

TTraffic = Class

private

FIP: string;

FMac: string;

FInPerSec: Dword;

FInTotal: Dword;

FPeakInPerSec: Dword;

FInterfaceIndex: DWord;

FActiveCountIn: Dword;

FSecondsActive: Cardinal;

FPrevCountIn: DWord;

FDescription: string;

FOutTotal: Dword;

FPeakOutPerSec: Dword;

FOutPerSec: Dword;

FPrevCountOut: DWord;

FActiveCountOut: Dword;

FAverageInPerSec: Dword;

FAverageOutPerSec: Dword;

FStartedAt: TDateTime;

FRunning: boolean;

FOnFreeze: TFreezeEvent;

FOnUnFreeze: TFreezeEvent;

FConnected: boolean;

FFound: boolean;

FSpeed: DWord;

function GetIPFromIFIndex(InterfaceIndex: Cardinal): string;

public

property Found : boolean read FFound write FFound;

property Connected : boolean read FConnected;

property Running : boolean read FRunning;

property InterfaceIndex : DWord read FInterfaceIndex;

property IP : string read FIP;

property Mac : string read FMac;

property Description : string read FDescription;

property StartedAt : TDateTime read FStartedAt;

property SecondsActive : Cardinal read FSecondsActive;

property Speed : DWord read FSpeed;

property ActiveCountIn : Dword read FActiveCountIn; { count of samples where something was received }

property PrevCountIn : DWord read FPrevCountIn; { previous byte count in }

property InPerSec : Dword read FInPerSec; { byte count in of last sample period }

property AverageInPerSec : Dword read FAverageInPerSec; { Average in }

property InTotal : Dword read FInTotal; { total byte count in }

property PeakInPerSec : Dword read FPeakInPerSec; { peak byte count in }

property ActiveCountOut : Dword read FActiveCountOut; { count of samples where something was sent }

property PrevCountOut : DWord read FPrevCountOut; { previous byte count out }

property OutPerSec : Dword read FOutPerSec; { byte count out of last sample period }

property AverageOutPerSec : Dword read FAverageOutPerSec; { Average Out }

property OutTotal : Dword read FOutTotal; { total byte count out }

property PeakOutPerSec : Dword read FPeakOutPerSec; { peak byte count out }

procedure NewCycle(const InOctets, OutOctets, TrafficSpeed : Dword);

procedure Reset;

procedure Freeze;

procedure UnFreeze;

procedure MarkDisconnected;

function GetStatus : string;

function FriendlyRunningTime:string;

constructor Create(const AMibIfRow : TMibIfRow; OnNewInstance : TNewInstanceEvent);

published

property OnFreeze :TFreezeEvent read FOnFreeze write FOnFreeze;

property OnUnFreeze :TFreezeEvent read FOnUnFreeze write FOnUnFreeze;

end;

function BytesToFriendlyString(Value : DWord) : string;

function BitsToFriendlyString(Value : DWord) : string;

implementation

function BytesToFriendlyString(Value : DWord) : string;

const

OneKB=1024;

OneMB=OneKB*1024;

OneGB=OneMB*1024;

begin

if Value<OneKB

then Result:=FormatFloat('#,##0.00 B',Value)

else

if Value<OneMB

then Result:=FormatFloat('#,##0.00 KB', Value/OneKB)

else

if Value<OneGB

then Result:=FormatFloat('#,##0.00 MB', Value/OneMB)

end;

function BitsToFriendlyString(Value : DWord) : string;

const

OneKB=1000;

OneMB=OneKB*1000;

OneGB=OneMB*1000;

begin

if Value<OneKB

then Result:=FormatFloat('#,##0.00 bps',Value)

else

if Value<OneMB

then Result:=FormatFloat('#,##0.00 Kbps', Value/OneKB)

else

if Value<OneGB

then Result:=FormatFloat('#,##0.00 Mbps', Value/OneMB)

end;

constructor TTraffic.Create(const AMibIfRow: TMibIfRow; OnNewInstance : TNewInstanceEvent);

var

Descr: string;

begin

inherited Create;

FRunning:=true;

FConnected:=true;

self.FInterfaceIndex:=AMibIfRow.dwIndex;

self.FIP:=GetIPFromIFIndex(self.InterfaceIndex);

self.FMac:=MacAddr2Str(TMacAddress(AMibIfRow.bPhysAddr), AMibIfRow.dwPhysAddrLen);

SetLength(Descr, Pred(AMibIfRow.dwDescrLen));

Move(AMibIfRow.bDescr, Descr[1], pred(AMibIfRow.dwDescrLen));

self.FDescription:=Trim(Descr);

self.FPrevCountIn:=AMibIfRow.dwInOctets;

self.FPrevCountOut:=AMibIfRow.dwOutOctets;

self.FStartedAt:=Now;

self.FSpeed:=AMibIfRow.dwSpeed;

FActiveCountIn:=0;

FActiveCountOut:=0;

FInTotal:=0;

FOutTotal:=0;

FInPerSec:=0;

FOutPerSec:=0;

FPeakInPerSec:=0;

FPeakOutPerSec:=0;

if Assigned(OnNewInstance)

then OnNewInstance(self);

end;

procedure TTraffic.NewCycle(const InOctets, OutOctets, TrafficSpeed: Dword);

begin

inc(self.FSecondsActive);

if not Running

then Exit;

FSpeed:=TrafficSpeed;

self.FInPerSec:=InOctets-self.PrevCountIn;

Inc(self.FInTotal, self.InPerSec);

if InPerSec>0

then Inc(FActiveCountIn);

if InPerSec>PeakInPerSec

then FPeakInPerSec:=InPerSec;

try

if ActiveCountIn<>0

then self.FAverageInPerSec:=InTotal div ActiveCountIn

except

self.FAverageInPerSec:=0;

end;

FPrevCountIn:=InOctets;

self.FOutPerSec:=OutOctets-self.PrevCountOut;

Inc(self.FOutTotal,self.OutPerSec);

if OutPerSec>0

then Inc(FActiveCountOut);

if OutPerSec>PeakOutPerSec

then FPeakOutPerSec:=OutPerSec;

try

if ActiveCountIn<>0

then self.FAverageOutPerSec:=OutTotal div ActiveCountOut

except

self.FAverageOutPerSec:=0;

end;

FPrevCountOut:=OutOctets;

end;

function TTraffic.GetIPFromIFIndex(InterfaceIndex: Cardinal): string;

var

i: integer;

IPArr: TMIBIPAddrArray;

begin

Result:='Not found!';

Get_IPAddrTableMIB(IpArr);

if Length(IPArr)>0

then

for i:=low(IPArr) to High(IPArr) do

if IPArr[i].dwIndex=InterfaceIndex

then

begin

Result:=IPAddr2Str(IParr[i].dwAddr);

Break;

end;

end;

procedure TTraffic.Reset;

begin

self.FPrevCountIn:=InPerSec;

self.FPrevCountOut:=OutPerSec;

self.FStartedAt:=Now;

FSecondsActive:=0;

FActiveCountIn:=0;

FActiveCountOut:=0;

FInTotal:=0;

FOutTotal:=0;

FInPerSec:=0;

FOutPerSec:=0;

FPeakInPerSec:=0;

FPeakOutPerSec:=0;

end;

procedure TTraffic.Freeze;

begin

FRunning:=false;

if Assigned(FOnFreeze)

then OnFreeze(Self);

end;

procedure TTraffic.UnFreeze;

begin

FRunning:=true;

if Assigned(FOnUnFreeze)

then OnUnFreeze(Self);

end;

procedure TTraffic.MarkDisconnected;

begin

self.FConnected:=false;

self.FRunning:=false;

end;

function TTraffic.GetStatus: string;

begin

if self.Connected

then Result:='Connected'

else Result:='Not connected';

if self.Running

then Result:=Result+', Running'

else Result:=Result+', Not running';

end;

function TTraffic.FriendlyRunningTime: string;

var

H,M,S: string;

ZH,ZM,ZS: integer;

begin

ZH:=SecondsActive div 3600;

ZM:=Integer(SecondsActive) div (60-ZH*60);

ZS:=Integer(SecondsActive)-(ZH*3600+ZM*60);

H:=Format('%.2d',[ZH]);

M:=Format('%.2d',[ZM]);

S:=Format('%.2d',[ZS]);

Result:=H+':'+M+':'+S;

end;

end.

2.7.3 Описание модуля MainFormUnit

Модуль MainFormUnit является главной формой клиентского приложения на которой производится контроль и учёт трафика (Листинг 3).

Листинг 3.

unit MainFormUnit;

interface

uses

Windows, Graphics, ExtCtrls, Controls, StdCtrls, Buttons, Tabs,

ComCtrls, Classes, SysUtils, Forms, Dialogs, Messages, Variants, ToolWin,

TrafficUnit, IPHelper, IPHLPAPI, ShellAPI, sSkinProvider, sSkinManager,

jpeg, Menus, TrayIcon, ScktComp;

type

TMainForm = class(TForm)

pnlMain: TPanel; - компонент панель

pnlBottom: TPanel; - компонент панель

pc: TPageControl; - компонент для создания вкладок

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; - компонент включения/отключения виде флажка

ledSpeed: TLabeledEdit; - компонент отображения данных

sSkinManager1: TsSkinManager; - компонент установки скинов

sSkinProvider1: TsSkinProvider; - компонент установки скинов

TabSheet1: TTabSheet; - вкладка

Panel1: TPanel; - компонент панель

Image1: TImage; - компонент для отображения изображения

Image2: TImage; - компонент для отображения изображения

Label1: TLabel; - метка

Label2: TLabel; - метка

Panel2: TPanel; - компонент панель

TrayIcon1: TTrayIcon; - компонент сворачивания в трей

PopupMenu1: TPopupMenu; - компонент меню

N1: TMenuItem; - вкладка меню

N2: TMenuItem; - вкладка меню

ClientSocket1: TClientSocket; - компонент обмена данными

TabSheet2: TTabSheet; - вкладка

Edit4: TEdit; - компонент отображения данных

Edit3: TEdit; - компонент отображения данных

Label3: TLabel; - метка

Label4: TLabel; - метка

Timer1: TTimer; - компонент таймер

ReConnect: TTimer; - компонент таймер

Label5: TLabel; - метка

Label6: TLabel; - метка

ListBox1: TListBox; - компонент отображения данных

ListBox2: TListBox; - компонент отображения данных

Label7: TLabel; - метка

Send: TTimer; - компонент таймер

Label8: TLabel; - метка

Image3: TImage; - компонент для отображения изображения

Label9: TLabel; - метка

procedure TrayIcon1Click(Sender: TObject); - процедура сворачивания в трей

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); - прцедура добавления вкладки IP - адреса

procedure ExitButtonClick(Sender: TObject); - процедура выхода из программы

procedure FormCreate(Sender: TObject); - процедура обработки событий

procedure FreezeButtonClick(Sender: TObject); - процедура «заморозки» данных

procedure UnFreezeButtonClick(Sender: TObject); - процедура «разморозки» данных

procedure RemoveInactiveButtonClick(Sender: TObject); - процедура удаления данных

procedure ledAdapterDescriptionChange(Sender: TObject); -процедура получения адаптера

procedure N2Click(Sender: TObject); - процедура выхода из программы

procedure ClientSocket1Connect(Sender: TObject;

Socket: TCustomWinSocket); - процедура подключения к серверу

procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); - процедура формирования пакета данных для отправки на сервер

procedure FormActivate(Sender: TObject); - процедура авторизации пользователя

procedure Timer1Timer(Sender: TObject); - процедура отправки данных по таймеру

procedure ReConnectTimer(Sender: TObject); - процедура переподключения к серверу

procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;

ErrorEvent: TErrorEvent; var ErrorCode: Integer); - процедура ошибки подключения к серверу

procedure ClientSocket1Disconnect(Sender: TObject;

Socket: TCustomWinSocket); - процедура разъединения с сервером

procedure SendTimer(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;

CanCloseForm:boolean;

NewTab: Integer;

nick:string;

implementation

{$R *.dfm}

function GetCompName:string;

var Len:Cardinal; pStr:PChar;

begin pStr:=nil; Len:=256;

try pStr:=StrAlloc(Len);

if GetComputerName(pStr,Len) then

Result:=pStr; finally

if pStr<>nil then StrDispose(pStr); end;

end;

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;

procedure TMainForm.TimerTimer(Sender: TObject);

begin

Timer.Enabled:=false;

ProcessMIBData;

Timer.Enabled:=true;

end;

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

begin ActiveTraffic:=nil;

end

else ActiveTraffic:=TTraffic(TrafficTabs.Tabs.Objects[NewTab]);

ClientSocket1.Socket.SendText(Nick);

ClientSocket1.Socket.SendText('Адаптер -'+ledAdapterDescription.text);

ClientSocket1.Socket.SendText('MAC-Адрес -'+ledMACAddress.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Начало в -'+ledStartedAt.Text);

ClientSocket1.Socket.SendText('Продолжительность -'+ledActiveFor.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Входящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctInSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakINSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgINSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalIN.Text);

ClientSocket1.Socket.SendText('Исходящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctOUTSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakOUTSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgOUTSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalOUT.Text);

RefreshDisplay;

end;

procedure TMainForm.ExitButtonClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

ClientSocket1.Port:=StrToInt(Edit3.Text);

ClientSocket1.Address:=Edit4.Text;

ClientSocket1.Open;

Sleep(1500);

Timer.Interval:=1000;

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;

end;

procedure TMainForm.ProcessMIBData;

var

MibArr: IpHlpAPI.TMIBIfArray;

i: integer;

ATraffic: TTraffic;

begin

Get_IfTableMIB(MibArr);

for i:= 0 to -1 + TrafficTabs.Tabs.Count do

begin

ATraffic:=TTraffic(TrafficTabs.Tabs.Objects[i]);

if ATraffic.Connected

then ATraffic.Found:=false;

end;

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

ATraffic.NewCycle(MIBArr[i].dwInOctets, MIBArr[i].dwOutOctets, MIBArr[i].dwSpeed);

end

else

begin

ATraffic:=TTraffic.Create(MIBArr[i], HandleNewAdapter);

ATraffic.Found:=true;

ATraffic.OnFreeze:=HandleFreeze;

ATraffic.OnUnFreeze:=HandleUnFreeze;

end;

end;

end;

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;

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;

procedure TMainForm.HandleNewAdapter(ATraffic: TTraffic);

begin

TrafficTabs.Tabs.AddObject(ATraffic.IP, ATraffic);

TrafficTabs.TabIndex:=-1+TrafficTabs.Tabs.Count;

end;

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

begin

ActiveTraffic.Free;

ActiveTraffic:=nil;

TrafficTabs.Tabs.Delete(TrafficTabs.TabIndex);

TrafficTabs.SelectNext(False);

end;

RefreshDisplay;

end;

procedure TMainForm.pcChange(Sender: TObject);

begin

pnlBottom.Visible:=pc.ActivePage=tsTraffic;

end;

procedure TMainForm.ledAdapterDescriptionChange(Sender: TObject);

begin

ledAdapterDescription.Hint:=ledAdapterDescription.Text;

ledAdapterDescription.ShowHint:=Canvas.TextWidth(ledAdapterDescription.Text)>ledAdapterDescription.ClientWidth;

end;

procedure TMainForm.N2Click(Sender: TObject);

begin

if MessageDlg('Вы действительно хотите выйти из программы?',mtConfirmation,[mbYes,mbNo],0)=mrYes

then

begin

CanCloseForm:=true;

Close;

end;

end;

procedure TMainForm.TrayIcon1Click(Sender: TObject);

begin

TrayIcon1.Visible := False;

Application.MainForm.Show;

end;

procedure TMainForm.ClientSocket1Connect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Socket.SendText('Ne>'+nick);

sleep(100);

Socket.SendText('>G<');

if (ListBox1.itemindex>=0) then begin

ClientSocket1.Socket.SendText(Nick);

end;

end;

procedure TMainForm.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

var mes,names,n,mmm:string; i:integer;

begin

mes:=Socket.ReceiveText;

if (mes[1]='m')and(mes[2]='m')and(mes[3]='m') then begin

mmm:=copy(mes,4,length(mes));

ShowMessage(mmm);

end;

if (mes[1]='(')and(mes[2]=')')and(mes[3]='=') then begin

names:=copy(mes,4,length(mes));

names:=names+'= =';

i:=-1; ListBox1.Items.Clear;

while n<>' ' do begin

i:=i+1;

n:=''; while names[i+1]<>'='do begin i:=i+1;

n:=n+names[i] end;

if n<>' ' then ListBox1.Items.Add(n);

end;

end else

if (mes[1]='<')and(mes[2]='USER')and(mes[3]='>') then

Socket.SendText('Ne>'+nick)

else begin i:=ListBox2.Items.Add(mes);

SendMessage(ListBox2.Handle,

LB_SETCURSEL,

ListBox2.Items.Count-1,0);

end;

end;

procedure TMainForm.FormActivate(Sender: TObject);

label beg; begin

beg:nick:=InputBox('Авторизация','Ф.И.О.',nick+'<USER>');

if length(nick)<1 then begin

ShowMessage('Вы не ввели Ф.И.О, Попробуйте ещё раз!'); goto beg end;

TrayIcon1.Visible:=True;

end;

procedure TMainForm.Button5Click(Sender: TObject);

begin

ClientSocket1.Port:=StrToInt(Edit3.Text);

ClientSocket1.Address:=Edit4.Text;

ClientSocket1.Open;

end;

procedure TMainForm.Timer1Timer(Sender: TObject);

begin

ClientSocket1.Socket.SendText(Nick);

ClientSocket1.Socket.SendText('Адаптер -'+ledAdapterDescription.text);

ClientSocket1.Socket.SendText('MAC-Адрес -'+ledMACAddress.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Начало в -'+ledStartedAt.Text);

ClientSocket1.Socket.SendText('Продолжительность -'+ledActiveFor.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Входящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctInSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakINSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgINSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalIN.Text);

ClientSocket1.Socket.SendText('Исходящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctOUTSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakOUTSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgOUTSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalOUT.Text);

end;

procedure TMainForm.ReConnectTimer(Sender: TObject);

begin

if not ClientSocket1.Active then ClientSocket1.Open;

end;

procedure TMainForm.ClientSocket1Error(Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

ShowMessage('Ошибка, Не удаётся соединится с сервером!!!!');

end;

procedure TMainForm.ClientSocket1Disconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ShowMessage('Соединение с сервером разоравано!!!!');

end;

procedure TMainForm.SendTimer(Sender: TObject);

begin

ClientSocket1.Socket.SendText(Nick);

ClientSocket1.Socket.SendText('Адаптер -'+ledAdapterDescription.Text);

ClientSocket1.Socket.SendText('MAC-Адрес -'+ledMACAddress.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Начало в -'+ledStartedAt.Text);

ClientSocket1.Socket.SendText('Продолжительность -'+ledActiveFor.Text);

ClientSocket1.Socket.SendText('Скорость -'+ledSpeed.Text);

ClientSocket1.Socket.SendText('Входящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctInSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakINSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgINSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalIN.Text);

ClientSocket1.Socket.SendText('Исходящий трафик >>');

ClientSocket1.Socket.SendText('Трафик/сек -'+ledOctOUTSec.Text);

ClientSocket1.Socket.SendText('Пик/сек -'+ledPeakOUTSec.Text);

ClientSocket1.Socket.SendText('Средний/сек -'+ledAvgOUTSec.Text);

ClientSocket1.Socket.SendText('Всего -'+ledTotalOUT.Text);

Send.Enabled:=false;

end;

end.

2.7.4 Описание модуля IPHLPAPI

Модуль IPHLPAPI служит для определения IP - Адреса пользователя (Листинг 4).

Листинг 4.

unit IPHLPAPI;

interface

uses

Windows, winsock;

const

ANY_SIZE = 1;

MAX_ADAPTER_DESCRIPTION_LENGTH = 128;

MAX_ADAPTER_NAME_LENGTH = 256;

MAX_ADAPTER_ADDRESS_LENGTH = 8;

DEFAULT_MINIMUM_ENTITIES = 32;

MAX_HOSTNAME_LEN = 128;

MAX_DOMAIN_NAME_LEN = 128;

MAX_SCOPE_ID_LEN = 256;

BROADCAST_NODETYPE = 1;

PEER_TO_PEER_NODETYPE = 2;

MIXED_NODETYPE = 4;

HYBRID_NODETYPE = 8;

NETBIOSTypes : array[0..8] of string[20] =

( 'UNKNOWN', 'BROADCAST', 'PEER_TO_PEER', '', 'MIXED', '', '', '', 'HYBRID'

);

IF_OTHER_ADAPTERTYPE = 0;

IF_ETHERNET_ADAPTERTYPE = 1;

IF_TOKEN_RING_ADAPTERTYPE = 2;

IF_FDDI_ADAPTERTYPE = 3;

IF_PPP_ADAPTERTYPE = 4;

IF_LOOPBACK_ADAPTERTYPE = 5;

IF_SLIP_ADAPTERTYPE = 6;

AdaptTypes : array[0..6] of string[10] =

( 'other', 'ethernet', 'tokenring', 'FDDI', 'PPP', 'loopback', 'SLIP' );

MAX_INTERFACE_NAME_LEN = 256; { mrapi.h }

MAXLEN_PHYSADDR = 8; { iprtrmib.h }

MAXLEN_IFDESCR = 256; { --"--- }

type

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

PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;

TIP_ADDRESS_STRING = array[0..15] of char;

PTIP_ADDR_STRING = ^TIP_ADDR_STRING;

TIP_ADDR_STRING = packed record

Next: PTIP_ADDR_STRING;

IpAddress: TIP_ADDRESS_STRING;

IpMask: TIP_ADDRESS_STRING;

Context: DWORD;

end;

PTFixedInfo = ^TFixedInfo;

TFixedInfo = packed record

HostName: array[0..MAX_HOSTNAME_LEN + 4] of char;

DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4] of char;

CurrentDNSServer: PTIP_ADDR_STRING;

DNSServerList: TIP_ADDR_STRING;

NodeType: UINT;

ScopeID: array[0..MAX_SCOPE_ID_LEN + 4] of char;

EnableRouting: UINT;

EnableProxy: UINT;

EnableDNS: UINT;

end;

PTMibIfRow = ^TMibIfRow;

TMibIfRow = packed record

wszName: array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;

dwIndex: DWORD;

dwType: DWORD;

dwMTU: DWORD;

dwSpeed: DWORD;

dwPhysAddrLen: DWORD;

bPhysAddr: array[1..MAXLEN_PHYSADDR] 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[1..MAXLEN_IFDESCR] of char;

end;

TMIBIfArray = array of TMIBIFRow;

PTMibIfTable = ^TMIBIfTable;

TMibIfTable = packed record

dwNumEntries: DWORD;

Table: array[0..ANY_SIZE - 1] of TMibIfRow;

end;

TTIME_T = array[1..325] of byte;

PTIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO;

TIP_ADAPTER_INFO = packed record

Next: PTIP_ADAPTER_INFO;

ComboIndex: DWORD;

AdapterName: array[1..MAX_ADAPTER_NAME_LENGTH + 4] of char;

Description: array[1..MAX_ADAPTER_DESCRIPTION_LENGTH + 4] of char;

AddressLength: UINT;

Address: array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

Index: DWORD;

aType: UINT;

DHCPEnabled: UINT;

CurrentIPAddress: PTIP_ADDR_STRING;

IPAddressList: TIP_ADDR_STRING;

GatewayList: TIP_ADDR_STRING;

DHCPServer: TIP_ADDR_STRING;

HaveWINS: BOOL;

PrimaryWINSServer: TIP_ADDR_STRING;

SecondaryWINSServer: TIP_ADDR_STRING;

LeaseObtained: TTIME_T;

LeaseExpires: TTIME_T;

end;

PTMibTCPRow = ^TMibTCPRow;

TMibTCPRow = packed record

dwState: DWORD;

dwLocalAddr: DWORD;

dwLocalPort: DWORD;

dwRemoteAddr: DWORD;

dwRemotePort: DWORD;

end;

PTMibTCPTable = ^TMibTCPTable;

TMibTCPTable = packed record

dwNumEntries: DWORD;

Table: array[0..0] of TMibTCPRow;

end;

PTMibTCPStats = ^TMibTCPStats;

TMibTCPStats = packed record

dwRTOAlgorithm: DWORD;

dwRTOMin: DWORD;

dwRTOMax: DWORD;

dwMaxConn: DWORD;

dwActiveOpens: DWORD;

dwPassiveOpens: DWORD;

dwAttemptFails: DWORD;

dwEstabResets: DWORD;

dwCurrEstab: DWORD;

dwInSegs: DWORD;

dwOutSegs: DWORD;

dwRetransSegs: DWORD;

dwInErrs: DWORD;

dwOutRsts: DWORD;

dwNumConns: DWORD;

end;

PTMibUDPRow = ^TMibUDPRow;

TMibUDPRow = packed record

dwLocalAddr: DWORD;

dwLocalPort: DWORD;

end;

PTMibUDPTable = ^TMIBUDPTable;

TMIBUDPTable = packed record

dwNumEntries: DWORD;

UDPTable: array[0..ANY_SIZE - 1] of TMibUDPRow;

end;

PTMibUdpStats = ^TMIBUdpStats;

TMIBUdpStats = packed record

dwInDatagrams: DWORD;

dwNoPorts: DWORD;

dwInErrors: DWORD;

dwOutDatagrams: DWORD;

dwNumAddrs: DWORD;

end;

PTMibIPNetRow = ^TMibIPNetRow;

TMibIPNetRow = packed record

dwIndex: DWord;

dwPhysAddrLen: DWord;

bPhysAddr: TMACAddress;

dwAddr: DWord;

dwType: DWord;

end;

PTMibIPNetTable = ^TMibIPNetTable;

TMibIPNetTable = packed record

dwNumEntries: DWORD;

Table: array[0..ANY_SIZE - 1] of TMibIPNetRow;

end;

PTMibIPStats = ^TMibIPStats;

TMibIPStats = packed record

dwForwarding: DWORD;

dwDefaultTTL: DWORD;

dwInReceives: DWORD;

dwInHdrErrors: DWORD;

dwInAddrErrors: DWORD;

dwForwDatagrams: DWORD;

dwInUnknownProtos: DWORD;

dwInDiscards: DWORD;

dwInDelivers: DWORD;

dwOutRequests: DWORD;

dwRoutingDiscards: DWORD;

dwOutDiscards: DWORD;

dwOutNoRoutes: DWORD;

dwReasmTimeOut: DWORD;

dwReasmReqds: DWORD;

dwReasmOKs: DWORD;

dwReasmFails: DWORD;

dwFragOKs: DWORD;

dwFragFails: DWORD;

dwFragCreates: DWORD;

dwNumIf: DWORD;

dwNumAddr: DWORD;

dwNumRoutes: DWORD;

end;

PTMibIPAddrRow = ^TMibIPAddrRow;

TMibIPAddrRow = packed record

dwAddr: DWORD;

dwIndex: DWORD;

dwMask: DWORD;

dwBCastAddr: DWORD;

dwReasmSize: DWORD;

Unused1,

Unused2: WORD;

end;

TMibIPAddrArray = array of TMIBIPAddrRow;

PTMibIPAddrTable = ^TMibIPAddrTable;

TMibIPAddrTable = packed record

dwNumEntries: DWORD;

Table: array[0..ANY_SIZE - 1] of TMibIPAddrRow;

end;

PTMibIPForwardRow = ^TMibIPForwardRow;

TMibIPForwardRow = packed record

dwForwardDest: DWORD;

dwForwardMask: DWORD;

dwForwardPolicy: DWORD;

dwForwardNextHop: DWORD;

dwForwardIFIndex: DWORD;

dwForwardType: DWORD;

dwForwardProto: DWORD;

dwForwardAge: DWORD;

dwForwardNextHopAS: DWORD;

dwForwardMetric1: DWORD;

dwForwardMetric2: DWORD;

dwForwardMetric3: DWORD;

dwForwardMetric4: DWORD;

dwForwardMetric5: DWORD;

end;

PTMibIPForwardTable = ^TMibIPForwardTable;

TMibIPForwardTable = packed record

dwNumEntries: DWORD;

Table: array[0..ANY_SIZE - 1] of TMibIPForwardRow;

end;

PTMibICMPStats = ^TMibICMPStats;

TMibICMPStats = packed record

dwMsgs: DWORD;

dwErrors: DWORD;

dwDestUnreachs: DWORD;

dwTimeEcxcds: DWORD;

dwParmProbs: DWORD;

dwSrcQuenchs: DWORD;

dwRedirects: DWORD;

dwEchos: DWORD;

dwEchoReps: DWORD;

dwTimeStamps: DWORD;

dwTimeStampReps: DWORD;

dwAddrMasks: DWORD;

dwAddrReps: DWORD;

end;

PTMibICMPInfo = ^TMibICMPInfo;

TMibICMPInfo = packed record

InStats: TMibICMPStats;

OutStats: TMibICMPStats;

end;

function GetAdaptersInfo( pAdapterInfo: PTIP_ADAPTER_INFO;

pOutBufLen: PULONG ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetNetworkParams( FixedInfo: PTFixedInfo; pOutPutLen: PULONG ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetTcpTable( pTCPTable: PTMibTCPTable; pDWSize: PDWORD;

bOrder: BOOL ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetTcpStatistics( pStats: PTMibTCPStats ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetUdpTable( pUdpTable: PTMibUDPTable; pDWSize: PDWORD;

bOrder: BOOL ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetUdpStatistics( pStats: PTMibUdpStats ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetIpStatistics( pStats: PTMibIPStats ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetIpNetTable( pIpNetTable: PTMibIPNetTable;

pdwSize: PULONG;

bOrder: BOOL ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetIpAddrTable( pIpAddrTable: PTMibIPAddrTable;

pdwSize: PULONG;

bOrder: BOOL ): DWORD;

stdcall; external 'IPHLPAPI.DLL';

function GetIpForwardTable( pIPForwardTable: PTMibIPForwardTable;

pdwSize: PULONG;

bOrder: BOOL ): DWORD;

stdCall; external 'IPHLPAPI.DLL';

function GetIcmpStatistics( pStats: PTMibICMPInfo ): DWORD;

stdCall; external 'IPHLPAPI.DLL';

function GetRTTAndHopCount( DestIPAddress: DWORD; HopCount: PULONG;

MaxHops: ULONG; RTT: PULONG ): BOOL;

stdCall; external 'IPHLPAPI.DLL';

implementation

end.

2.7.5 Описание модуля ServerUnit1

Модуль ServerUnit1 является главной формой в серверной части приложения, служит для получения информации от клиентской части приложения и отображения ее (Листинг 5).

Листинг 5.

unit ServerUnit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ScktComp, ExtCtrls, Buttons, Spin, ToolWin, ComCtrls,

sSkinProvider, sSkinManager, Menus, TrayIcon, TeeProcs, TeEngine, Chart,

jpeg, ExtDlgs, Grids;

type

TForm1 = class(TForm)

ServerSocket1: TServerSocket; - компонент обмена данными

Label1: TLabel; - метка

Button1: TButton; - кнопка

SpinEdit1: TSpinEdit; - окно для ввода данных

Button4: TButton; - кнопка

SpeedButton1: TSpeedButton; - кнопка

SaveDialog1: TSaveDialog;- компонент для сохранения данных в файл

PageControl1: TPageControl; - компонент для создания в кладок

TabSheet1: TTabSheet; - вкладка

Memo1: TListBox; - компонент отображения данных

ListBox1: TListBox; - компонент для отображения данных

sSkinManager1: TsSkinManager; - компонент для установки скинов

sSkinProvider1: TsSkinProvider; - компонент для установки скинов

TabSheet2: TTabSheet; - вкладка

TrayIcon1: TTrayIcon; - компонент для сворачивания в трей

PopupMenu1: TPopupMenu;- компонент меню

N1: TMenuItem; - вкладка меню

N2: TMenuItem; - вкладка меню

Timer1: TTimer; - компонент таймер

TabSheet3: TTabSheet; - вкладка

Image1: TImage; - компонент для отображения изображения

Timer2: TTimer; - компонент таймер

Panel1: TPanel; - компонент панель

Image2: TImage; - компонент для отображения изображения

Image3: TImage; - компонент для отображения изображения

Label2: TLabel; - метка

Label3: TLabel; - метка

Label4: TLabel; - метка

Button2: TButton; - кнопка

Button3: TButton;- кнопка

Label5: TLabel; - метка

SavePictureDialog1: TSavePictureDialog; - компонент для сохранения данных в файл

Image5: TImage; - компонент для отображения изображения

StringGrid1: TStringGrid; - компонент для отображения данных

Label6: TLabel; - метка

Label7: TLabel; - метка

procedure Button1Click(Sender: TObject); - процедура подключения к клиенту

procedure ServerSocket1ClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket); - процедура разъединения с клиентом

procedure ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket); - процедура формирования пакета данных для отправки на сервер

procedure ServerSocket1Listen(Sender: TObject;

Socket: TCustomWinSocket); - процедура вывода на дисплей статуса подключения

procedure Button4Click(Sender: TObject); - процедура отключения сервера

procedure SpinEdit1Change(Sender: TObject); -

procedure FormActivate(Sender: TObject); - процедура авторизации

procedure Memo1Click(Sender: TObject); - процедура отображения данных

procedure Memo1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState); - процедура изменения цвета строки

procedure SpeedButton1Click(Sender: TObject);

procedure FormCreate(Sender: TObject); - процедура обработки событий

procedure N2Click(Sender: TObject); - процедура сворачивания программы в трей

procedure N1Click(Sender: TObject); - процедура разворачивания программы из трея

procedure Timer2Timer(Sender: TObject); - процедура отображения данных по таймеру

procedure Button2Click(Sender: TObject); - процедура отображения графика

procedure Button3Click(Sender: TObject); - процедура сохранения графика

private

{ Private declarations }

public

{ Public declarations }

end;

const

NR = 4;

var

Form1: TForm1;

Nick:string;

n: array[1..NR] of real;

p: array[1..NR] of real;

h: array[1..NR] of integer;

BarColor: array[1..4] of TColor = (clRed,clGreen,clBlue,clYellow);

implementation

{$R *.dfm}

function GetNicks(listbox1:TListBox):string;

var ii:integer; names:string;

begin

for ii:=0 to ListBox1.Items.Capacity-1 do

names:=names+'='+ListBox1.Items[ii];

result:='()'+names+'='+nick;

end;

function Obr : boolean;

var

sum: real;

m: integer;

i: integer;

ii:integer; name,mes,names:string;

begin

obr := FALSE;

for i:=1 to NR do

begin

try

n[i]:=Form1.Memo1.Items.Add(mes);

except

on EConvertError do

begin

ShowMessage('Надо ввести данные во все' + #13 +

'ячейки второй колонки.');

exit;

end;

end;

end;

sum := 0;

for i:=1 to NR do

sum := sum + n[i];

for i:=1 to NR do

p[i] := n[i] / sum;

m := 1;

for i := 2 to NR do

if n[i] > n[m] then m:=i;

for i :=1 to NR do

h[i] := Round((Form1.Image1.Height - 20) *

n[i]/n[m]);

obr := TRUE;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ServerSocket1.Port:=SpinEdit1.Value;

ServerSocket1.Open;

Button1.Enabled:=false;

Button4.Enabled:=true;

button2.Enabled:=true;

button3.Enabled:=true;

end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

var ii,gf:integer;

begin

gf:=ListBox1.Items.Capacity-1;

ListBox1.Items.Clear;

for ii:=0 to gf do

try ServerSocket1.Socket.Connections[ii].SendText('<S>');

except end;

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket);

var ii:integer; name,mes,names:string;

begin

mes:=Socket.ReceiveText;

name:=''; names:='';

if (mes[1]='N')and(mes[2]='e')and(mes[3]='>')then begin

name:=copy(mes,4,length(mes));

ListBox1.Items.Add(name);

for ii:=0 to ListBox1.Items.Capacity do

try ServerSocket1.Socket.Connections[ii].SendText(GetNicks(ListBox1));

except end; end else

if (mes[1]='>')and(mes[2]='G')and(mes[3]='<')then begin

Socket.SendText(GetNicks(ListBox1));

end else

begin

Memo1.Items.Add(mes);

for ii:=0 to ListBox1.Items.Capacity-1 do try

ServerSocket1.Socket.Connections[ii].SendText(mes);

except end;

SendMessage(Memo1.Handle,

LB_SETCURSEL,

Memo1.Items.Capacity-1,0);

end;

end;

procedure TForm1.ServerSocket1Listen(Sender: TObject;

Socket: TCustomWinSocket);

var i:integer;

begin

i:=Memo1.Items.Add(TimeToStr(now)+'- Connecting... ');

SendMessage(Memo1.Handle,LB_SETCURSEL,i,0);

end;

procedure diagr;

const

WR = 25;

DR = 10;

var

x,y,i: integer;

begin

with Form1.Image1 do

begin

x:=10;

y:=Height;

Canvas.Brush.Color := clWindow;

Canvas.Rectangle(0,0,Width,Height);

for i:=1 to 4 do

begin

Canvas.Brush.Color := BarColor[i];

Canvas.Rectangle(x,y,x+WR,y-h[i]);

Canvas.Brush.Color := clWindow;

Canvas.TextOut(x,y-h[i]-15,

FloatToStrF(p[i]*100,ffGeneral,3,2)+'%');

x := x + WR + DR;

end;

x := x + 20;

y:=20;

for i:=1 to 4 do

begin

Canvas.Brush.Color := BarColor[i];

Canvas.Rectangle(x,y,x+25,y+14);

Canvas.Brush.Color := clWindow;

Canvas.TextOut(x+WR+10,y,

Form1.StringGrid1.Cells[0,i]);

Form1.StringGrid1.Visible:=false;

Form1.StringGrid1.Cells[0,1]:='Трафик / сек';

Form1.StringGrid1.Cells[0,2]:='Пик / сек';

Form1.StringGrid1.Cells[0,3]:='Средний / сек';

Form1.StringGrid1.Cells[0,4]:='Всего';

y := y + 20;

end;

end;

end;

procedure TForm1.Button4Click(Sender: TObject);

var

i:integer;

begin

ServerSocket1.Close;

i:=Memo1.Items.Add(TimeToStr(now)+' - ServerSocket.Close');

SendMessage(Memo1.Handle,LB_SETCURSEL,i,0);

Button4.Enabled:=false;

Button1.Enabled:=true;

button2.Enabled:=false;

button3.Enabled:=false;

end;

procedure TForm1.SpinEdit1Change(Sender: TObject);

begin

Button4.Click;

end;

function GetCompName:string;

var Len:Cardinal; pStr:PChar;

begin pStr:=nil; Len:=256;

try pStr:=StrAlloc(Len);

if GetComputerName(pStr,Len) then

Result:=pStr; finally

if pStr<>nil then StrDispose(pStr); end;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

nick:='Server';

Memo1.Items.Clear;

Memo1.Items.add(getcompname);

Memo1.Items.Add(nick);

end;

procedure TForm1.Memo1Click(Sender: TObject);

var s:string;

begin

s:=Memo1.Items[Memo1.itemindex];

ListBox1.Canvas.Font:=ListBox1.Font;

if Canvas.TextWidth(s)>=Memo1.Width then begin

Memo1.Hint:=s; Memo1.ShowHint:=true; end else begin

memo1.ShowHint:=false; memo1.hint:=''; end;

end;

procedure TForm1.Memo1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

vAr K,f,al:STRING; X:INTEGER;

BeGiN

k:=copy(Memo1.Items[index],1,length(nick));

If k=nick THEN

Memo1.Canvas.Brush.Color:=$9ae916;

Memo1.Canvas.Font.Color:=$000000;

Memo1.Canvas.FillRect(rect);

Memo1.Canvas.TextOut(Rect.Left+1,Rect.Top+2,Memo1.Items[index]);

End;

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

if SaveDialog1.Execute then

Memo1.Items.SaveToFile(SaveDialog1.FileName+'.txt');

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

begin

ListBox1.ItemIndex:=1;

Sleep(2000);

TrayIcon1.Visible:=True;

diagr;

button2.Enabled:=false;

button3.Enabled:=false;

end;

procedure TForm1.N2Click(Sender: TObject);

begin

if MessageDlg('Вы действительно хотите выйти из программы?',mtConfirmation,[mbYes,mbNo],0)=mrYes

then

begin

Close;

end;

end;

procedure TForm1.N1Click(Sender: TObject);

begin

TrayIcon1.ActOnMinimize:=True;

TrayIcon1.Visible:=false;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

diagr;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if Obr

then diagr;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

if SavePictureDialog1.Execute then

Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.jpeg');

end;

End.

3. Рекомендации по охране труда, технике безопасности и охране окружающей среды

3.1 Рабочее место администратора локальной сети

Несмотря на то, что сеть может охватывать значительную площадь и войти в нее (авторизоваться) можно с любого подключенного к ней компьютера, рабочее место администратора сети должно быть по возможности ближе к основному серверу сети. Размещение рабочего места в непосредственной близости к серверу избавит от излишней ходьбы, если необходимо срочно предпринять какие-либо меры. Как бы надежно ни было оборудование и программное обеспечение, ни для кого не секрет, что всегда возможно "зависание" системы или отдельной программы. В этом случае даже наличие специальных средств удаленного управления не позволит оперативно решить проблему. Необходимо личное присутствие администратора около сервера. При этом рабочее место администратора сети, точнее рабочий компьютер, не должен совпадать с компьютером-сервером. Несмотря на высокий уровень подготовки, никто не застрахован от ошибок. А ошибка, допущенная при работе на сервере, может стать причиной простоя сети в течение продолжительного времени. Конечно, полностью исключить необходимость выключения или перезагрузки сервера невозможно, но время проведения этих операций и их количество должно быть минимизировано.

Наиболее удобный вариант расположения рабочего места -- это "серверная" (отдельное помещение, где расположен сервер или серверы). Само собой разумеется, что от компьютеров сети, коммутаторов, расположенных в сети, от других сетей, возможно, взаимодействующих с серверной подходит значительное число кабелей. Часто начинающие администраторы считают, что когда возникнет необходимость, можно изменить подключения, переложить кабели, заменить оборудование. На самом деле, если заранее не предусмотреть возможности расширения сети, наступит момент, когда она будет неработоспособна продолжительное время, которое может составлять не один день; даже после восстановления ее работоспособности придется завершать начатые работы не одну неделю. Лучше заранее готовиться к будущим проблемам. Естественно, что такая подготовка потребует некоторых затрат, которые на данный момент "не требуются", но эти затраты необходимы. Если выделение средств на техническое обеспечение сети зависит от руководства организации, в которой эксплуатируется сеть, необходимо доказать, что затраты необходимы именно теперь.

Позднее затраты будут выше, учитывая потери, к которым приведет продолжительный простой сети, а также оплату за работу, которая будет выполняться.

Немаловажен организованный монтаж кабеля, содержания его, и сетевого оборудования в специальных шкафах. При этом значительно уменьшается вероятность случайного доступа к кабелям и оборудованию, находящемуся в шкафу. Возле каждого гнезда на патч-панелях должны быть этикетки с подписями о назначении данного соединения. Неплохо иметь и список всех гнезд с указанием их назначения.