?
Solved

Points for: rllibby - Login to IE Instance without / TWebBrowser Straight IE Interface

Posted on 2004-11-22
6
Medium Priority
?
397 Views
Last Modified: 2010-04-04
Thank you so very much for your help.
To all
here is the code, works great on versions of IE 6 and above.
=======================
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.
===============

Thank you Russell;
Great work, great coding, Great Programmer, New Friend!
Please keep an eye out for the new site that I (we) are developing.
It is for ALL Borland Products.
Tutorials, Source Code, Project, and so forth.
Called: DFS = Delphi Fire Security.
Been in the works for 2 yrs, been in development stages for 6 months.
Almost done, we hope, ready for a Hopeful release LIVE date on:
New Years Eve.

Take Care
Wayne
0
Comment
Question by:Wayne Barron
  • 4
6 Comments
 
LVL 14

Expert Comment

by:DragonSlayer
ID: 12650581
Wayne, when you release that site, don't forget to post the link up for all of us! ;-)
0
 
LVL 31

Author Comment

by:Wayne Barron
ID: 12650617
Hey Dragon.
Do not worry, I will.

Right now there is an estimated 1,500 people that are to hit that site
And my Main site within hours after their release.
Cannot wait, the anticipation, is driving me bonkers ;-)
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 2000 total points
ID: 12651053
Thanks for the points Wayne; been a pleasure working with you. I will also keep an eye out for your release..

Kind regards,
Russell
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

Author Comment

by:Wayne Barron
ID: 12651335
It was my pleasure to get to know you.
Russell, take care and have a wonder Thanksgiving Holiday

From Everyone here at:
Carrz-Fox-Fire Promotions
0
 
LVL 31

Author Comment

by:Wayne Barron
ID: 14755167
Hello Russell;

   If you have the time, could you drop in and see if you can assist with an issue
That we are having? The points have already been awarded out, as the initial
Question has been answered. But if you can assist, I will be more then happy to
Post another question giving you some points as well.

Look at the code supplied under and everything after
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21534837.html#14751504


And also, ON the
Borland Site = DFS
That I was working on, It had to be put on the back burner, as other projects
Come up that took priority.

I am hoping to start back on it sometime within the next coming months, in hopes
That it can be released before the ending of the year.
Fingers Crossed anyway.

Take Care and thanks for everything.
0
 
LVL 31

Author Comment

by:Wayne Barron
ID: 14755194
Hello Russell;

   I think we might have this taken care of.
But if you still want to take a look at it, please do so, and any comments, will
Be greatfully appreciated.

Wayne
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
When cloud platforms entered the scene, users and companies jumped on board to take advantage of the many benefits, like the ability to work and connect with company information from various locations. What many didn't foresee was the increased risk…
Suggested Courses
Course of the Month14 days, 11 hours left to enroll

839 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