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

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 245
  • Last Modified:

Single Instance Netscape

I have an application that I am creating that one of its functions is to keep open only 1 or 2 instances of Netscape or IE open.  Can some give me a code example to do this?  Or give me a way to count the number of open Netscape or IE browser windows, and close them, leaving only one open?  I hope this is a clear question.

Thanks!
0
aj85
Asked:
aj85
  • 9
  • 7
1 Solution
 
geobulCommented:
Hi,

The following code will close all IE windows except one when the button is pressed:
-----
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  List: TStringList;

implementation

{$R *.DFM}

function EnumerateWindows(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  buf: array [1..10] of char;
  cl: string;
begin
  Result := true;
  if GetClassName(hWnd, @buf, 10) <> 0 then begin
    cl := string(buf);
    if Trim(cl) = 'IEFrame' then List.Add(IntToStr(hWnd));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  List := TStringList.Create;
  try
    EnumWindows(@EnumerateWindows, 0);
    if List.Count > 1 then begin
      for i := 1 to List.Count - 1 do begin
        PostMessage(StrToInt(List[i]),WM_CLOSE,0,0);
      end;
    end;
  finally
    List.Free;
  end;
end;

end.
-----

IEFrame is the ClassName for IE windows. I don't know what is the name for Netscape. I will try to find it out and modify the code in a couple of hours.

Regards, Geo
0
 
geobulCommented:
Hi,

This works (tested) with IE 5 and above and Netscape Communicator 4.51.
----
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  List: TStringList;
  Instances: integer = 2; // number of instances to retain

implementation

{$R *.DFM}

function EnumerateWindows(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
 buf: array [1..10] of char;
 cl: string;
begin
 Result := true;
 if GetClassName(hWnd, @buf, 10) <> 0 then begin
   cl := string(buf);
   if (Trim(cl) = 'IEFrame') or (Copy(cl,1,4) = 'Afx:') then List.Add(IntToStr(hWnd));
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i: integer;
begin
 List := TStringList.Create;
 try
   EnumWindows(@EnumerateWindows, 0);
   if List.Count > Instances then begin
     for i := Instances to List.Count - 1 do begin
       PostMessage(StrToInt(List[i]),WM_CLOSE,0,0);
     end;
   end;
 finally
   List.Free;
 end;
end;

end.
-----
Regards, Geo
0
 
aj85Author Commented:
Ok, thanks, I will test this and get back to you shortly.

aj85
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
aj85Author Commented:

Ok, it seems to work, however, it closes the current browser window that I have open.  I want the currently open browsers to not be effected.  Meaning when the user opens the third browser for example, I only want the new browser to be closed.  Not the ones that are already open.  How can this be done?

Thanks!
aj85
0
 
geobulCommented:
This way: Getting creation times of the processes and sorting them in the StringList we receive a list of all browser windows, ordered by date/time.
---
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  List: TStringList;
  Instances: integer = 1; // number of instances to retain

implementation

{$R *.DFM}

function EnumerateWindows(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  buf: array [1..10] of char;
  cl: string;
  PID: DWORD;  // Process ID
  PH: THandle; // Process Handle
  CreationTime,ExitTime,KernelTime,UserTime: TFileTime;
  SysTimeStruct: TSystemTime;
  TheTime: TDateTime;
begin
  Result := true;
  if GetClassName(hWnd, @buf, 10) <> 0 then begin
    cl := string(buf);
    if (Copy(cl,1,7) = 'IEFrame') or (Copy(cl,1,4) = 'Afx:') then begin // IE or Netscape window
      GetWindowThreadProcessId(hWnd,@PID); // Get PID
      PH := OpenProcess(PROCESS_QUERY_INFORMATION, false, PID); // Get Process Handle
      try
        if PH <> 0 then begin
          GetProcessTimes(PH,CreationTime,ExitTime,KernelTime,UserTime); // Get Process Times
          if FileTimeToSystemTime(CreationTime, SysTimeStruct) then begin // Convert CreationTime to DateTime
            TheTime := SystemTimeToDateTime(SysTimeStruct);
            List.Add(FormatDateTime('yyyymmddhhnnss',TheTime)+' '+Format('%12d',[hWnd])); // Add to List
          end;
        end;
      finally
        CloseHandle(PH);
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  List := TStringList.Create;
  try
    EnumWindows(@EnumerateWindows, 0); // Enumerate windows
    List.Sorted := true; // sort the list (last times at the bottom)
    if List.Count > Instances then begin
      for i := Instances to List.Count - 1 do begin
        PostMessage(StrToInt(Copy(List[i],16,12)),WM_CLOSE,0,0); // close windows
      end;
    end;
  finally
    List.Free;
  end;
end;

end.
---
Regards, Geo
0
 
aj85Author Commented:
This works great, except I now get an exception error "date encode".  Can you tell me how to correct this?  Other than that it appears to work fine.

Thanks again!
0
 
geobulCommented:
if PH <> 0 then begin
  try // >> new line
    GetProcessTimes(PH,CreationTime,ExitTime,KernelTime,UserTime); // Get Process Times
    if FileTimeToSystemTime(CreationTime, SysTimeStruct) then begin // Convert CreationTime to DateTime
      TheTime := SystemTimeToDateTime(SysTimeStruct);
      List.Add(FormatDateTime('yyyymmddhhnnss',TheTime)+' '+Format('%12d',[hWnd])); // Add to List
  except // >> 3 new lines
    // if an exception occurs - do nothing
  end;
end;

This should do it I think.

Regards, Geo
0
 
aj85Author Commented:
Thanks, I will try this and get back with you shortly.

aj85
0
 
aj85Author Commented:
Ok, that took care of that, I think, but now when I open a new browser serveral times in a row.  On the 4th or 5th time whether it is IE or Netscape, it closes my current browser window and lets the new open.  I hope I explained that clearly enough, but anyway, what do you think could be cause this?  It is as if the time gets lost or something and it assumes the new browser has a more current timestamp than the present one that is already opened.

Thanks again!

P.S. Because you have given me a great source code example to follow.  And have also given me clear comments to follow what is happening.  I have increase your points by 25 for your help.
0
 
aj85Author Commented:
Also, one other thing.  I am now getting this error: Exception class EconvertError with message "Invalid argument to time encode".  I am not sure what is causing this?  Can you assist with this as well.

Thanks again!
0
 
geobulCommented:
I'm sorry that I misled you with all this processes stuff. I've found that:

1.IE: doesn't create new process when a new window is being opened using 'File-New-Window' main menu or 'Open in New Window' popup menu. It creates a new process when started using desktop icon / start-programs only.

2. Netscape always uses one process for all its windows.

So, the only real solution I could think of is:
1. Remember all browser window handles that should not be terminated (in a StringList)
2. repeatedly kill all other browser windows.

In the next example:
-pressing btnStore button will 'remember' all currently opened browsers in Instances list;
-pressing btnKill will close all the others.

And the code is:
---

type
  TForm1 = class(TForm)
    btnKill: TButton;
    btnStore: TButton;
    procedure btnKillClick(Sender: TObject);
    procedure btnStoreClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  List: TStringList;
  Instances: TStringList;

implementation

{$R *.DFM}

function EnumerateWindows(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
  buf: array [1..10] of char;
  cl: string;
begin
  Result := true;
  if GetClassName(hWnd, @buf, 10) <> 0 then begin
    cl := string(buf);
    if (Copy(cl,1,7) = 'IEFrame') or (Copy(cl,1,4) = 'Afx:') then begin // IE or Netscape window
      TStringList(Ptr(lParam)).Add(Format('%12d',[hWnd])); // Add to List
    end;
  end;
end;

procedure TForm1.btnKillClick(Sender: TObject);
var
  i: integer;
begin
  List := TStringList.Create;
  try
    EnumWindows(@EnumerateWindows, Integer(List)); // Enumerate windows
    if List.Count > 0 then begin // if there are browsers found
      for i := 0 to List.Count - 1 do begin
        if Instances.IndexOf(List[i]) = -1 then begin // if the window hasn't been stored in Instances
          PostMessage(StrToInt(List[i]),WM_CLOSE,0,0); // close windows
        end;
      end;
    end;
  finally
    List.Free;
  end;
end;

procedure TForm1.btnStoreClick(Sender: TObject);
begin
  // Remember all currently opened browser windows in Instances list
  Instances.Clear;
  EnumWindows(@EnumerateWindows, Integer(Instances)); // using lParam as a pointer to a StringList
end;

initialization
  // create Instances list
  Instances := TStringList.Create;
  Instances.Sorted := true;

finalization
  // free Instances list
  if Instances <> nil then Instances.Free;

end.
---
Regards, Geo
0
 
aj85Author Commented:
Ok, I think that did it.  On another note, can you give me an example on clearing or killing the cookies for IE and Netscape?  If you can I will increase your points by 50.  I am not sure if this an easy thing to do or not.  Anyway, let me know if you are interested in the additional points.

Thanks,
aj85
0
 
geobulCommented:
I'm afraid I can't help you in clearing cookies. Ask another 50 points question and someone else may have an answer how to do that.

Regards, Geo
0
 
aj85Author Commented:
No problem, here are your points.  And thanks for the clear answer.
0
 
aj85Author Commented:
Great answer!
0
 
geobulCommented:
My pleasure. Thanks for the points.

Best regards, Geo
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 9
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now