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

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:=16384;
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 = $00000004;
FILE_DEVICE_FILE_SYSTEM = $00000009;
FILE_DEVICE_MASS_STORAGE = $0000002D;

METHOD_BUFFERED = $00000000;
FILE_ANY_ACCESS = $00000000;
FILE_READ_ACCESS = $00000001;
FILE_WRITE_ACCESS = $00000002;

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 = $00000002;
DIGCF_DEVICEINTERFACE = $00000010;

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)<>'\Device\Floppy' 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..









28


1



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

Настройки


ЛВС

Работа с flash


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

Сохранить в Excel

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

Показать

Сохранить в Excel

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

Показать

Показать

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

Сохранить в Excel

начало


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

Конец списка

нет

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

да

нет

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

да

конец


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

начало


Конец списка

нет

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

да

нет

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

нет

да

Есть в списке

да

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

да

да

нет

нет

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

нет

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

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

да

конец


нет

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

Конец списка

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

начало


нет

да

да

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

нет

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

да

конец


0
30 30 10


0
17 17 9


0
14 14 7
7

0
11 11
5

0
8 8
2

0
0 0
0


0
4 4
1


7
19 26
8

0
15 15
6

0
11 11
4

0
7 7
3

0
247 247 19


0
217 217 18


0
57 57 14


0
47 47 12


0
37 38 11


0
271 271 20


0
194 194 17


0
148 148 16


72
43 115 13


0
118 118 15


0
303 303 21


0
30 30 10


0
17 17 9


0
14 14 7
7

0
11 11
5

0
8 8
2

0
0 0
0


0
4 4
1


7
19 26
8

0
15 15
6

0
11 11
4

0
7 7
3

0
217 217 19


0
187 187 18


0
57 57 14


0
47 47 12


0
37 37 11


0
241 241 20


0
164 164 17


0
118 118 16


32
43 85 13


0
88 88 15


0
273 273 21