Программа мониторинга событий в ЛВС

dfm}

procedure TForm1. FormCreate (Sender: TObject);

var name_bd: String;

TT: TStringList;

i: Integer;

begin

//создадим БД формата ACCESS

name_bd:=ExtractFilePath (Application.ExeName)+'lan.mdb';

CreateMSAccessDB (name_bd);

//строка для соединения с БД

ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.

4.0;Data Source='+name_bd+';Persist Security Info=False';

try

ADOConnection1.Open;

except

ADOConnection1.Close;

ShowMessage ('Ошибка при соединениии с базой данных!');

Application.Terminate;

end;

ADOQuery1.Connection:=ADOConnection1;

//создадим массив с названиями таблиц

TT:=TStringList.Create;

ADOConnection1.GetTableNames (TT);

//проверим на наличие каждой таблицы и в случае отсутствия создадим ее

if (TT.IndexOf ('flash')=-1) then

begin

// создание таблицы для flash-устройств

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add ('CREATE TABLE flash (');

ADOQuery1.SQL.Add ('computer_name varchar (48) not null, ');

ADOQuery1.SQL.Add ('flash_type varchar (24) not null, ');

ADOQuery1.SQL.Add ('flash_action tinyint not null, ');

ADOQuery1.SQL.Add ('flash_dt datetime not null ');

ADOQuery1.SQL.Add (')');

try

ADOQuery1.ExecSQL;

except

ADOConnection1.Close;

ShowMessage ('Ошибка при создании таблицы flash!');

Application.Terminate;

end;

end;

if (TT.IndexOf ('visiturl')=-1) then

begin

// создание таблицы для посещений Интернет-ресурсов

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add ('CREATE TABLE visiturl (');

ADOQuery1.SQL.Add ('computer_name varchar (48) not null, ');

ADOQuery1.SQL.Add ('url varchar (255) not null, ');

ADOQuery1.SQL.Add ('url_title varchar (255) not null, ');

ADOQuery1.SQL.Add ('url_visited datetime not null, ');

ADOQuery1.SQL.Add ('url_updated datetime not null, ');

ADOQuery1.SQL.Add ('url_expires datetime not null, ');

ADOQuery1.SQL.Add ('dt datetime not null ');

ADOQuery1.SQL.Add (')');

try

ADOQuery1.ExecSQL;

except

ADOConnection1.Close;

ShowMessage ('Ошибка при создании таблицы visiturl!');

Application.Terminate;

end;

end;

if (TT.IndexOf ('computer')=-1) then

begin

// создание таблицы для списка компьютеров в ЛВС

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add ('CREATE TABLE computer (');

ADOQuery1.SQL.Add ('computer_name varchar (48) not null, ');

ADOQuery1.SQL.Add ('computer_dt datetime not null ');

ADOQuery1.SQL.Add (')');

try

ADOQuery1.ExecSQL;

except

ADOConnection1.Close;

ShowMessage ('Ошибка при создании таблицы computer!');

Application.Terminate;

end;

end;

//Добавляем иконку в трей при старте программы:

nid.cbSize := SizeOf (TNotifyIconData);

nid.Wnd := Form1. Handle;

nid.uID := 1;

nid.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

nid.uCallbackMessage := WM_USER + 100;

nid.hIcon := Application.Icon.Handle;

StrPCopy (nid.szTip, 'Мониториг ЛВС');

Shell_NotifyIcon (NIM_ADD, @nid);

PageControl1.Align:=AlClient;

for i:=0 to PageControl1. PageCount-1 do

PageControl1.Pages[i]. TabVisible:=False;

Timer1.Interval:=SpinEdit1.Value;

Timer1.Enabled:=CheckBox1.Checked;

FormResize (Form1);

Timer1Timer (Form1);

end;

procedure TForm1. IconCallBackMessage (var Mess: TMessage);

begin

case Mess. lParam of WM_RBUTTONUP: //Обрабатываем нажатие правой кнопкой мыши.

begin

PopupMenu.Popup (Mouse.CursorPos.x, Mouse.CursorPos.y); //заставляем «всплыть» наше меню:)

end;

end;

end;

procedure TForm1. WMSYSCOMMAND (var msg: TMessage);

begin

inherited;

if (msg.wParam=SC_MINIMIZE) then Form1. Hide;

if (msg.wParam=SC_CLOSE) then Form1. Hide;

end;

procedure TForm1. N1Click (Sender: TObject);

begin

Form1.Show;

Form1.Activate;

end;

procedure TForm1. N2Click (Sender: TObject);

begin

Form1.Close;

Application.Terminate;

end;

procedure TForm1. FormDestroy (Sender: TObject);

begin

Shell_NotifyIcon (NIM_DELETE, @nid);

end;

procedure TForm1. FormClose (Sender: TObject; var Action: TCloseAction);

begin

Action:=caNone;

end;

procedure TForm1. Timer1Timer (Sender: TObject);

begin

Screen.Cursor:=crHourGlass;

FillDrives;

List_computer;

VisitURL;

Screen.Cursor:=crDefault;

end;

procedure TForm1. VisitURL;

var

r: Staturl;

s, ss: string;

Enum: IEnumStatUrl;

X, j, k, Row, iSize: integer;

dat1,dat2: String;

begin

Timer1.Enabled:=False;

IRL_Hist:=CreateComObject (ClsId_CUrlHistory) as IUrlHistoryStg2;

IRL_Hist.EnumUrls (Enum);

Enum.SetFilter (StringToPWide (ComboBox1.Text, iSize), 0);

ComboBox1.Clear;

Row:=0;

if (Enum.Next (1, r, @X) <> S_OK) then

begin

IRL_Hist.EnumUrls (Enum);

Enum.SetFilter (StringToPWide (ComboBox1.Text, iSize), 0);

end;

while Enum. Next (1, r, @X) = S_OK do

begin

inc (Row);

Form1.Caption:='Get IE history (URL''s: '+IntToStr (Row)+')';

s:=Widechar (Pointer (r.pwcsUrl));

ss:=Widechar (Pointer (r.pwcsUrl));

j:=pos ('://', ss);

Delete (ss, 1, j+2);

if pos ('/', ss)<>0 then

begin

k:=pos ('/', ss);

Delete (s,(j+k)+2,Length (s));

end;

ComboBox1.Items.Add (s);

//проверить наличие

ADOQuery1.SQL.Clear;

ADOQuery1.ParamCheck:=False;

ADOQuery1.SQL.Add ('select * from visiturl ');

ADOQuery1.SQL.Add ('where url='+QuotedStr (copy (PWidechar (Pointer (r.pwcsUrl)), 1,255)));

dat1:='#'+copy (DateTimeToStr (FileTimeToDt (r.ftLastVisited)), 4,2)+'/'+copy (DateTimeToStr (FileTimeToDt (r.ftLastVisited)), 1,2)+'/'+copy (DateTimeToStr (FileTimeToDt (r.ftLastVisited)), 7,4)+

' '+copy (DateTimeToStr (FileTimeToDt (r.ftLastVisited)), 12,8)+'#';

dat2:='#'+copy (DateTimeToStr (FileTimeToDt (r.ftExpires)), 4,2)+'/'+copy (DateTimeToStr (FileTimeToDt (r.ftExpires)), 1,2)+'/'+copy (DateTimeToStr (FileTimeToDt (r.ftExpires)), 7,4)+

' '+copy (DateTimeToStr (FileTimeToDt (r.ftExpires)), 12,8)+'#';

ADOQuery1.SQL.Add (' and url_visited='+dat1);

ADOQuery1.SQL.Add (' and url_expires='+dat2);

try

ADOQuery1.Open;

if (ADOQuery1.RecordCount=0) then

begin

//запись в таблицу посещений

ADOQuery1.Close;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add ('insert into visiturl (computer_name, url, url_title, url_visited, url_updated, url_expires, dt) ');

ADOQuery1.SQL.Add ('values ('+QuotedStr (copy (GetComputerNetName, 1,48))+',');

ADOQuery1.SQL.Add (QuotedStr (copy (PWidechar (Pointer (r.pwcsUrl)), 1,255))+',');

ADOQuery1.SQL.Add (QuotedStr (copy (PWidechar (Pointer (r.pwcsTitle)), 1,255))+',');

ADOQuery1.SQL.Add (QuotedStr (DateTimeToStr (FileTimeToDt (r.ftLastVisited)))+',');

ADOQuery1.SQL.Add (QuotedStr (DateTimeToStr (FileTimeToDt (r.ftLastUpdated)))+',');

ADOQuery1.SQL.Add (QuotedStr (DateTimeToStr (FileTimeToDt (r.ftExpires)))+',');

ADOQuery1.SQL.Add (QuotedStr (FormatDateTime ('dd.mm.yyyy HH: mm:ss', now))+')');

ADOQuery1.ExecSQL;

end;

except

end;

ADOQuery1.Close;

Application.ProcessMessages;

end;

Timer1.Enabled:=CheckBox1.Checked;

end;

function TForm1. StringToPWide (sStr: string; var iNewSize: integer): PWideChar;

var

pw: PWideChar;

iSize: integer;

begin

iSize:=Length (sStr)+1;

iNewSize:=iSize*2;

pw:=AllocMem (iNewSize);

MultiByteToWideChar (CP_ACP, 0, PChar (sStr), iSize, pw, iNewSize);

Result:=pw;

end;

function TForm1. FileTimeToDt (Ft: TFileTime): TDateTime;

var

l: integer;

lft: TFileTime;

begin

FileTimeToLocalFiletime (Ft, lft);

if FileTimeToDosDateTime (lft, Longrec (l).Hi, Longrec (l).Lo)

then result:=FiledateToDatetime (l)

else result:=0;

end;

procedure TForm1. CreateMSAccessDB (filename: String);

var accessMDB, DAOEngine: Variant;

NameBD: String;

begin

//процедура создания БД — файла Access с именем filename

NameBD := ('Provider=Microsoft.Jet.OLEDB.

4.0;Data Source='+ FileName + ';');

if FileExists (FileName) <> TRUE then begin

try

accessMDB := CreateOleObject ('ADOX.Catalog'); // ADOX

DAOEngine := CreateOleObject ('DAO.DBEngine.36');

except

try

DAOEngine := CreateOleObject ('DAO.DBEngine.35');

except

begin

ShowMessage ('Ошибка создания -> DAO. DBEngine');

Exit;

end;

end;

end;

try

accessMDB.Create (NameBD); // работа с ADOX

accessMDB := NULL;

except

begin

ShowMessage ('Ошибка создания БД -> ' + FileName);

Exit;

end;

end;

end;

end;

procedure TForm1. N8Click (Sender: TObject);

begin

//показ 1 страницы

Screen.Cursor:=crDefault;

PageControl1.ActivePageIndex:=0;

PageControl1.Pages[0]. TabVisible:=True;

TabSheet1.Caption:=N3.Caption;

DateTimePicker1.Date:=date;

DateTimePicker2.Date:=date;

end;

procedure TForm1. N4Click (Sender: TObject);

var dat1, dat2: String;

begin

//просмотр посещений интернет-ресурсов за период

Screen.Cursor:=crDefault;

DBGrid1.Visible:=True;

dat1:='#'+copy (DateToStr (DateTimePicker1.Date), 7,4)+'

-'+copy (DateToStr (DateTimePicker1.Date), 4,2)+'

-'+copy (DateToStr (DateTimePicker1.Date), 1,2)+'#';

dat2:='#'+copy (DateToStr (DateTimePicker2.Date+1), 7,4)+'

-'+copy (DateToStr (DateTimePicker2.Date+1), 4,2)+'

-'+copy (DateToStr (DateTimePicker2.Date+1), 1,2)+'#';

ADODataSet1.Close;

ADODataSet1.CommandText:='select * from visiturl where url_visited >= '+dat1+' and url_visited<='+dat2+ ' order by url_visited ';

ADODataSet1.Open;

end;

procedure TForm1. DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if (ADODataSet1.RecNo mod 2=0) then

DBGrid1.Canvas.Brush.Color:=$ 00F5EBEC

else

DBGrid1.Canvas.Brush.Color:=$ 00E8E7E3;

DBGrid1.Canvas.Font.Color:=clBlack;

if (Column.Field.FieldName='url') then

begin

DBGrid1.Canvas.Font.Style:=[fsUnderline];

DBGrid1.Canvas.Font.Color:=$ 00FF8080;

end;

DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State);

end;

procedure TForm1. DataSource1DataChange (Sender: TObject; Field: TField);

begin

StatusBar1.Panels[0]. Text:='Всего: '+IntToStr (ADODataSet1.RecordCount);

StatusBar1.Panels[1]. Text:='Запись: '+IntToStr (ADODataSet1.Recno);

end;

procedure TForm1. DBGrid1DblClick (Sender: TObject);

begin

try

ShellExecute (0,'open', PChar (ADODataSet1.FieldByName ('url').AsString),'','', SW_SHOW);

except

ShowMessage ('Ошибка при загрузке адреса Интернет-ресурса!');

end;

end;

procedure TForm1. N5Click (Sender: TObject);

var varr: String;

TT:TstringList;

i: Integer;

begin

//вывод в Excel

if (not ADODataSet1. Active) then exit;

Screen.Cursor:=crDefault;

TT:=TStringList.Create;

varr:=PageControl1.ActivePage.Caption;

ADODataSet1.DisableControls;

for i:=0 to DBGrid1.Columns.Count-1 do

TT.Add (DBGrid1.Columns[i]. Title. Caption);

excel_array (DBGrid1.DataSource.DataSet, 1, varr, TT);

ADODataSet1.EnableControls;

end;

procedure TForm1. excel_array (QQ:TDataSet;Page_Orientation:Integer;Title_Excel:String;Header_Excel:TStringList);

var XL, TableVals, WorkBook: Variant; // Врем. массив для переноса значений в Excel

i, LineCounter: Integer; // Счетчик строк для переноса записей в Excel

begin

TableVals:=VarArrayCreate ([0, QQ. RecordCount-1,//кол-во строк

0, Header_Excel.Count-1], // кол-во столбцов

varVariant);

QQ.First;

LineCounter := 0;

while not QQ. EOF do

begin

for i := 0 to Header_Excel.Count-1 do

begin

if not QQ. Fields[i]. IsNull then

TableVals[LineCounter, i] := QQ. Fields[i]. AsString

else

TableVals[LineCounter, i] := '';

end;

LineCounter := LineCounter + 1;

QQ.Next;

end;

XL := CreateOleObject ('Excel.Application');

WorkBook := XL.WorkBooks.Add;

WorkBook := XL. WorkBooks[1] ;

XL.Application.WindowState:=1;

try

XL.ActiveSheet.PageSetup.Orientation:=Page_Orientation;

XL.ActiveSheet.PageSetup.LeftMargin:=0;

XL.ActiveSheet.PageSetup.RightMargin:=0;

XL.ActiveSheet.PageSetup.TopMargin:=0;

XL.ActiveSheet.PageSetup.BottomMargin:=0;

except

end;

XL.Cells.Select;

XL.Selection.Font.Name:='Arial Cyr';

XL.Selection.Font.Size:=8;

XL.range['A1']. Select;

XL.ActiveCell.FormulaR1C1:=Title_Excel;

XL.Selection.Font.Size:=10;

XL.Selection.Font.Bold:=True;

for i:=0 to Header_Excel.Count-1 do

begin

XL.range[col_name (i)+'2']. Select;

XL.ActiveCell.FormulaR1C1:=Header_Excel[i];

end;

XL.Rows['2']. Select;

XL.Selection.Font.Bold:=True;

//данные с 3 строки

XL.Range[XL.Cells[3,1], XL. Cells[QQ.RecordCount+2,Header_Excel.Count]]. Value := TableVals;

XL.Range['A2:'+col_name (Header_Excel.Count-1)+IntToStr (QQ.RecordCount+2)]. Select;

XL.Selection.Columns.AutoFit;

XL.Selection.Borders[7]. LineStyle:=1;

XL.Selection.Borders[8]. LineStyle:=1;

XL.Selection.Borders[9]. LineStyle:=1;

XL.Selection.Borders[10]. LineStyle:=1;

XL.Selection.Borders[11]. LineStyle:=1;

XL.Range['A1:'+col_name (Header_Excel.Count-1)+'1'].Select;

XL.Selection.HorizontalAlignment:=-4108;

XL.Selection.MergeCells:=True;

XL.Range['A1:'+col_name (Header_Excel.Count-1)+IntToStr (QQ.RecordCount+2)].Select;

XL.Selection.Font.Size:=8;

XL.Visible := True;

end;

function TForm1. Col_name (i_col:Integer):String;

begin

if i_col>255 then result:=''

else

begin

if i_col<26 then result:=chr (65+i_col)

else

result:=chr ((i_col div 26)+64)+chr ((i_col mod 26)+65);

end;

end;

procedure TForm1. FormResize (Sender: TObject);

var i, cwidth: Integer;

begin

//изменение размеров формы

cwidth:=trunc ((Form1.Width-90)/DBGrid1.Columns.Count);

for i:=0 to DBGrid1.Columns.Count-1 do

DBGrid1.Columns[i]. Width:=cwidth;

cwidth:=trunc ((Form1.Width-90)/DBGrid2.Columns.Count);

for i:=0 to DBGrid2.Columns.Count-1 do

DBGrid2.Columns[i]. Width:=cwidth;

cwidth:=trunc ((Form1.Width-90)/DBGrid3.Columns.Count);

for i:=0 to DBGrid3.Columns.Count-1 do

DBGrid3.Columns[i]. Width:=cwidth;

end;

procedure TForm1. DataSource2DataChange (Sender: TObject; Field: TField);

begin

StatusBar2.Panels[0]. Text:='Всего: '+IntToStr (ADODataSet2.RecordCount);

StatusBar2.Panels[1]. Text:='Запись: '+IntToStr (ADODataSet2.Recno);

end;

procedure TForm1. N9Click (Sender: TObject);

var dat1, dat2: String;

begin

//просмотр с USB-устройствами за период

Screen.Cursor:=crDefault;

DBGrid2.Visible:=True;

dat1:='#'+copy (DateToStr (DateTimePicker3.Date), 7,4)+'

-'+copy (DateToStr (DateTimePicker3.Date), 4,2)+'

-'+copy (DateToStr (DateTimePicker3.Date), 1,2)+'#';

dat2:='#'+copy (DateToStr (DateTimePicker4.Date+1), 7,4)+'

-'+copy (DateToStr (DateTimePicker4.Date+1), 4,2)+'

-'+copy (DateToStr (DateTimePicker4.Date+1), 1,2)+'#';

ADODataSet2.Close;

ADODataSet2.CommandText:='select computer_name, flash_type,'+

'iif (flash_action=0," извлечение" ," вставка") as flash_act,'+

'flash_dt from flash where flash_dt >= '+dat1+' and flash_dt <='+dat2+ ' order by flash_dt ';

ADODataSet2.Open;

end;

procedure TForm1. N7Click (Sender: TObject);

var varr: String;

TT:TstringList;

i: Integer;

begin

//вывод в Excel

if (not ADODataSet2. Active) then exit;

Screen.Cursor:=crDefault;

TT:=TStringList.Create;

varr:=PageControl1.ActivePage.Caption;

ADODataSet2.DisableControls;

for i:=0 to DBGrid2.Columns.Count-1 do

TT.Add (DBGrid2.Columns[i]. Title. Caption);

excel_array (DBGrid2.DataSource.DataSet, 1, varr, TT);

ADODataSet2.EnableControls;

end;

procedure TForm1. N6Click (Sender: TObject);

begin

//показ 2 страницы

Screen.Cursor:=crDefault;

PageControl1.ActivePageIndex:=1;

PageControl1.Pages[1]. TabVisible:=True;

TabSheet2.Caption:=N12.Caption;

DateTimePicker3.Date:=date;

DateTimePicker4.Date:=date;

end;

procedure TForm1. N11Click (Sender: TObject);

begin

//показ 3 страницы

Screen.Cursor:=crDefault;

PageControl1.ActivePageIndex:=2;

PageControl1.Pages[2]. TabVisible:=True;

TabSheet3.Caption:=N10.Caption;

end;

procedure TForm1. SpinEdit1Change (Sender: TObject);

begin

Timer1.Interval:=SpinEdit1.Value;

end;

procedure TForm1. CheckBox1Click (Sender: TObject);

begin

Timer1.Enabled:=CheckBox1.Checked;

end;

function TForm1. GetComputerNetName: string;

var

buffer: array[0.255] of char;

size: dword;

begin

size := 256;

if GetComputerName (buffer, size) then

Result := buffer

else

Result := ''

end;

procedure TForm1. Button1Click (Sender: TObject);

begin

EnumRec (NIL, 0);

end;

procedure TForm1. List_computer;

begin

EnumRec (NIL, 0);

end;

procedure TForm1. EnumRec (start:PNetResource; lev: LongInt);

var

i :LongInt;

hEnum :Cardinal;

res, cnt: Cardinal;

bufsize :Cardinal;

p :Cardinal;

nr :PNetResource;

st :String;

pk :String;

begin

Screen.Cursor:=crHourGlass;

Timer1.Enabled:=False;

//Form1.Memo1.Lines.Clear;

st:='';

for i:=1 to lev do st:=st+' ';

res:=WNetOpenEnum (RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, start, hEnum);

if res=NO_ERROR then

repeat

bufsize:=16 384;

p:=GlobalAlloc (GPTR, bufsize);

cnt:=$FFFFFFFF;

res:=WNetEnumResource (hEnum, cnt, Pointer (p), bufsize);

if res=NO_ERROR then

for i:=0 to cnt-1 do

begin

nr:=PNetResource (Pointer (p+Cardinal (i)*SizeOf (NetResource)));

//if nr. lpLocalName<>NIL then Form1. Memo1.Lines.Add (nr.lpLocalName+' '+nr.lpRemoteName);

if nr. lpRemoteName<>NIL then

begin

if ((copy (nr.lpRemoteName, 1,2)='\') and (pos ('', copy (nr.lpRemoteName, 3, length (nr.lpRemoteName)-2))=0)) then

begin

pk:=copy (copy (nr.lpRemoteName, 3, length (nr.lpRemoteName)-2), 1,48);

//проверить наличие

ADOQuery1.SQL.Clear;

ADOQuery1.ParamCheck:=False;

ADOQuery1.SQL.Add ('select DateDiff («d», a. computer_dt, Date ()) as dday ');

ADOQuery1.SQL.Add ('from (select max (computer_dt) as computer_dt ');

ADOQuery1.SQL.Add ('from computer ');

ADOQuery1.SQL.Add ('where computer_name='+QuotedStr (pk)+') a');

ADOQuery1.SQL.Add ('where a. computer_dt is not null ');

ADOQuery1.Open;

if ((ADOQuery1.RecordCount=0) or (ADOQuery1.FieldByname ('dday').AsInteger>0)) then

begin

//запись в таблицу computer

ADOQuery1.Close;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add ('insert into computer (computer_name, computer_dt) ');

ADOQuery1.SQL.Add ('values ('+QuotedStr (pk)+',');

ADOQuery1.SQL.Add (QuotedStr (FormatDateTime ('dd.mm.yyyy HH: mm:ss', now))+')');

//ShowMessage (ADOQuery1.SQL.Text);

try

ADOQuery1.ExecSQL;

except

end;

ADOQuery1.Close;

end;

end;

end;

if lev<3 then EnumRec (nr, lev+1);

end

else

if res<>ERROR_NO_MORE_ITEMS then

begin

GlobalFree (p);

break;

end;

GlobalFree (p);

until res=ERROR_NO_MORE_ITEMS;

WNetCloseEnum (hEnum);

Timer1.Enabled:=CheckBox1.Checked;

Screen.Cursor:=crDefault;

end;

procedure TForm1. N14Click (Sender: TObject);

begin

//показ 4 страницы

Screen.Cursor:=crDefault;

PageControl1.ActivePageIndex:=3;

PageControl1.Pages[3]. TabVisible:=True;

TabSheet4.Caption:=N13.Caption;

DateTimePicker5.Date:=date;

DateTimePicker6.Date:=date;

end;

procedure TForm1. N15Click (Sender: TObject);

var dat1, dat2: String;

begin

//просмотр с USB-устройствами за период

Screen.Cursor:=crDefault;

DBGrid3.Visible:=True;

dat1:='#'+copy (DateToStr (DateTimePicker5.Date), 7,4)+'

-'+copy (DateToStr (DateTimePicker5.Date), 4,2)+'

-'+copy (DateToStr (DateTimePicker5.Date), 1,2)+'#';

dat2:='#'+copy (DateToStr (DateTimePicker6.Date+1), 7,4)+'

-'+copy (DateToStr (DateTimePicker6.Date+1), 4,2)+'

-'+copy (DateToStr (DateTimePicker6.Date+1), 1,2)+'#';

ADODataSet3.Close;

ADODataSet3.CommandText:='select * from computer where computer_dt>= '+dat1+' and computer_dt<='+dat2+ ' order by computer_name, computer_dt desc ';

ADODataSet3.Open;

end;

procedure TForm1. Excel1Click (Sender: TObject);

var varr: String;

TT:TstringList;

i: Integer;

begin

//вывод в Excel

if (not ADODataSet3. Active) then exit;

Screen.Cursor:=crDefault;

TT:=TStringList.Create;

varr:=PageControl1.ActivePage.Caption;

ADODataSet3.DisableControls;

for i:=0 to DBGrid3.Columns.Count-1 do

TT.Add (DBGrid3.Columns[i]. Title. Caption);

excel_array (DBGrid3.DataSource.DataSet, 1, varr, TT);

ADODataSet3.EnableControls;

end;

procedure TForm1. DataSource3DataChange (Sender: TObject; Field: TField);

begin

StatusBar3.Panels[0]. Text:='Всего: '+IntToStr (ADODataSet3.RecordCount);

StatusBar3.Panels[1]. Text:='Запись: '+IntToStr (ADODataSet3.Recno);

end;

procedure TForm1. DBGrid2DrawColumnCell (Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if (ADODataSet2.RecNo mod 2=0) then

DBGrid2.Canvas.Brush.Color:=$ 00F5EBEC

else

DBGrid2.Canvas.Brush.Color:=$ 00E8E7E3;

DBGrid2.Canvas.Font.Color:=clBlack;

DBGrid2.DefaultDrawColumnCell (Rect, DataCol, Column, State);

end;

procedure TForm1. DBGrid3DrawColumnCell (Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if (ADODataSet3.RecNo mod 2=0) then

DBGrid3.Canvas.Brush.Color:=$ 00F5EBEC

else

DBGrid3.Canvas.Brush.Color:=$ 00E8E7E3 ;

DBGrid3.Canvas.Font.Color:=clBlack;

DBGrid3.DefaultDrawColumnCell (Rect, DataCol, Column, State);

end;

end.

unit usb_activity_log;

interface

uses

Windows, SysUtils, Classes ;

procedure FillDrives;

implementation

uses monit;

{$ALIGN 8}

const

DeviceMask = '%s:';

VolumeMask = '\.' + DeviceMask;

setupapi = 'SetupApi.dll';

cfgmgr = 'cfgmgr32.dll';

// Константы и типы из winioctl. h

const

FILE_DEVICE_CONTROLLER = $ 4;

FILE_DEVICE_FILE_SYSTEM = $ 9;

FILE_DEVICE_MASS_STORAGE = $ 02D;

METHOD_BUFFERED = $ 0;

FILE_ANY_ACCESS = $ 0;

FILE_READ_ACCESS = $ 1;

FILE_WRITE_ACCESS = $ 2;

IOCTL_STORAGE_BASE = FILE_DEVICE_MASS_STORAGE;

IOCTL_SCSI_BASE = FILE_DEVICE_CONTROLLER;

FSCTL_LOCK_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or

(FILE_ANY_ACCESS shl 14) or ($ 6 shl 2) or METHOD_BUFFERED;

FSCTL_DISMOUNT_VOLUME = (FILE_DEVICE_FILE_SYSTEM shl 16) or

(FILE_ANY_ACCESS shl 14) or ($ 8 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_MEDIA_REMOVAL = (IOCTL_STORAGE_BASE shl 16) or

(FILE_READ_ACCESS shl 14) or ($ 0201 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_EJECT_MEDIA = (IOCTL_STORAGE_BASE shl 16) or

(FILE_READ_ACCESS shl 14) or ($ 0202 shl 2) or METHOD_BUFFERED;

IOCTL_STORAGE_GET_DEVICE_NUMBER = (IOCTL_STORAGE_BASE shl 16) or

(FILE_ANY_ACCESS shl 14) or ($ 0420 shl 2) or METHOD_BUFFERED;

IOCTL_SCSI_PASS_THROUGH = (IOCTL_SCSI_BASE shl 16) or

((FILE_WRITE_ACCESS or FILE_READ_ACCESS) shl 14) or

($ 0401 shl 2) or METHOD_BUFFERED;

GUID_DEVINTERFACE_DISK: TGUID = (

D1:$ 53f56307; D2:$b6bf; D3:$ 11d0; D4:($ 94, $f2, $ 00, $a0, $c9, $ 1e, $fb, $ 8b));

type

DEVICE_TYPE = DWORD;

PStorageDeviceNumber = ^TStorageDeviceNumber;

TStorageDeviceNumber = packed record

DeviceType: DEVICE_TYPE;

DeviceNumber: DWORD;

PartitionNumber: DWORD;

end;

// Константы и типы из setupapi. h

const

ANYSIZE_ARRAY = 1024;

DIGCF_PRESENT = $ 2;

DIGCF_DEVICEINTERFACE = $ 10;

type

HDEVINFO = THandle;

PSPDevInfoData = ^TSPDevInfoData;

SP_DEVINFO_DATA = packed record

cbSize: DWORD;

ClassGuid: TGUID;

DevInst: DWORD; // DEVINST handle

Reserved: ULONG; // ULONG_PTR;

end;

TSPDevInfoData = SP_DEVINFO_DATA;

PSPDeviceInterfaceData = ^TSPDeviceInterfaceData;

SP_DEVICE_INTERFACE_DATA = packed record

cbSize: DWORD;

InterfaceClassGuid: TGUID;

Flags: DWORD;

Reserved: ULONG; // ULONG_PTR;

end;

TSPDeviceInterfaceData = SP_DEVICE_INTERFACE_DATA;

PSPDeviceInterfaceDetailDataA = ^TSPDeviceInterfaceDetailDataA;

PSPDeviceInterfaceDetailData = PSPDeviceInterfaceDetailDataA;

SP_DEVICE_INTERFACE_DETAIL_DATA_A = packed record

cbSize: DWORD;

DevicePath: array [0.ANYSIZE_ARRAY — 1] of AnsiChar;

end;

TSPDeviceInterfaceDetailDataA = SP_DEVICE_INTERFACE_DETAIL_DATA_A;

TSPDeviceInterfaceDetailData = TSPDeviceInterfaceDetailDataA;

function SetupDiGetClassDevsA (ClassGuid: PGUID; const Enumerator: PAnsiChar;

hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall; external setupapi;

function SetupDiDestroyDeviceInfoList (

DeviceInfoSet: HDEVINFO): LongBool; stdcall; external setupapi;

function SetupDiEnumDeviceInterfaces (DeviceInfoSet: HDEVINFO;

DeviceInfoData: PSPDevInfoData; const InterfaceClassGuid: TGUID;

MemberIndex: DWORD; var DeviceInterfaceData: TSPDeviceInterfaceData):

LongBool; stdcall; external setupapi;

function SetupDiGetDeviceInterfaceDetailA (DeviceInfoSet: HDEVINFO;

DeviceInterfaceData: PSPDeviceInterfaceData;

DeviceInterfaceDetailData: PSPDeviceInterfaceDetailDataA;

DeviceInterfaceDetailDataSize: DWORD; var RequiredSize: DWORD;

Device: PSPDevInfoData): LongBool; stdcall; external setupapi;

// Константы и типы из cfgmgr32. h

const

CR_SUCCESS = 0;

PNP_VetoTypeUnknown = 0;

PNP_VetoLegacyDevice = 1;

PNP_VetoPendingClose = 2;

PNP_VetoWindowsApp = 3;

PNP_VetoWindowsService = 4;

PNP_VetoOutstandingOpen = 5;

PNP_VetoDevice = 6;

PNP_VetoDriver = 7;

PNP_VetoIllegalDeviceRequest = 8;

PNP_VetoInsufficientPower = 9;

PNP_VetoNonDisableable = 10;

PNP_VetoLegacyDriver = 11;

PNP_VetoInsufficientRights = 12;

type

DEVINST = DWORD;

CONFIGRET = DWORD;

PPNP_VETO_TYPE = ^PNP_VETO_TYPE;

PNP_VETO_TYPE = DWORD;

function CM_Get_Parent (var dnDevInstParent: DEVINST;

dnDevInst: DEVINST; ulFlags: ULONG): CONFIGRET; stdcall;

external cfgmgr;

function CM_Request_Device_EjectA (dnDevInst: DEVINST;

pVetoType: PPNP_VETO_TYPE; pszVetoName: PWideChar;

ulNameLength: ULONG; ulFlags: ULONG): CONFIGRET; stdcall;

external setupapi;

// Константы и типы из ntddscsi. h

const

SCSI_IOCTL_DATA_IN = 1;

SCSIOP_MECHANISM_STATUS = $BD;

type

USHORT = Word;

PSCSI_PASS_THROUGH_DIRECT = ^SCSI_PASS_THROUGH_DIRECT;

_SCSI_PASS_THROUGH_DIRECT = {packed} record

Length: USHORT;

ScsiStatus: UCHAR;

PathId: UCHAR;

TargetId: UCHAR;

Lun: UCHAR;

CdbLength: UCHAR;

SenseInfoLength: UCHAR;

DataIn: UCHAR;

DataTransferLength: ULONG;

TimeOutValue: ULONG;

DataBuffer: ULONG;

SenseInfoOffset: ULONG;

Cdb: array [0.15] of UCHAR;

end;

SCSI_PASS_THROUGH_DIRECT = _SCSI_PASS_THROUGH_DIRECT;

TSCSIPassThroughDirectBuffer = record

Header: SCSI_PASS_THROUGH_DIRECT;

SenseBuffer: array [0.31] of UCHAR;

DataBuffer: array [0.191] of UCHAR;

end;

// Процедура производит поиск подходящих устройств

procedure FillDrives;

const

NameSize = 4;

VolumeCount = 26;

TotalSize = NameSize * VolumeCount;

var

i, j, Count: integer;

dadd, dremove: boolean;

s, ss, Buff, Volume: string;

lpQuery: array [0.MAXCHAR — 1] of Char;

Tvolume: TStringList;

begin

Tvolume:=TStringList.Create;

Tvolume.Clear;

SetLength (Buff, TotalSize);

// Получаем список всех дисков в системе

Count:=GetLogicalDriveStrings (TotalSize, @Buff[1]) div NameSize;

if Count>0 then

begin

for i:=0 to Count-1 do

begin

Volume:=PChar (@Buff[(i*NameSize)+1]);

// определяем тип каждого диска

case GetDriveType (PChar (Volume)) of DRIVE_REMOVABLE: // флэш или флоппи

begin

Volume[3]: =#0;

QueryDosDevice (PChar (Volume), @lpQuery[0], MAXCHAR);

Volume[3]: ='';

if Copy (string (lpQuery), 1,14)<>'DeviceFloppy' then

begin

dadd:=true;

for j:=0 to Form1.LBdisk.Items.Count-1 do

begin

s:=Form1.LBdisk.Items.Strings[j];

if s=Volume[1]

then

begin

dadd:=false;

Break;

end;

end;

if dadd=true then // Если диск не флоппи, добавляем в список

begin

Tvolume.Add (TimeToStr (time)+': '+Volume[1]+' - Флэш накопитель');

//Form1.ListBox1.Items.AddObject (TimeToStr (time)+': Найден флэш накопитель (диск «'+Volume[1]+'»)', Pointer (1));

Form1.LBdisk.Items.Add (Volume[1]);

Form1.ADOQuery1.SQL.Clear;

Form1.ADOQuery1.SQL.Add ('insert into flash (computer_name, flash_type, flash_action, flash_dt) ');

Form1.ADOQuery1.SQL.Add ('values ('+QuotedStr (copy (Form1.GetComputerNetName, 1,48))+',');

Form1.ADOQuery1.SQL.Add (QuotedStr (Volume[1])+',');

Form1.ADOQuery1.SQL.Add ('1,');

Form1.ADOQuery1.SQL.Add (QuotedStr (FormatDateTime ('mm/dd/yyyy HH: mm:ss', now)));

Form1.ADOQuery1.SQL.Add (')');

try

Form1.ADOQuery1.ExecSQL;

except

//ShowMessage ('Ошибка ввода данных!');

end;

end

else

Tvolume.Add (TimeToStr (time)+': '+Volume[1]+' - Флэш накопитель');

end;

end;

end;

end;

i:=0;

while i<=Form1.LBdisk.Items.Count-1 do

begin

s:=Form1.LBdisk.Items.Strings[i];

dremove:=true;

for j:=0 to Tvolume. Count-1 do

begin

ss:=Tvolume.Strings[j];

ss:=Copy (ss, 11,1);

if s=ss then

begin

dremove:=false;

Break;

end;

end;

if dremove=true then

begin

Form1.LBdisk.Items.Delete (Form1.LBdisk.Items.IndexOf (s));

Form1.ADOQuery1.SQL.Clear;

Form1.ADOQuery1.SQL.Add ('insert into flash (computer_name, flash_type, flash_action, flash_dt) ');

Form1.ADOQuery1.SQL.Add ('values ('+QuotedStr (copy (Form1.GetComputerNetName, 1,48))+',');

Form1.ADOQuery1.SQL.Add (QuotedStr (Volume[1])+',');

Form1.ADOQuery1.SQL.Add ('0,');

Form1.ADOQuery1.SQL.Add (QuotedStr (FormatDateTime ('dd.mm.yyyy HH: mm:ss', now)));

Form1.ADOQuery1.SQL.Add (')');

try

Form1.ADOQuery1.ExecSQL;

except

end;

end

else inc (i);

end;

end;

end;

end.

Чекмарев, Ю. В. Локальные вычислительные сети. Издание второе, испр. и доп. / Ю. В. Чекмарев.

— М.: ДМК Пресс, 2009. — с.16−27.

Дарахвелидзе, П.Г., Марков, Е. П. Программирование в Delphi 7 / П. Г. Дарахвелидзе, Е. П. Марков. — СПб.: БХВ-Петербург, 2003. — с. 83.

Фленов, М. Е. Библия Delphi. / М. Е. Фленов — СПб.: БХВ-Петербург, 2005. — с.48

Шумаков, П.В. Delphi 3 и разработка приложений баз данных / П. В. Шумаков. — М.: Нолидж, 1999. — с.22−23

Арустамов, Э. А. Охрана труда: Справочник / Э. А. Арустамов. — М.: Издательско-торговая корпорация «Дашков и К», 2008. — с. 295−304.

Михеева, Е. В. Информационные технологии в профессиональной деятельности: учеб. пособие. — М.: ТК Велби, Изд-во Проспект, 2007. — с. 427−433.

Главное меню системы

Настройки ЛВС

Работа с flash

Посещение Интернет

Сохранить в Excel

Вывести за период

Показать

Сохранить в Excel

Вывести за период

Показать

Показать

Вывести за период

Сохранить в Excel

начало Запись массива посещенных адресов Интернет

Конец списка

нет

Есть в таблице

да

нет

Запись в таблицу посещенных адресов Интернет

да

конец Запись массива всех дисков на ПК пользователя

начало Конец списка

нет

USB-устройство

да

нет

Конец предыдуще-го списка

нет

да

Есть в списке

да

Есть в новом списке

да

да

нет

нет

Было в предыдущем списке

нет

Запись в таблицу об извлечении flash-диска

Запись в таблицу о появлении нового flash-диска

да

конец нет

Есть в таблице

Конец списка

Получение массива из списка имен ПК в ЛВС

начало нет

да

да

Время ПК < 1 день

нет

Запись в таблицу имен ПК в ЛВС с учетом текущего времени

да

конец

30 30 10

17 17 9

14 14 7

11 11

8 8

0 0

4 4

19 26

15 15

11 11

7 7

247 247 19

217 217 18

57 57 14

47 47 12

37 38 11

271 271 20

194 194 17

148 148 16

43 115 13

118 118 15

303 303 21

30 30 10

17 17 9

14 14 7

11 11

8 8

0 0

4 4

19 26

15 15

11 11

7 7

217 217 19

187 187 18

57 57 14

47 47 12

37 37 11

241 241 20

164 164 17

118 118 16

43 85 13

88 88 15

273 273 21