Прерывать сообщения Internet Explorer

{ 
This component allows you to intercept Internet Explorer messages such as 
"StatusTextChangeEvent", "DocumentCompleteEvent" and so on. 

Mit folgende Komponente lassen sich Nachrichten wie 
"StatusTextChangeEvent", "DocumentCompleteEvent" usw. von 
Internet Explorer Fenstern abfangen. 
}

 //---- Component Source: Install this component first. 

unit
 IEEvents;

 interface


 uses

   Windows, SysUtils, Classes, Graphics, ComObj, ActiveX, SHDocVW;

 type

   // Event types exposed from the Internet Explorer interface 
  TIEStatusTextChangeEvent = procedure
(Sender: TObject; const
 Text: WideString) of
 object
;
   TIEProgressChangeEvent = procedure
(Sender: TObject; Progress: Integer; ProgressMax: Integer) of
 object
;
   TIECommandStateChangeEvent = procedure
(Sender: TObject; Command: Integer; Enable: WordBool) of
 object
;
   TIEDownloadBeginEvent = procedure
(Sender: TObject) of
 object
;
   TIEDownloadCompleteEvent = procedure
(Sender: TObject) of
 object
;
   TIETitleChangeEvent = procedure
(Sender: TObject; const
 Text: WideString) of
 object
;
   TIEPropertyChangeEvent = procedure
(Sender: TObject; const
 szProperty: WideString) of
 object
;
   TIEBeforeNavigate2Event = procedure
(Sender: TObject; const
 pDisp: IDispatch;
     var
 URL: OleVariant; var
 Flags: OleVariant; var
 TargetFrameName: OleVariant;
     var
 PostData: OleVariant; var
 Headers: OleVariant; var
 Cancel: WordBool) of
 object
;
   TIENewWindow2Event = procedure
(Sender: TObject; var
 ppDisp: IDispatch; var
 Cancel: WordBool) of
 object
;
   TIENavigateComplete2Event = procedure
(Sender: TObject; const
 pDisp: IDispatch; var
 URL: OleVariant) of
 object
;
   TIEDocumentCompleteEvent = procedure
(Sender: TObject; const
 pDisp: IDispatch; var
 URL: OleVariant) of
 object
;
   TIEOnQuitEvent = procedure
(Sender: TObject) of
 object
;
   TIEOnVisibleEvent = procedure
(Sender: TObject; Visible: WordBool) of
 object
;
   TIEOnToolBarEvent = procedure
(Sender: TObject; ToolBar: WordBool) of
 object
;
   TIEOnMenuBarEvent = procedure
(Sender: TObject; MenuBar: WordBool) of
 object
;
   TIEOnStatusBarEvent = procedure
(Sender: TObject; StatusBar: WordBool) of
 object
;
   TIEOnFullScreenEvent = procedure
(Sender: TObject; FullScreen: WordBool) of
 object
;
   TIEOnTheaterModeEvent = procedure
(Sender: TObject; TheaterMode: WordBool) of
 object
;

   // Event component for Internet Explorer 
  TIEEvents = class
(TComponent, IUnknown, IDispatch)
   private

      // Private declarations 
    FConnected: Boolean;
     FCookie: Integer;
     FCP: IConnectionPoint;
     FSinkIID: TGuid;
     FSource: IWebBrowser2;
     FStatusTextChange: TIEStatusTextChangeEvent;
     FProgressChange: TIEProgressChangeEvent;
     FCommandStateChange: TIECommandStateChangeEvent;
     FDownloadBegin: TIEDownloadBeginEvent;
     FDownloadComplete: TIEDownloadCompleteEvent;
     FTitleChange: TIETitleChangeEvent;
     FPropertyChange: TIEPropertyChangeEvent;
     FBeforeNavigate2: TIEBeforeNavigate2Event;
     FNewWindow2: TIENewWindow2Event;
     FNavigateComplete2: TIENavigateComplete2Event;
     FDocumentComplete: TIEDocumentCompleteEvent;
     FOnQuit: TIEOnQuitEvent;
     FOnVisible: TIEOnVisibleEvent;
     FOnToolBar: TIEOnToolBarEvent;
     FOnMenuBar: TIEOnMenuBarEvent;
     FOnStatusBar: TIEOnStatusBarEvent;
     FOnFullScreen: TIEOnFullScreenEvent;
     FOnTheaterMode: TIEOnTheaterModeEvent;
   protected

      // Protected declaratios for IUnknown 
    function
 QueryInterface(const
 IID: TGUID; out Obj): HResult; override
;
     function
 _AddRef: Integer; stdcall
;
     function
 _Release: Integer; stdcall
;
      // Protected declaratios for IDispatch 
    function
 GetIDsOfNames(const
 IID: TGUID; Names: Pointer; NameCount, LocaleID:
       Integer; DispIDs: Pointer): HResult; virtual
; stdcall
;
     function
 GetTypeInfo(Index
, LocaleID: Integer; out TypeInfo): HResult; virtual
; stdcall
;
     function
 GetTypeInfoCount(out Count: Integer): HResult; virtual
; stdcall
;
     function
 Invoke(DispID
: Integer; const
 IID: TGUID; LocaleID: Integer;
       Flags: Word; var
 Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; virtual
; stdcall
;
      // Protected declarations 
    procedure
 DoStatusTextChange(const
 Text: WideString); safecall;
     procedure
 DoProgressChange(Progress: Integer; ProgressMax: Integer); safecall;
     procedure
 DoCommandStateChange(Command: Integer; Enable: WordBool); safecall;
     procedure
 DoDownloadBegin; safecall;
     procedure
 DoDownloadComplete; safecall;
     procedure
 DoTitleChange(const
 Text: WideString); safecall;
     procedure
 DoPropertyChange(const
 szProperty: WideString); safecall;
     procedure
 DoBeforeNavigate2(const
 pDisp: IDispatch; var
 URL: OleVariant;
       var
 Flags: OleVariant; var
 TargetFrameName: OleVariant; var
 PostData: OleVariant;
       var
 Headers: OleVariant; var
 Cancel: WordBool); safecall;
     procedure
 DoNewWindow2(var
 ppDisp: IDispatch; var
 Cancel: WordBool); safecall;
     procedure
 DoNavigateComplete2(const
 pDisp: IDispatch; var
 URL: OleVariant); safecall;
     procedure
 DoDocumentComplete(const
 pDisp: IDispatch; var
 URL: OleVariant); safecall;
     procedure
 DoOnQuit; safecall;
     procedure
 DoOnVisible(Visible: WordBool); safecall;
     procedure
 DoOnToolBar(ToolBar: WordBool); safecall;
     procedure
 DoOnMenuBar(MenuBar: WordBool); safecall;
     procedure
 DoOnStatusBar(StatusBar: WordBool); safecall;
     procedure
 DoOnFullScreen(FullScreen: WordBool); safecall;
     procedure
 DoOnTheaterMode(TheaterMode: WordBool); safecall;
   public

      // Public declarations 
    constructor
 Create(AOwner: TComponent); override
;
     destructor
 Destroy; override
;
     procedure
 ConnectTo(Source: IWebBrowser2);
     procedure
 Disconnect;
     property
 SinkIID: TGuid read
 FSinkIID;
     property
 Source: IWebBrowser2 read
 FSource;
   published

      // Published declarations 
    property
 WebObj: IWebBrowser2 read
 FSource;
     property
 Connected: Boolean read
 FConnected;
     property
 StatusTextChange: TIEStatusTextChangeEvent read
 FStatusTextChange write
 FStatusTextChange;
     property
 ProgressChange: TIEProgressChangeEvent read
 FProgressChange write
 FProgressChange;
     property
 CommandStateChange: TIECommandStateChangeEvent read
 FCommandStateChange write
 FCommandStateChange;
     property
 DownloadBegin: TIEDownloadBeginEvent read
 FDownloadBegin write
 FDownloadBegin;
     property
 DownloadComplete: TIEDownloadCompleteEvent read
 FDownloadComplete write
 FDownloadComplete;
     property
 TitleChange: TIETitleChangeEvent read
 FTitleChange write
 FTitleChange;
     property
 PropertyChange: TIEPropertyChangeEvent read
 FPropertyChange write
 FPropertyChange;
     property
 BeforeNavigate2: TIEBeforeNavigate2Event read
 FBeforeNavigate2 write
 FBeforeNavigate2;
     property
 NewWindow2: TIENewWindow2Event read
 FNewWindow2 write
 FNewWindow2;
     property
 NavigateComplete2: TIENavigateComplete2Event read
 FNavigateComplete2 write
 FNavigateComplete2;
     property
 DocumentComplete: TIEDocumentCompleteEvent read
 FDocumentComplete write
 FDocumentComplete;
     property
 OnQuit: TIEOnQuitEvent read
 FOnQuit write
 FOnQuit;
     property
 OnVisible: TIEOnVisibleEvent read
 FOnVisible write
 FOnVisible;
     property
 OnToolBar: TIEOnToolBarEvent read
 FOnToolBar write
 FOnToolBar;
     property
 OnMenuBar: TIEOnMenuBarEvent read
 FOnMenuBar write
 FOnMenuBar;
     property
 OnStatusBar: TIEOnStatusBarEvent read
 FOnStatusBar write
 FOnStatusBar;
     property
 OnFullScreen: TIEOnFullScreenEvent read
 FOnFullScreen write
 FOnFullScreen;
     property
 OnTheaterMode: TIEOnTheaterModeEvent read
 FOnTheaterMode write
 FOnTheaterMode;
   end
;

 // Register procedure 
procedure
 Register
;

 implementation


 function
 TIEEvents._AddRef: Integer;
 begin


   // No more than 2 counts 
  result := 2;

 end
;

 function
 TIEEvents._Release: Integer;
 begin

   // Always maintain 1 ref count (component holds the ref count) 
  result := 1;
 end
;

 function
 TIEEvents.QueryInterface(const
 IID: TGUID; out Obj): HResult;
 begin

   // Clear interface pointer 
  Pointer(Obj) := nil
;

   // Attempt to get the requested interface 
  if
 (GetInterface(IID, Obj)) then

      // Success 
    result := S_OK
   // Check to see if the guid requested is for the event 
  else
 if
 (IsEqualIID(IID, FSinkIID)) then

   begin

      // Event is dispatch based, so get dispatch interface (closest we can come) 
    if
 (GetInterface(IDispatch, Obj)) then

         // Success 
      result := S_OK
     else

         // Failure 
      result := E_NOINTERFACE;
   end

   else

      // Failure 
    result := E_NOINTERFACE;
 end
;

 function
 TIEEvents.GetIDsOfNames(const
 IID: TGUID; Names: Pointer; NameCount,
   LocaleID: Integer; DispIDs: Pointer): HResult;
 begin

   // Not implemented 
  result := E_NOTIMPL;
 end
;

 function
 TIEEvents.GetTypeInfo(Index
, LocaleID: Integer; out TypeInfo): HResult;
 begin

   // Clear the result interface 
  Pointer(TypeInfo) := nil
;
   // No type info for our interface 
  result := E_NOTIMPL;
 end
;

 function
 TIEEvents.GetTypeInfoCount(out Count: Integer): HResult;
 begin

   // Zero type info counts 
  Count := 0;
   // Return success 
  result := S_OK;
 end
;

 function
 TIEEvents.Invoke(DispID
: Integer; const
 IID: TGUID; LocaleID: Integer; Flags: Word;
   var
 Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
 var
 pdpParams: PDispParams;
   lpDispIDs: array
[0..63] of
 TDispID;
   dwCount: Integer;
 begin


   // Get the parameters 
  pdpParams := @Params;

   // Events can only be called with method dispatch, not property get/set 
  if
 ((Flags and
 DISPATCH_METHOD) > 0) then

   begin

      // Clear DispID list 
    ZeroMemory(@lpDispIDs, SizeOf(lpDispIDs));
      // Build dispatch ID list to handle named args 
    if
 (pdpParams^.cArgs > 0) then

     begin

         // Reverse the order of the params because they are backwards 
      for
 dwCount := 0 to
 Pred(pdpParams^.cArgs) do
 lpDispIDs[dwCount] := Pred(pdpParams^.cArgs) - dwCount;
         // Handle named arguments 
      if
 (pdpParams^.cNamedArgs > 0) then

       begin

         for
 dwCount := 0 to
 Pred(pdpParams^.cNamedArgs) do

           lpDispIDs[pdpParams^.rgdispidNamedArgs^[dwCount]] := dwCount;
       end
;
     end
;
      // Unless the event falls into the "else" clause of the case statement the result is S_OK 
    result := S_OK;
      // Handle the event 
    case
 DispID
 of

       102: DoStatusTextChange(pdpParams^.rgvarg^[lpDispIds[0]].bstrval);
       104: DoDownloadComplete;
       105: DoCommandStateChange(pdpParams^.rgvarg^[lpDispIds[0]].lval,
           pdpParams^.rgvarg^[lpDispIds[1]].vbool);
       106: DoDownloadBegin;
       108: DoProgressChange(pdpParams^.rgvarg^[lpDispIds[0]].lval,
           pdpParams^.rgvarg^[lpDispIds[1]].lval);
       112: DoPropertyChange(pdpParams^.rgvarg^[lpDispIds[0]].bstrval);
       113: DoTitleChange(pdpParams^.rgvarg^[lpDispIds[0]].bstrval);
       250: DoBeforeNavigate2(IDispatch(pdpParams^.rgvarg^[lpDispIds[0]].dispval),
           POleVariant(pdpParams^.rgvarg^[lpDispIds[1]].pvarval)^,
           POleVariant(pdpParams^.rgvarg^[lpDispIds[2]].pvarval)^,
           POleVariant(pdpParams^.rgvarg^[lpDispIds[3]].pvarval)^,
           POleVariant(pdpParams^.rgvarg^[lpDispIds[4]].pvarval)^,
           POleVariant(pdpParams^.rgvarg^[lpDispIds[5]].pvarval)^,
           pdpParams^.rgvarg^[lpDispIds[6]].pbool^);
       251: DoNewWindow2(IDispatch(pdpParams^.rgvarg^[lpDispIds[0]].pdispval^),
           pdpParams^.rgvarg^[lpDispIds[1]].pbool^);
       252: DoNavigateComplete2(IDispatch(pdpParams^.rgvarg^[lpDispIds[0]].dispval),
           POleVariant(pdpParams^.rgvarg^[lpDispIds[1]].pvarval)^);
       253:
         begin

            // Special case handler. When Quit is called, IE is going away so we might 
           // as well unbind from the interface by calling disconnect. 
          DoOnQuit;
            //  Call disconnect 
          Disconnect;
         end
;
       254: DoOnVisible(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
       255: DoOnToolBar(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
       256: DoOnMenuBar(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
       257: DoOnStatusBar(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
       258: DoOnFullScreen(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
       259: DoDocumentComplete(IDispatch(pdpParams^.rgvarg^[lpDispIds[0]].dispval),
           POleVariant(pdpParams^.rgvarg^[lpDispIds[1]].pvarval)^);
       260: DoOnTheaterMode(pdpParams^.rgvarg^[lpDispIds[0]].vbool);
     else

         // Have to idea of what event they are calling 
      result := DISP_E_MEMBERNOTFOUND;
     end
;
   end

   else

      // Called with wrong flags 
    result := DISP_E_MEMBERNOTFOUND;
 end
;

 constructor
 TIEEvents.Create(AOwner: TComponent);
 begin

   // Perform inherited 
  inherited
 Create(AOwner);

   // Set the event sink IID 
  FSinkIID := DWebBrowserEvents2;
 end
;

 destructor
 TIEEvents.Destroy;
 begin

   // Disconnect 
  Disconnect;
   // Perform inherited 
  inherited
 Destroy;
 end
;

 procedure
 TIEEvents.ConnectTo(Source: IWebBrowser2);
 var
 pvCPC: IConnectionPointContainer;
 begin

   // Disconnect from any currently connected event sink 
  Disconnect;
   // Query for the connection point container and desired connection point. 
  // On success, sink the connection point 
  OleCheck(Source.QueryInterface(IConnectionPointContainer, pvCPC));
   OleCheck(pvCPC.FindConnectionPoint(FSinkIID, FCP));
   OleCheck(FCP.Advise(Self, FCookie));
   // Update internal state variables 
  FSource := Source;
   // We are in a connected state 
  FConnected := True;
   // Release the temp interface 
  pvCPC := nil
;
 end
;

 procedure
 TIEEvents.Disconnect;
 begin

   // Do we have the IWebBrowser2 interface? 
  if
 Assigned(FSource) then

   begin

     try

         // Unadvise the connection point 
      OleCheck(FCP.Unadvise(FCookie));
         // Release the interfaces 
      FCP := nil
;
       FSource := nil
;
     except

       Pointer(FCP) := nil
;
       Pointer(FSource) := nil
;
     end
;
   end
;

   // Disconnected state 
  FConnected := False;
 end
;

 procedure
 TIEEvents.DoStatusTextChange(const
 Text: WideString);
 begin

   // Call assigned event 
  if
 Assigned(FStatusTextChange) then
 FStatusTextChange(Self, Text);
 end
;

 procedure
 TIEEvents.DoProgressChange(Progress: Integer; ProgressMax: Integer);
 begin

   // Call assigned event 
  if
 Assigned(FProgressChange) then
 FProgressChange(Self, Progress, ProgressMax);
 end
;

 procedure
 TIEEvents.DoCommandStateChange(Command: Integer; Enable: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FCommandStateChange) then
 FCommandStateChange(Self, Command, Enable);
 end
;

 procedure
 TIEEvents.DoDownloadBegin;
 begin

   // Call assigned event 
  if
 Assigned(FDownloadBegin) then
 FDownloadBegin(Self);
 end
;

 procedure
 TIEEvents.DoDownloadComplete;
 begin

   // Call assigned event 
  if
 Assigned(FDownloadComplete) then
 FDownloadComplete(Self);
 end
;

 procedure
 TIEEvents.DoTitleChange(const
 Text: WideString);
 begin

   // Call assigned event 
  if
 Assigned(FTitleChange) then
 FTitleChange(Self, Text);
 end
;

 procedure
 TIEEvents.DoPropertyChange(const
 szProperty: WideString);
 begin

   // Call assigned event 
  if
 Assigned(FPropertyChange) then
 FPropertyChange(Self, szProperty);
 end
;

 procedure
 TIEEvents.DoBeforeNavigate2(const
 pDisp: IDispatch; var
 URL: OleVariant; var
 Flags:
   OleVariant; var
 TargetFrameName: OleVariant; var
 PostData: OleVariant; var
 Headers: OleVariant; var
 Cancel: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FBeforeNavigate2) then
 FBeforeNavigate2(Self, pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel);
 end
;

 procedure
 TIEEvents.DoNewWindow2(var
 ppDisp: IDispatch; var
 Cancel: WordBool);
 var

   pvDisp: IDispatch;
 begin

   // Call assigned event 
  if
 Assigned(FNewWindow2) then

   begin

     if
 Assigned(ppDisp) then

       pvDisp := ppDisp
     else

       pvDisp := nil
;
     FNewWindow2(Self, pvDisp, Cancel);
     ppDisp := pvDisp;
   end
;
 end
;

 procedure
 TIEEvents.DoNavigateComplete2(const
 pDisp: IDispatch; var
 URL: OleVariant);
 begin

   // Call assigned event 
  if
 Assigned(FNavigateComplete2) then
 FNavigateComplete2(Self, pDisp, URL);
 end
;

 procedure
 TIEEvents.DoDocumentComplete(const
 pDisp: IDispatch; var
 URL: OleVariant);
 begin

   // Call assigned event 
  if
 Assigned(FDocumentComplete) then
 FDocumentComplete(Self, pDisp, URL);
 end
;

 procedure
 TIEEvents.DoOnQuit;
 begin

   // Call assigned event 
  if
 Assigned(FOnQuit) then
 FOnQuit(Self);
 end
;

 procedure
 TIEEvents.DoOnVisible(Visible: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnVisible) then
 FOnVisible(Self, Visible);
 end
;

 procedure
 TIEEvents.DoOnToolBar(ToolBar: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnToolBar) then
 FOnToolBar(Self, ToolBar);
 end
;

 procedure
 TIEEvents.DoOnMenuBar(MenuBar: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnMenuBar) then
 FOnMenuBar(Self, MenuBar);
 end
;

 procedure
 TIEEvents.DoOnStatusBar(StatusBar: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnStatusBar) then
 FOnStatusBar(Self, StatusBar);
 end
;

 procedure
 TIEEvents.DoOnFullScreen(FullScreen: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnFullScreen) then
 FOnFullScreen(Self, FullScreen);
 end
;

 procedure
 TIEEvents.DoOnTheaterMode(TheaterMode: WordBool);
 begin

   // Call assigned event 
  if
 Assigned(FOnTheaterMode) then
 FOnTheaterMode(Self, TheaterMode);
 end
;

 procedure
 Register
;
 begin

   // Register the component on the Internet tab of the IDE 
  RegisterComponents('Internet', [TIEEvents]);
 end
;

 end
.


 --- Project source ----
 //Notes: Add a button and the IEEvents component to Form1. The button1 click event 
// shows  how the IE enumeration is achieved, and shows how the binding is done: 

unit
 Unit1;

 interface


 uses

   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, IEEvents, StdCtrls, ActiveX, SHDocVw;

 type

   TForm1 = class
(TForm)
     IEEvents1: TIEEvents;
     Button1: TButton;
     procedure
 FormCreate(Sender: TObject);
     procedure
 FormDestroy(Sender: TObject);
     procedure
 IEEvents1Quit(Sender: TObject);
     procedure
 IEEvents1DownloadBegin(Sender: TObject);
     procedure
 IEEvents1DownloadComplete(Sender: TObject);
     procedure
 Button1Click(Sender: TObject);
     procedure
 IEEvents1ProgressChange(Sender: TObject; Progress,
       ProgressMax: Integer);
   private

     { Private declarations }
     FTimeList: TList;
   public

     { Public declarations }
   end
;

 var

   Form1: TForm1;

 implementation


 {$R *.dfm}

 procedure
 TForm1.Button1Click(Sender: TObject);
 var

   pvShell: IShellWindows;
   pvWeb2: IWebBrowser2;
   ovIE: OleVariant;
   dwCount: Integer;
 begin

   // 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);
      // At this point you can evaluate the interface (LocationUrl, etc) 
     // to decide if this is the one you want to connect to. For demo purposes, 
     // the code will bind to the first one 
    ShowMessage(ovIE.LocationURL);
      // QI for the IWebBrowser2 
    if
 (IDispatch(ovIE).QueryInterface(IWebBrowser2, pvWeb2) = S_OK) then

     begin

       IEEvents1.ConnectTo(pvWeb2);
         // Release the interface 
      pvWeb2 := nil
;
     end
;
      // Clear the variant 
    ovIE := Unassigned;
      // Break if we connected 
    if
 IEEvents1.Connected then
 break;
   end
;
   // Release the shell windows interface 
  pvShell := nil
;
 end
;

 procedure
 TForm1.FormCreate(Sender: TObject);
 begin

   // Create the time list 
  FTimeList := TList.Create;
 end
;

 procedure
 TForm1.FormDestroy(Sender: TObject);
 begin

   // Free the time list 
  FTimeList.Free;
 end
;

 procedure
 TForm1.IEEvents1DownloadBegin(Sender: TObject);
 begin

   // Add the current time to the list 
  FTimeList.Add(Pointer(GetTickCount));
 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

     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 
    ShowMessage(Format('Download time for "%s" was %d ms', [IEEvents1.WebObj.LocationURL, dwTime]));
   end
;
 end
;

 procedure
 TForm1.IEEvents1Quit(Sender: TObject);
 begin

   ShowMessage('About to disconnect');
 end
;

 procedure
 TForm1.IEEvents1ProgressChange(Sender: TObject; Progress,
   ProgressMax: Integer);
 begin

   Caption := IntToStr(Progress);
 end
;

 end
.

Другое по теме:

• Очистка кэша в IE
• WEB страничка внутри Delphi приложения
• Автоматическое заполнение HTML-форм в браузере