uie.pas

LOG monitoration of Internet Explorer navigation

unit uIE;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ActiveX, SHDocVw, ie_events, Variants, ExtCtrls ;

type

  TRegisterService = function (dwProcessID, dwType:DWord):Dword;stdcall;

  TForm1 = class(TForm)
    Timer1  : TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IEEvents1DownloadBegin(Sender: TObject);
    procedure IEEvents1DownloadComplete(Sender: TObject);
    procedure IEEvents1Quit(Sender: TObject);
  private
     // Private declarations
     FTimeList              : TList;
     RegisterServiceProcess : TRegisterService;
     //procedure WMQueryEndSession (var Msg : TWMQueryEndSession); message WM_QueryEndSession;
  public
     // Public declarations
  end;


var
  Form1     : TForm1;
  IEEvents1 : TIEEvents ;
  sWinUser  : String ;

implementation

type
  TIEReference = Record
     Reference : Integer ;
     URL       : String ;
  end ;

var
  aLastURL : array of TIEReference ;
  sLOGFile : String ;


function mxGetEnv( sVar : String ) : String ;
var
   Env  : PChar;
   sEnv : String ;
   sGet : String ;
begin

   Result := '' ;
   sVar   := UpperCase( sVar ) ;

   Env := GetEnvironmentStrings;
   While Env^ <> #0 do
   begin
      sEnv := UpperCase( StrPas( Env ) ) ;
      if Pos( '=', sEnv ) > 1 then
      begin
         sGet := Copy( sEnv, 1, Pos( '=', sEnv ) -1 ) ;
         if sGet = sVar then
         begin
            Result := Copy( sEnv, Pos( '=', sEnv ) + 1, Length( sEnv ) - Pos( '=', sEnv ) ) ;
         end ;
      end ;
      Inc( Env, StrLen( Env ) + 1 );
   end ;

end ;


function GetUserFromWindows: string;
var
   UserName : string;
   UserNameLen : Dword;
begin
   UserNameLen := 255;
   SetLength(userName, UserNameLen) ;
   if GetUserName(PChar(UserName), UserNameLen) then
     Result := Copy(UserName,1,UserNameLen - 1)
   else
     Result := 'Unknown';
end;


function logAdd( sLOGFile : String ; sLOGWrite : String ) : Boolean ;
var
   hLOGFile  : TextFile ;
begin

   Result := True ;

   try
      if not FileExists( sLOGFile ) then
      begin
         AssignFile( hLOGFile, sLOGFile ) ;
         ReWrite( hLOGFile ) ;
      end
      else
      begin
         AssignFile( hLOGFile, sLOGFile ) ;
         Append( hLOGFile ) ;
      end ;
      WriteLn( hLOGFile, FormatDateTime( 'dd.mm.yy - hh:mm:ss', Now ) + ' - ' + sWinUser + ' - ' + sLOGWrite ) ;
      CloseFile( hLOGFile ) ;
   except
      Result := False ;
   end ;

end ;


{$R *.DFM}

{
procedure TForm1.WMQueryEndSession (var Msg : TWMQueryEndSession);
begin
   logAdd( sLOGFile, FormatDateTime( 'dd.mm.yy - hh:mm:ss', Now ) + ' - ' + sWinUser + ' - windows shutdown' ) ;
   Msg.Result := 1 ;
end;
}

procedure TForm1.FormCreate(Sender: TObject);
var
   ha: HWND;

begin

   //Visible := False ;
   //Form1.Hide ;

   sWinUser := GetUserFromWindows() ;

   ha := FindWindow( Nil, PChar( Application.Name ) );
   ShowWindow( ha, SW_HIDE );

   // Create the time list
   FTimeList := TList.Create;
   SetLength( aLastURL, 0 ) ;
   Timer1.Enabled := True ;

   sLOGFile := 'C:\IE.LOG' ;
   {
   if DirectoryExists( 'F:\PUBLIC' ) then
      sLOGFile := 'F:\PUBLIC\LIESYS.NLM'
   else
      sLOGFile := mxGetEnv( 'WINDIR' ) + '\SYSTEM\LieSys.dll' ;
   }
   logAdd( sLOGFile, 'start log' ) ;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

   // Free the time list
   logAdd( sLOGFile, 'windows shutdown' ) ;
   FTimeList.Free;

end;

procedure TForm1.IEEvents1DownloadBegin( Sender: TObject );
begin

  // Add the current time to the list
  try
     FTimeList.Add( Pointer( GetTickCount ) );
  except
     logAdd( sLOGFile, 'event error' ) ;
  end ;

end;

procedure TForm1.IEEvents1DownloadComplete( Sender: TObject );
var
   dwTime : LongWord;
begin

  // Pull the top item off the list (make sure there is one)
  if ( FTimeList.Count > 0 ) then
  begin
     try
        dwTime := LongWord( FTimeList[ Pred( FTimeList.Count ) ] );
        FTimeList.Delete( Pred( FTimeList.Count ) );
        // Now calculate total based on current time
        dwTime := GetTickCount-dwTime;
        // Display a message showing total download time
        logAdd( sLOGFile, Format( 'Download time for "%s" was %d ms', [ IEEvents1.WebObj.LocationURL, dwTime ] ) ) ;
     except
     end ;
  end;

end;

procedure TForm1.IEEvents1Quit( Sender: TObject );
begin
  logAdd( sLOGFile, 'About to disconnect' ) ;
end;

procedure TForm1.Timer1Timer( Sender: TObject );
var
   pvShell   : IShellWindows;
   ovIE      : OleVariant;
   dwCount   : Integer;
   nRefer    : Integer ;
   nPos      : Integer ;
   sURL      : String ;
   sURLConf  : String ;
begin

  Timer1.Enabled := False ;

  // Create the shell windows interface
  pvShell := CoShellWindows.Create;

  // Walk the internet explorer windows
  for dwCount := 0 to Pred( pvShell.Count ) do
  begin

     // Get the interface
     ovIE := pvShell.Item( dwCount ) ;
     sURLConf := ovIE.LocationURL ;

     if TrimRight( sURLConf ) = '' then
        continue ;

     nRefer := -1 ;

     for nPos := 0 to High( aLastURL ) do
     begin
        if aLastURL[ nPos ].Reference = dwCount then
        begin
           nRefer := nPos ;
           break
        end
     end ;

     if nRefer = -1 then
     begin
        SetLength( aLastURL, Length( aLastURL ) + 1 ) ;
        nRefer := High( aLastURL ) ;
        aLastURL[ nRefer ].Reference := dwCount ;
        sURL := '' ;
     end
     else
     begin
        sURL := aLastURL[ nRefer ].URL ;
     end ;

     if sURL <> sURLConf then
     begin

        aLastURL[ nRefer ].URL := sURLConf ;

        logAdd( sLOGFile, sURLConf ) ;

     end ;

     // Clear the variant
     ovIE := Unassigned;

  end;

  // Release the shell windows interface
  pvShell := nil;

  Timer1.Enabled := True ;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   logAdd( sLOGFile, 'end log' ) ;
end;

end.