aj85
asked on
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!
Thanks!
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(@EnumerateWind ows, 0);
if List.Count > Instances then begin
for i := Instances to List.Count - 1 do begin
PostMessage(StrToInt(List[ i]),WM_CLO SE,0,0);
end;
end;
finally
List.Free;
end;
end;
end.
-----
Regards, Geo
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
var
i: integer;
begin
List := TStringList.Create;
try
EnumWindows(@EnumerateWind
if List.Count > Instances then begin
for i := Instances to List.Count - 1 do begin
PostMessage(StrToInt(List[
end;
end;
finally
List.Free;
end;
end;
end.
-----
Regards, Geo
ASKER
Ok, thanks, I will test this and get back to you shortly.
aj85
aj85
ASKER
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
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,Kern elTime,Use rTime: 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(h Wnd,@PID); // Get PID
PH := OpenProcess(PROCESS_QUERY_ INFORMATIO N, false, PID); // Get Process Handle
try
if PH <> 0 then begin
GetProcessTimes(PH,Creatio nTime,Exit Time,Kerne lTime,User Time); // Get Process Times
if FileTimeToSystemTime(Creat ionTime, SysTimeStruct) then begin // Convert CreationTime to DateTime
TheTime := SystemTimeToDateTime(SysTi meStruct);
List.Add(FormatDateTime('y yyymmddhhn nss',TheTi me)+' '+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(@EnumerateWind ows, 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_C LOSE,0,0); // close windows
end;
end;
finally
List.Free;
end;
end;
end.
---
Regards, Geo
---
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,Kern
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(h
PH := OpenProcess(PROCESS_QUERY_
try
if PH <> 0 then begin
GetProcessTimes(PH,Creatio
if FileTimeToSystemTime(Creat
TheTime := SystemTimeToDateTime(SysTi
List.Add(FormatDateTime('y
end;
end;
finally
CloseHandle(PH);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender
var
i: integer;
begin
List := TStringList.Create;
try
EnumWindows(@EnumerateWind
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(
end;
end;
finally
List.Free;
end;
end;
end.
---
Regards, Geo
ASKER
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!
Thanks again!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks, I will try this and get back with you shortly.
aj85
aj85
ASKER
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.
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.
ASKER
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!
Thanks again!
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)).A dd(Format( '%12d',[hW nd])); // Add to List
end;
end;
end;
procedure TForm1.btnKillClick(Sender : TObject);
var
i: integer;
begin
List := TStringList.Create;
try
EnumWindows(@EnumerateWind ows, 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_CLO SE,0,0); // close windows
end;
end;
end;
finally
List.Free;
end;
end;
procedure TForm1.btnStoreClick(Sende r: TObject);
begin
// Remember all currently opened browser windows in Instances list
Instances.Clear;
EnumWindows(@EnumerateWind ows, 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
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)).A
end;
end;
end;
procedure TForm1.btnKillClick(Sender
var
i: integer;
begin
List := TStringList.Create;
try
EnumWindows(@EnumerateWind
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])
PostMessage(StrToInt(List[
end;
end;
end;
finally
List.Free;
end;
end;
procedure TForm1.btnStoreClick(Sende
begin
// Remember all currently opened browser windows in Instances list
Instances.Clear;
EnumWindows(@EnumerateWind
end;
initialization
// create Instances list
Instances := TStringList.Create;
Instances.Sorted := true;
finalization
// free Instances list
if Instances <> nil then Instances.Free;
end.
---
Regards, Geo
ASKER
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
Thanks,
aj85
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
Regards, Geo
ASKER
No problem, here are your points. And thanks for the clear answer.
ASKER
Great answer!
My pleasure. Thanks for the points.
Best regards, Geo
Best regards, Geo
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
var
i: integer;
begin
List := TStringList.Create;
try
EnumWindows(@EnumerateWind
if List.Count > 1 then begin
for i := 1 to List.Count - 1 do begin
PostMessage(StrToInt(List[
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