tpsystools_4.04/source/StFirst.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StFirst.pas 4.04                            *}
{*********************************************************}
{* SysTools: limit instance routines                     *}
{*********************************************************}

{$I StDefine.inc}

unit StFirst;

interface

uses
  Windows, Messages, Forms, SysUtils, Dialogs,

  StBase;

function IsFirstInstance: Boolean;
 {- check if previous instance is running}
procedure ActivateFirst(AString : PChar);
 {- Activate previous instance, passing a string}
procedure ActivateFirstCommandLine;
 {- Activate previous instance, passing the command line}


implementation

const
  MAX_CMDLEN = 1024;

var
  CmdLine : array[0..MAX_CMDLEN] of char;

var
  FirstInstance : Boolean;
  InstanceMutex : THandle;

{limit instances routines}
function IsFirstInstance : Boolean;
begin
  Result := FirstInstance;
end;

procedure ActivateFirstCommandLine;
var
  S : String;
  I : Longint;
begin
  S := '';
  for I := 0 to ParamCount-1 do
    S := S + ParamStr(I) + ' ';
  S := S + ParamStr(ParamCount);
  StrPCopy(CmdLine, Copy(S, 1, MAX_CMDLEN));
  ActivateFirst(CmdLine);
end;


procedure ActivateFirst(AString : PChar);
var
  ClassBuf,
  WindowBuf : array [0..255] of Char;
  Wnd,
  TopWnd    : hWnd;
  ThreadID  : DWord;
  CDS       : TCopyDataStruct;
begin
  if (strlen(AString) > 0) then begin
    CDS.dwData := WMCOPYID;
    CDS.cbData := StrLen(AString) + 1;
    CDS.lpData := AString;
  end else begin
    CDS.dwData := WMCOPYID;
    CDS.cbData := 0;
    CDS.lpData := nil;
  end;

  if IsFirstInstance then begin
    if IsIconic(Application.Handle) then
      Application.Restore
    else
      Application.BringToFront;
  end else begin
    GetClassName(Application.Handle, ClassBuf, Length(ClassBuf));
    GetWindowText(Application.Handle, WindowBuf, Length(WindowBuf));
    Wnd := FindWindow(ClassBuf, WindowBuf);
    if (Wnd <> 0) then begin
      GetWindowThreadProcessId(Wnd, @ThreadID);
      if (ThreadID = GetCurrentProcessId) then begin
        Wnd := FindWindowEx(0, Wnd, ClassBuf, WindowBuf);
        if (Wnd <> 0) then begin
          if IsIconic(Wnd) then
            ShowWindow(Wnd, SW_RESTORE);
          SetForegroundWindow(Wnd);
          TopWnd := GetLastActivePopup(Wnd);
          if (TopWnd <> 0) and (TopWnd <> Wnd) and
              IsWindowVisible(TopWnd) and IsWindowEnabled(TopWnd) then begin
            BringWindowToTop(TopWnd);
            SendMessage(TopWnd, WM_COPYDATA, 0, lparam(@CDS));
          end else begin
            BringWindowToTop(Wnd);
            SendMessage(Wnd, WM_COPYDATA, 0, lparam(@CDS));
          end;
        end;
      end;
    end;
  end;
end;

function GetMutexName : string;
var
  WindowBuf : array [0..512] of Char;
begin
  GetWindowText(Application.Handle, WindowBuf, Length(WindowBuf));
  Result := 'PREVINST:' + WindowBuf;
end;

initialization
  InstanceMutex := CreateMutex(nil, True, PChar(GetMutexName));
  if (InstanceMutex <> 0) and (GetLastError = 0) then
    FirstInstance := True
  else
    FirstInstance := False;

finalization
  if (InstanceMutex <> 0) then
    CloseHandle(InstanceMutex);
end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StFirst.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: limit instance routines *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	unit StFirst;
37
38	interface
39
40	uses
41	Windows, Messages, Forms, SysUtils, Dialogs,
42
43	StBase;
44
45	function IsFirstInstance: Boolean;
46	{- check if previous instance is running}
47	procedure ActivateFirst(AString : PChar);
48	{- Activate previous instance, passing a string}
49	procedure ActivateFirstCommandLine;
50	{- Activate previous instance, passing the command line}
51
52
53	implementation
54
55	const
56	MAX_CMDLEN = 1024;
57
58	var
59	CmdLine : array[0..MAX_CMDLEN] of char;
60
61	var
62	FirstInstance : Boolean;
63	InstanceMutex : THandle;
64
65	{limit instances routines}
66	function IsFirstInstance : Boolean;
67	begin
68	Result := FirstInstance;
69	end;
70
71	procedure ActivateFirstCommandLine;
72	var
73	S : String;
74	I : Longint;
75	begin
76	S := '';
77	for I := 0 to ParamCount-1 do
78	S := S + ParamStr(I) + ' ';
79	S := S + ParamStr(ParamCount);
80	StrPCopy(CmdLine, Copy(S, 1, MAX_CMDLEN));
81	ActivateFirst(CmdLine);
82	end;
83
84
85	procedure ActivateFirst(AString : PChar);
86	var
87	ClassBuf,
88	WindowBuf : array [0..255] of Char;
89	Wnd,
90	TopWnd : hWnd;
91	ThreadID : DWord;
92	CDS : TCopyDataStruct;
93	begin
94	if (strlen(AString) > 0) then begin
95	CDS.dwData := WMCOPYID;
96	CDS.cbData := StrLen(AString) + 1;
97	CDS.lpData := AString;
98	end else begin
99	CDS.dwData := WMCOPYID;
100	CDS.cbData := 0;
101	CDS.lpData := nil;
102	end;
103
104	if IsFirstInstance then begin
105	if IsIconic(Application.Handle) then
106	Application.Restore
107	else
108	Application.BringToFront;
109	end else begin
110	GetClassName(Application.Handle, ClassBuf, Length(ClassBuf));
111	GetWindowText(Application.Handle, WindowBuf, Length(WindowBuf));
112	Wnd := FindWindow(ClassBuf, WindowBuf);
113	if (Wnd <> 0) then begin
114	GetWindowThreadProcessId(Wnd, @ThreadID);
115	if (ThreadID = GetCurrentProcessId) then begin
116	Wnd := FindWindowEx(0, Wnd, ClassBuf, WindowBuf);
117	if (Wnd <> 0) then begin
118	if IsIconic(Wnd) then
119	ShowWindow(Wnd, SW_RESTORE);
120	SetForegroundWindow(Wnd);
121	TopWnd := GetLastActivePopup(Wnd);
122	if (TopWnd <> 0) and (TopWnd <> Wnd) and
123	IsWindowVisible(TopWnd) and IsWindowEnabled(TopWnd) then begin
124	BringWindowToTop(TopWnd);
125	SendMessage(TopWnd, WM_COPYDATA, 0, lparam(@CDS));
126	end else begin
127	BringWindowToTop(Wnd);
128	SendMessage(Wnd, WM_COPYDATA, 0, lparam(@CDS));
129	end;
130	end;
131	end;
132	end;
133	end;
134	end;
135
136	function GetMutexName : string;
137	var
138	WindowBuf : array [0..512] of Char;
139	begin
140	GetWindowText(Application.Handle, WindowBuf, Length(WindowBuf));
141	Result := 'PREVINST:' + WindowBuf;
142	end;
143
144	initialization
145	InstanceMutex := CreateMutex(nil, True, PChar(GetMutexName));
146	if (InstanceMutex <> 0) and (GetLastError = 0) then
147	FirstInstance := True
148	else
149	FirstInstance := False;
150
151	finalization
152	if (InstanceMutex <> 0) then
153	CloseHandle(InstanceMutex);
154	end.