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	torben	2671	// 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.