（小菜一碟？）怎样让程序重复执行时自动转到已有的实例中？

[wyj]

我知道可以用加全局原子的方法让程序不会同时执行两次，但有时您明明已经告诉用户“程序已经在运行中，不可以再运行一次。”

[kxy]

unit InstanceManager;
{
****************************************************************
* updates can be found at http://www.pefra.de/renatager *
* *
* *
* Please send me any changes/fixes/addings you make. I publish *
* this unit like something like open sources! ;) I found this *
* unit somewhere and added handling of command line parameter *
* *
****************************************************************
}

interface

{Notes: make InstanceManager the *very first* unit in your program's USES
clause. To take advantage of the notification and launch-string, put a
method with no parameters in one of your forms and assign it to triggerProc.
Once triggerProc is called, rcvStr contains the command line of the launch
attempt.

If the only reaction you want is to bring the first instance to the front,
just put a method like the following in your main form, and in the form's
OnCreate set InstanceManager.triggerProc:=ToFront;

procedure TForm1.ToFront;
begin
Application.Restore;
Application.BringToFront;
end;

If you don't have a dependable main form, make ToFront a class procedure of
any old class.}

{ Customize these constants before using }
const UniqueAppName = 'bobaNew';
AppNotifyValue: integer = 0;

var rcvStr: string;
rcvValue: integer;
ForbidOtherInstance: boolean = True;
triggerProc: procedure of object;

implementation

uses Windows, SysUtils, Messages, Dialogs;

var mutex, thisWnd: HWND;
IMWndClass: TWndClassA;
mustHalt: boolean;
copydata: TCOPYDATASTRUCT;

function IMWndProc(HWindow: HWnd; Message, WParam: Longint; LParam:
Longint): Longint; stdcall;
begin
if Message=WM_COPYDATA then
begin
try
rcvStr := StrPas(PCOPYDATASTRUCT(lParam).lpData);
rcvValue := PCOPYDATASTRUCT(lParam).dwData;
if Assigned(triggerProc) then triggerProc;
Result := Ord(ForbidOtherInstance);
except
ShowMessage('WM_COPYDATA:error '+rcvStr+' '+IntToStr(rcvValue));
// Result := DefWindowProc(hWindow, Message, WParam, LParam);
end;
end
else
Result := DefWindowProc(hWindow, Message, WParam, LParam);
end;

initialization

FillChar(IMWndClass, SizeOf(IMWndClass), 0);
IMWndClass.lpfnWndProc := @IMWndProc;
IMWndClass.hInstance := HINSTANCE;
IMwndClass.lpszClassName := 'TInstanceManager';
if Windows.RegisterClass(IMWndClass) = 0 then RaiseLastWin32Error;
mutex := CreateMutex(nil, True, UniqueAppName);
if GetLastError = ERROR_ALREADY_EXISTS then
begin
mustHalt := True;
if WaitForSingleObject(mutex, 5000)=WAIT_OBJECT_0 then
begin
thisWnd := FindWindow(IMwndClass.lpszClassName, UniqueAppName);
// thisWnd := FindWindow('TMainForm', UniqueAppName);
if thisWnd = 0 then RaiseLastWin32Error;
CopyData.dwData := AppNotifyValue;
CopyData.lpData := PChar(ParamStr(1));
CopyData.cbData := Length(ParamStr(1));
mustHalt :=
(SendMessage(thisWnd,WM_COPYDATA,0,Integer(@CopyData))>0);
// beep;
end;
thisWnd := 0;
ReleaseMutex(mutex);
if mustHalt then Halt;
end
else
begin
thisWnd :=
CreateWindow(IMwndClass.lpszClassName,UniqueAppName,0,0,0,0,0,0,0,hInstance,
nil);
if thisWnd = 0 then RaiseLastWin32Error;
ReleaseMutex(mutex);
end;

finalization
if thisWnd>0 then DestroyWindow(thisWnd);

end.

[ChK]