推荐一个可以传递参数的只允许一个实例运行的控件(0分)

这是个很不错的控件，用的是Mutex原理达到互斥。原来的元件若在
运行期间修改Enabled属性，如果发现另一个实例已经在运行，会自
动关闭，没有保存文档等的机会，我把它改成不会关闭，但是会互斥
了。很早就想再改造这个控件，加上参数传递功能，一直没能抽出时
间来，今天终于完工了，在自己的程序上试了试，还行。大家共享一
下。

unit RasOneInstComp;
// version 2.0
//
// Alexander Rodigin
//
// RUSSIA 1999
//
// ras@ras.udm.ru
//
//Modified by ShengQuanhu 1999/11/24
//New Feture:
//FParam:string Can receive the ParamStr(1) from Another Instance
//FReceiveParam:TNotifyEvent; After receive the ParamStr(1), what will be done?

interface
uses
Windows, Messages, Classes, Forms, SysUtils;
//--------------------------------------------------
// The following declaration is necessary because of an error in
// the declaration of BroadcastSystemMessage() in the Windows unit
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
external 'user32.dll';

type
TrasOneInstComp = class(TComponent)
private
{ Private declarations }
FEnabled: Boolean;
FsMutex : string;
FhMutex : THandle;
FMessage: string;
FMesID : Cardinal;
FHooked : Boolean;
FText : string;
FTitle : string;
FParam : string;
FOnAnInst : TNotifyEvent;
FReceiveParam:TNotifyEvent;

ReceiveFlag:boolean;

function AppWindowHook(var M: TMessage): Boolean;
procedure BroadcastFocusMessage;
protected
{ Protected declarations }
procedure CheckAnotherInstance;
procedure LoadHook;
procedure FreeHook;
procedure Loaded;override;
function MutexExists:Boolean;
procedure SetEnabled(Value:Boolean);
procedure SetMessage(Value:string);
procedure SetMutex(Value:string);
public
{ Public declarations }
constructor Create( AOwner: TComponent ); override;
destructor Destroy;override;
published
{ Published declarations }
property Enabled:Boolean read FEnabled write SetEnabled default True;
property Message:string read FMessage write SetMessage;
property Mutex:string read FsMutex write SetMutex;
property Text:string read FText write FText;
property Title:string read FTitle write FTitle;
property Param:string read FParam;
property OnAnotherInstance: TNotifyEvent read FOnAnInst write FOnAnInst;
property OnReceiveParam: TNotifyEvent read FReceiveParam write FReceiveParam;
end;

procedure Register;
//--------------------------------------------------
implementation

type
OneInstCompError=class(Exception);
//--------------------------------------------------
constructor TrasOneInstComp.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FsMutex :=DateToStr(Date)+'-mutex';
FMessage:=DateToStr(Date)+'-message';
FEnabled := True;

ReceiveFlag := false;

end; { constructor Create }
//--------------------------------------------------
procedure TrasOneInstComp.Loaded;
begin
inherited;
FMesID:=RegisterWindowMessage(PChar(FMessage));
if(FEnabled) then CheckAnotherInstance;
end; { procedure Loaded }
//--------------------------------------------------
procedure TrasOneInstComp.CheckAnotherInstance;
begin
if FEnabled and not (csDesigning in ComponentState) then
begin
if MutexExists then //Quit application
begin
if Assigned(FOnAnInst)then
FOnAnInst(Self);
BroadcastFocusMessage;
PostQuitMessage(0);
end
else
LoadHook;
end;
end; { procedure CheckAnotherInstance }
//-------------------------------------------------
function TrasOneInstComp.MutexExists:Boolean;
begin
FhMutex:=OpenMutex(MUTEX_ALL_ACCESS,False,PChar(FsMutex));
if FhMutex=0 then //it's a first instance
Result:=False
else //it's a second instance
Result:=True;
end; { function MutexExists }
//--------------------------------------------------
procedure TrasOneInstComp.SetMutex(Value:string);
begin
if (csDesigning in ComponentState)or(csLoading in ComponentState) then
begin
if FsMutex<>Value then
begin
if(Value = '') then
FsMutex :=DateToStr(Date)+'-mutex'
else
FsMutex := Value;
end
end
else
raise OneInstCompError.Create('you can''t change Mutex property at runtime!');
end; { procedure TrasOneInstComp.SetMutex }
//--------------------------------------------------
procedure TrasOneInstComp.SetEnabled(Value:Boolean);
begin
if FEnabled<>Value then
begin
FEnabled := Value;
if not (csDesigning in ComponentState) then
begin
if Value then
LoadHook
else
FreeHook;
end;
end;
end; { procedure SetEnabled }
//-------------------------------------------------
procedure TrasOneInstComp.SetMessage(Value:string);
begin
if (csDesigning in ComponentState)or(csLoading in ComponentState) then
begin
if FMessage<>Value then
begin
if Value='' then
FMessage:=DateToStr(Date)+'-message'
else
FMessage:=Value;
end
end
else
raise OneInstCompError.Create('you can''t change Message property at runtime!');
end; { procedure SetMessage }
//-------------------------------------------------
procedure TrasOneInstComp.BroadcastFocusMessage;
var
BSMRecipients: DWORD;
i:integer;
iResult:integer;
begin
{ Don't flash main form }
Application.ShowMainForm := False;
{ Post message and inform other instance to focus itself }
BSMRecipients := BSM_APPLICATIONS;

repeat
iResult := BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, FMesID, -1, 0);
until(iResult <> -1);//start post

for i:=1 to length(ParamStr(1)) do
repeat
iResult := BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, FMesID, 1, ord(paramstr(1)));
until (iResult <> -1);

repeat
iResult := BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, FMesID, -1, 0);
until (iResult <> -1);//stop post
end; { procedure BroadcastFocusMessage }
//--------------------------------------------------
function TrasOneInstComp.AppWindowHook(var M: TMessage): Boolean;
begin
if (M.Msg=FMesID) then //our message has arrived
begin
case M.WParam of
-1:
begin
ReceiveFlag := not ReceiveFlag;
if(not ReceiveFlag) then//after receive the paramstr(1)
begin
if(Assigned(FReceiveParam)) then FReceiveParam(Self);
{ if main form is minimized, normalize it }
{ set focus to application }
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
SetForegroundWindow(Application.MainForm.Handle);
if Text <> '' then
begin
if Title='' then FTitle:=Application.Title;
Application.MessageBox(PChar(FText),PChar(FTitle),MB_OK);
end;
end
else FParam := '';//ready to receive paramstr(1)
end;
1: FParam := FParam + chr(M.LParam);//receiving paramstr(1)
end;

Result := True;
end
else //it's not our message-let app to process it
Result := False;
end; { function AppWindowHook }
//--------------------------------------------------
procedure TrasOneInstComp.LoadHook;
begin
if not FHooked then
begin
Application.HookMainWindow(AppWindowHook);
FHooked:=True;
end;

if (FhMutex = 0) or (CloseHandle(FhMutex)) then
begin
FhMutex:=OpenMutex(MUTEX_ALL_ACCESS,False,PChar(FsMutex));
if FhMutex=0 then //it's a first instance
begin
FhMutex:=CreateMutex(nil,False,PChar(FsMutex));
end;
end;
end; { procedure LoadHook }
//--------------------------------------------------
procedure TrasOneInstComp.FreeHook;
begin
if FHooked then
begin
Application.UnhookMainWindow(AppWindowHook);
FHooked:=False;
end;
if(FhMutex <> 0) and CloseHandle(FhMutex) then
FhMutex:=0;
end; { procedure FreeHook }
//-------------------------------------------------
destructor TrasOneInstComp.Destroy;
begin
FreeHook;
inherited Destroy;
end; { destructor Destroy }
//--------------------------------------------------
procedure Register;
begin
RegisterComponents('FromNetwork', [TrasOneInstComp]);
end;

end.

<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=142451" target="_blank">这里请看我的回答</a>也可以实现此功能。

呵呵，用FileMap也实现了，更方便吧。