[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Auto login to webpage > how to implement an am-i-online-check and is-the-page-loaded-check prior to logging in?

Posted on 2004-11-13
15
Medium Priority
?
335 Views
Last Modified: 2010-04-05
Hi Guyzz!

I'm working on a project which involves starting Internet Explorer > jumping to some page > insert a username and pass and click a button after which I'm logged in automatically. Now I ran into some problems regarding the following:

If IE needs some time to load, my program should wait until it has loaded the page it wants to log in to. I managed to achieve that by using a TWebbrowser (documentcomplete) but now I'd like to implement that 'behaviour' into my app without having to use the TWebbrowser. In addition it should detect whether the page is available (suppose internet connection is dead) at all and if not it should pop up a message and close automatically.



Solving these issues will give you the points > a working sample. Let me know whether I should post my code okay?

Regards in advance,

PeterdeB
0
Comment
Question by:PeterdeB
  • 9
  • 6
15 Comments
 
LVL 31

Expert Comment

by:Wayne Barron
ID: 12581327
What all do you exactly have at the moment?
Are you able to logon to the page in IE?
Or are you needing to know it from the ground up?

Could you supply your code as well?

Carrzkiss
0
 

Author Comment

by:PeterdeB
ID: 12583834
Hey Carrzkiss tnx for your reply!!

I gave up hope somebody would respond to this one and already considered deleting it.
I manage to login automatically but haven't figured out why it sometimes fails to do so. Apparently it has something to do with the webpage its cookies or something since when I opened the page once and closed it it succeeds every time I try but when I try to do so after having cleaned my pc which occurs after every restart with eraser, it fails. I'll supply my code right away I implemented some timers to let the app check for internet connection since I want it to close regardless of it succeeds or fails it should automatically close.

I get back to you right away ok?

Regards,

Peterdeb
0
 

Author Comment

by:PeterdeB
ID: 12587726
uses mshtml_tlb, Shellapi;

function TForm1.Go1:boolean;
var
  ShellWindow: IShellWindows;
  WB: IWebbrowser2;
  spDisp: IDispatch;
  IDoc1: IHTMLDocument2;
  Document: Variant;
  k, m: Integer;
  ovElements: OleVariant;
  i: Integer;
begin
result:=false; //assume no go

 ShellWindow := CoShellWindows.Create;
  // get the running instance of Internet Explorer
  for k := 0 to ShellWindow.Count do
  begin
    spDisp := ShellWindow.Item(k);
    if spDisp = nil then Continue;
    // QueryInterface determines if an interface can be used with an object
    spDisp.QueryInterface(iWebBrowser2, WB);
    if WB <> nil then
    begin try

      WB.Document.QueryInterface(IHTMLDocument2, iDoc1);   < this is wheree the EOleException occurs
      except
      end;
      if iDoc1 <> nil then
      begin
        WB := ShellWindow.Item(k) as IWebbrowser2;
        begin
          Document := WB.Document;
          // count forms on document and iterate through its forms
          for m := 0 to Document.forms.Length - 1 do
          begin
            ovElements := Document.forms.Item(m).elements;
            // iterate through elements
            for i := 0 to ovElements.Length - 1 do
            begin
              // when input fieldname is found, try to fill out
              try
                if (CompareText(ovElements.item(i).tagName, 'INPUT') = 0) and
                  (CompareText(ovElements.item(i).type, 'text') = 0) then
                begin
                  ovElements.item(i).Value := edtUserName.Text;
                end;
              except
              end;
              try
                if (CompareText(ovElements.item(i).tagName, 'INPUT') = 0) and
                  (CompareText(ovElements.item(i).type, 'password') = 0) then
                begin
                  ovElements.item(i).Value := edtPassword.Text;
                end;
              except
              end;
              // when Submit button is found, try to click
              try
                if (CompareText(ovElements.item(i).tagName, 'INPUT') = 0) and
                  (CompareText(ovElements.item(i).type, 'SUBMIT') = 0) and
                  (ovElements.item(i).Value = edtButton.Text) then  /
                begin
                  ovElements.item(i).Click;
                  result:=true; // we're a go!

                end;
              except
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

  function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
  ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
  if (INTERNETGetConnectedState(@ConTypes, 0) = False) then Result := False else Result := True;
end;


procedure TForm1.FormCreate(Sender: TObject);
    var
  AStyle: Cardinal;
begin
AStyle := GetWindowLong(Application.Handle,GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE, AStyle or WS_EX_TOOLWINDOW);
if GetOnlineStatus = False then
timer3.Enabled := true
else begin
label1.Caption := 'Bezig met verbinden...';
ShellExecute(HANDLE,
    'open',
    PChar(edtURL.Text),
    nil,
    nil,
    SW_SHOW);
    Timer1.Enabled := true;

    //SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clRed);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
 label1.Caption := 'Inloggen...';

If Go1 then
Timer2.Enabled := True
else begin
label1.caption := 'Mislukt!';
Timer3.Enabled := true;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
Timer2.Enabled := false;
Progressbar1.Position := 100;
Label1.Caption := 'Ingelogd!';
Timer3.Enabled := true;
end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
Timer3.Enabled := False;
Close;
end;

end.


To Carrzkiss > I want the label1 to reflect in what state the program is and couldn't find another way to do so without using several timers. Furthermore it sometimes halts with an EOleException and that too seems to be related to whether a page already has been loaded before (temp files??)

My regards,

PeterdeB
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 31

Expert Comment

by:Wayne Barron
ID: 12587824
I will take a look at it later on this evening.
I see that you are in fact using the "WB" WebBrowser control in this project correct?
Have you tried using the "TEmbeddedWB" instead?

Is this project going to rely on the use of a Delphi-WebBrowser control?
Or are you wanting to connect to IE itself?

The WebBrowser (TEmbeddedWB) Control, Their is not very much that
I cannot do, ( And a lot that I have not learned yet as well )
But IE is something that I am learning.

So if you can give me some in-depth information on "Exactly"
What it is that you are wanting/trying to do here.
Then when I bring the code into Delphi this evening I will not be lost.
Trying to figure out what it is that you are actually trying to do.

Also, a link to a site that your project is using will be great as well.
This way I can take a look at everything that you are seeing.

I know that sometimes you do not really want to give out to much information on the open groups like this, but it will help me and others to assist in this issue.

Carrzkiss
0
 

Author Comment

by:PeterdeB
ID: 12589245
Sounds fair enough to me > send me a mail then I'll give you all the information you need and even give you a temporary account to use the program and see what it does and where it is taken:)

Ok?

My regards,

PeterdeB

Btw the wb is not a twebbrowser > my app uses internet explorer
0
 
LVL 31

Expert Comment

by:Wayne Barron
ID: 12589273
send an e-mail to:

delphianATcarrz-fox-fire.com

// Replace the AT with @
0
 

Author Comment

by:PeterdeB
ID: 12607406
Hi Carrzkiss!

Did you receive my email?

My regards and tnx in advance for the effort you put into helping me!

PeterdeB
0
 
LVL 31

Expert Comment

by:Wayne Barron
ID: 12608326
I take it you want to do this on your own.
Since no project files were sent over.

Good Luck in your project.

Carrzkiss
0
 

Author Comment

by:PeterdeB
ID: 12610324
No not at all then we've misunderstood each other > the project is being sent your way, I must have misinterpreted your comments cause I didn't read you asked for the project files. Alas I'll send them your way.

My regards and respect,

PeterdeB
0
 

Author Comment

by:PeterdeB
ID: 12614795
Carzzkiss,

I sent you two emails both containing my project files but they were bounced by the server. The first contained a zip file the second contained a txt file (I pressumed it was the zip extension which made it bounce)

Shall I post the project here?

Regards,

Peterdeb
0
 
LVL 31

Accepted Solution

by:
Wayne Barron earned 2000 total points
ID: 12614870
humm?
Do not know why?
I have a new Mail Server Web Mail installed.
And the Web Mail part of it I have not gotten to configure it.
Send to:

eric_carr_tribute @ hotmail.com

Carrzkiss
0
 

Author Comment

by:PeterdeB
ID: 12615029
Oh ok I'll try once more hang on tnx for your response!

Regards,

PeterdeB
0
 

Author Comment

by:PeterdeB
ID: 12651444
Quid pro quo :)

My regards!

Peter
0
 

Author Comment

by:PeterdeB
ID: 12651466
The points are yours Carrzkiss for the effort you put into helping me and for the project's code you will send me:)

My regards,

Peter

Btw the problem isnt really solved > but I upped the timer interval from 2 to 4 seconds which seems to reduce the errors because of the 2 seconds extra time IE gets to load the page. I'm aware of the fact that this comment doesnt help out other people but I reward Carrzkiss anyway for the effort he put into assisting me.
0
 
LVL 31

Expert Comment

by:Wayne Barron
ID: 12651671
Here is the code for those that wish to use it.
This way it is not a 500 point ??? About the code from other people
And from EE if they look in here and wonder where HELP is from:
========================================
This is the code for the "Component" that needs to be installed in order for it to run"
Component by: [ rllibby ] Here on EE
=================================================
unit ie_events;

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.
=================================================
=================================================
This is the code for the project, Runs ONLY in IE6 and above. Need to do some more
Checking and code implementation to make it run on versions before IE6.
=================================================
=======================
unit Unit1;

interface

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

type
  TForm1            =  class(TForm)
     procedure      FormCreate(Sender: TObject);
  private
     FTimer:        TTimer;
     FLogin:        TButton;
     FUserID:       TEdit;
     FPassword:     TEdit;
     FEvents:       TIEEvents;
     function       CanLoginAny: Boolean;
     function       CanLogin(Browser: OleVariant): Boolean;
     function       PerformLogin(UserID, Password: String): Boolean;
  protected
     // Protected declarations
     procedure      UpdateState(AllowLogin: Boolean);
     procedure      CreateRuntimeControls;
     procedure      OnTimer(Sender: TObject);
     procedure      OnButtonClick(Sender: TObject);
     procedure      OnQuit(Sender: TObject);
  public
     // Public declarations
  end;

// Color constants
const
  clrEnabled:       Array [False..True] of TColor = (clBtnFace, clWindow);

// Global form variable
var
  Form1:            TForm1;
  Unassigned:       OleVariant;
implementation
{$R *.DFM}

procedure TForm1.UpdateState(AllowLogin: Boolean);
begin

  // Update the controls state
  FUserID.Enabled:=AllowLogin;
  FPassword.Enabled:=AllowLogin;
  FUserID.Color:=clrEnabled[FUserID.Enabled];
  FPassword.Color:=clrEnabled[FPassword.Enabled];
  FLogin.Enabled:=AllowLogin;

end;

procedure TForm1.OnButtonClick(Sender: TObject);
begin

  // Check values
  if (FUserID.Text = EmptyStr) then
     ShowMessage('UserID required...')
  else if (FPassword.Text = EmptyStr) then
     ShowMessage('Password required...')
  else
  begin
     // Perform the login
     if PerformLogin(FUserID.Text, FPassword.Text) then
     begin
        // Disable state
        FTimer.Enabled:=False;
        try
           // Disable state
           UpdateState(False);
           // Let the process start
           while (FEvents.WebObj.ReadyState = READYSTATE_COMPLETE) do Application.ProcessMessages;
           // Wait until the login has completed
           while FEvents.Connected and (FEvents.WebObj.ReadyState <> READYSTATE_COMPLETE) do
           begin
              // Wait until the submission has finished (or the user closes the IE window)
              Application.ProcessMessages;
           end;
           // Check state of web browser interface
           if not(FEvents.Connected) or CanLogin(FEvents.WebObj.Document) then
              // Failed to login
              ShowMessage('Failed to log in')
           else
              // Logged in
              ShowMessage('Logged in...');
        finally
           // Disconnect
           FEvents.Disconnect;
           // Re-enable timer
           FTimer.Enabled:=True;
        end;
     end;
  end;

end;

procedure TForm1.OnQuit(Sender: TObject);
begin

  // Disconnect from interface
  FEvents.Disconnect;

  // Update state
  UpdateState(False);

end;

procedure TForm1.OnTimer(Sender: TObject);
begin

  // Timer event
  if not(FEvents.Connected) then UpdateState(CanLoginAny);

end;

function TForm1.PerformLogin(UserID, Password: String): Boolean;
var  pvShell:       IShellWindows;
     pvWeb2:        IWebBrowser2;
     ovIE:          OleVariant;
     ovDoc2:        OleVariant;
     ovElement:     OleVariant;
     ovInput:       OleVariant;
     ovPassword:    OleVariant;
     ovSubmit:      OleVariant;
     dwCount:       Integer;
     dwFrames:      Integer;
     dwIndex:       Integer;
     bSubmit:       Boolean;
begin

  // Set default result
  result:=False;

  // Create the shell windows interface
  pvShell:=CoShellWindows.Create;
  try
     // Walk the internet explorer windows
     for dwCount:=0 to Pred(pvShell.Count) do
     begin
        // Get the interface
        ovIE:=pvShell.Item(dwCount);
        // QI for the IWebBrowser2
        if (IDispatch(ovIE).QueryInterface(IWebBrowser2, pvWeb2) = S_OK) then
        begin
           // Make sure it is ready
           if not(pvWeb2.Offline) and (pvWeb2.ReadyState = READYSTATE_COMPLETE) then
           begin
              // Check for elements in page
              if Assigned(pvWeb2.Document) then
              begin
                 // Set defaults
                 ovInput:=Unassigned;
                 ovPassword:=Unassigned;
                 ovSubmit:=Unassigned;
                 // Get the document object
                 ovDoc2:=pvWeb2.Document;
                 try
                    // Walk the frames
                    for dwFrames:=0 to ovDoc2.Forms.Length-1 do
                    begin
                       // Walk elements
                       for dwIndex:=0 to ovDoc2.Forms.Item(dwFrames).All.Length-1 do
                       begin
                          // Get element
                          ovElement:=ovDoc2.Forms.Item(dwFrames).All.Item(dwIndex);
                          // Check input
                          if (CompareText(String(ovElement.tagName), 'input') = 0) then
                          begin
                             // Check input
                             if (CompareText(String(ovElement.Type), 'text') = 0) then
                                // Get input
                                ovInput:=ovElement
                             // Check password
                             else if (CompareText(String(ovElement.Type), 'password') = 0) then
                                // Set password
                                ovPassword:=ovElement
                             // Check for submit
                             else if (Pos(LowerCase('submit'), LowerCase(String(ovElement.Name))) > 0) then
                             begin
                                // Must be in the same context as user/password (eg, don't falsely pick up a search button)
                                if (VarType(ovInput) > varEmpty) and (VarType(ovPassword) > varEmpty) then
                                begin
                                   // Have submit
                                   ovSubmit:=ovElement;
                                end;
                             end;
                          end;
                          // Release element
                          ovElement:=Unassigned;
                          // Do we have all elements?
                          if (VarType(ovInput) > varEmpty) and
                             (VarType(ovPassword) > varEmpty) and
                             (VarType(ovSubmit) > varEmpty) then
                          begin
                             // Connect to the interface
                             FEvents.ConnectTo(pvWeb2);
                             // Submit
                             ovInput.Value:=UserID;
                             ovPassword.Value:=Password;
                             ovSubmit.Click;
                             // Set result
                             result:=True;
                             // Break
                             break;
                          end;
                       end;
                       // If success then break
                       if result then break;
                    end;
                 finally
                    // Clear refs
                    ovInput:=Unassigned;
                    ovPassword:=Unassigned;
                    ovSubmit:=Unassigned;
                    ovDoc2:=Unassigned;
                 end;
              end;
           end;
           // Release the interface
           pvWeb2:=nil;
        end;
        // Clear the variant
        ovIE:=Unassigned;
        // If success then break
        if result then break;
     end;
  finally
     // Release the interface
     pvShell:=nil;
  end;

end;

function TForm1.CanLogin(Browser: OleVariant): Boolean;
var  ovElement:     OleVariant;
     ovInput:       OleVariant;
     ovPassword:    OleVariant;
     dwCount:       Integer;
     dwFrames:      Integer;
     dwIndex:       Integer;
begin

  // Set default result
  result:=False;

  // Walk the frames
  for dwFrames:=0 to Browser.Forms.Length-1 do
  begin
     // Clear state
     ovInput:=Unassigned;
     ovPassword:=Unassigned;
     // Walk elements
     for dwIndex:=0 to Browser.Forms.Item(dwFrames).All.Length-1 do
     begin
        // Get element
        ovElement:=Browser.Forms.Item(dwFrames).All.Item(dwIndex);
        // Check input
        if (CompareText(String(ovElement.tagName), 'input') = 0) then
        begin
           // Check input
           if (CompareText(String(ovElement.Type), 'text') = 0) then
              // Have input
              ovInput:=ovElement
           // Check password
           else if (CompareText(String(ovElement.Type), 'password') = 0) then
              // Have password
              ovPassword:=ovElement;
        end;
        // Release element
        ovElement:=Unassigned;
        // Break if we have both password and input
        if (VarType(ovInput) > varEmpty) and (VarType(ovPassword) > varEmpty) then break;
     end;
     // Check elements
     result:=(VarType(ovInput) > varEmpty) and (VarType(ovPassword) > varEmpty);
     // Release refs
     ovInput:=Unassigned;
     ovPassword:=Unassigned;
     // Break is success
     if result then break;
  end;

end;

function TForm1.CanLoginAny: Boolean;
var  pvShell:       IShellWindows;
     pvWeb2:        IWebBrowser2;
     ovIE:          OleVariant;
     ovDoc2:        OleVariant;
     dwCount:       Integer;
begin

  // Set default result
  result:=False;

  // Create the shell windows interface
  pvShell:=CoShellWindows.Create;
  try
     // Walk the internet explorer windows
     for dwCount:=0 to Pred(pvShell.Count) do
     begin
        // Get the interface
        ovIE:=pvShell.Item(dwCount);
        // QI for the IWebBrowser2
        if (IDispatch(ovIE).QueryInterface(IWebBrowser2, pvWeb2) = S_OK) then
        begin
           // Make sure it is ready
           if not(pvWeb2.Offline) and (pvWeb2.ReadyState = READYSTATE_COMPLETE) then
           begin
              // Check for elements in page
              if Assigned(pvWeb2.Document) then
              begin
                 // Get the document object
                 ovDoc2:=pvWeb2.Document;
                 try
                    // See if we can login to the page
                    result:=CanLogin(ovDoc2);
                 finally
                    // Clear document
                    ovDoc2:=Unassigned;
                 end;
              end;
           end;
        end;
        // Release the interface
        pvWeb2:=nil;
        // Clear the variant
        ovIE:=Unassigned;
        // If success then break
        if result then break;
     end;
  finally
     // Release the interface
     pvShell:=nil;
  end;

end;

procedure TForm1.CreateRuntimeControls;
begin

  // Create IE event handler
  FEvents:=TIEEvents.Create(Self);
  FEvents.OnQuit:=OnQuit;

  // Create login button
  FLogin:=TButton.Create(Self);
  with FLogin do
  begin
     Parent:=Self;
     SetBounds(8, 8, 73, 25);
     Caption:='Login';
     OnClick:=OnButtonClick;
     Visible:=True;
  end;

  // Create user id label
  with TLabel.Create(Self) do
  begin
     Parent:=Self;
     SetBounds(100, 12, 60, 13);
     Caption:='User ID:';
     Visible:=True;
  end;

  // Create password label
  with TLabel.Create(Self) do
  begin
     Parent:=Self;
     SetBounds(100, 36, 60, 13);
     Caption:='Password:';
     Visible:=True;
  end;

  // Create user id entry field
  FUserID:=TEdit.Create(Self);
  with FUserID do
  begin
     Parent:=Self;
     SetBounds(164, 8, 197, 21);
     Text:=EmptyStr;
     Visible:=True;
  end;

  // Create password entry field
  FPassword:=TEdit.Create(Self);
  with FPassword do
  begin
     Parent:=Self;
     SetBounds(164, 32, 197, 21);
     Text:=EmptyStr;
     PasswordChar:='*';
     Visible:=True;
  end;

  // Create timer
  FTimer:=TTimer.Create(Self);
  with FTimer do
  begin
     Parent:=Self;
     Interval:=500;
     Enabled:=True;
     OnTimer:=Self.OnTimer;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  // Set caption
  Caption:='Login to IE';

  // Set bounds
  SetBounds((Screen.Width-400) div 2, (Screen.Height-120) div 2, 400, 120);

  // Create run time controls
  CreateRuntimeControls;

  // Update state (don't allow login yet)
  UpdateState(False);

end;

end.
===============

=================================================
Hope that everyone can find some use of this code project,
I would like to think: [ rllibby ] for his assistance in this project code.

Take Care All;
And Happy Thanksgiving

Carrzkiss
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…
Suggested Courses

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question