一个根据运行目录保证程序只执行一次，并且可以传递参数的类(0分)

下面是我改写过的一个类，增加了参数传递以及按目录控制功能。
我用下来还是不错的，所以拿出来共享一下。文件名：justone.pas。
唯一的限制是，参数不能动态分配空间。只能用MaxParamCount限制。
如果谁有更好的办法，可要通知我哦。

用法：
begin
JustOneApplication := TJustOneApplication.Create;
JustOneApplication.Enabled := true;
if JustOneApplication.CheckAnotherInstance then
begin
Application.Terminate;
JustOneApplication.Free;
exit;
end;

Application.Initialize;

Application.CreateForm(TMainForm, MainForm);
JustOneApplication.OnReceiveParam := MainForm.ReceiveParam;

if ParamCount > 0 then
begin
//参数处理
end;

Application.Run;
JustOneApplication.Free;
end.


main.pas中接受参数函数：
procedure TMainFOrm.ReceiveParam;
var
i:integer;
begin
if JustOneApplication.Params.Count > 0 then
for i := 0 to JustOneApplication.Params.Count do
...
end;



JustOne文件：

unit JustOne;

interface
uses
Windows, Messages, Classes, Forms, SysUtils;

Type TProcedure = Procedure of object;
//--------------------------------------------------
// 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';

const
MaxParamCount = 10;

type
TParamValue = record
tpv_count:integer;
tpv_param:string[255];
end;

TJustOneApplication = class
private
{ Private declarations }
FEnabled: Boolean;
FsMutex : string;
FhMutex : THandle;
FMessage: string;
FMesID : Cardinal;
FHooked : Boolean;
FText : string;
FTitle : string;
FParams : TStringList;

FOnAnInst : TNotifyEvent;
FReceiveParam:TProcedure;

FMapping:THandle;

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

//--------------------------------------------------
var
JustOneApplication:TJustOneApplication;

implementation

type
OneInstCompError=class(Exception);
//--------------------------------------------------
constructor TJustOneApplication.Create;
begin
FsMutex :=Application.ExeName+'-mutex';
FMessage:=Application.ExeName+'-message';

FsMutex := Lowercase(StringReplace(FsMutex,'/','-',[rfReplaceAll]));
FMessage := LowerCase(StringReplace(FMessage,'/','-',[rfReplaceAll]));

FEnabled := True;
FParams := TStringList.Create;

ResetValues;
end; { constructor Create }

//--------------------------------------------------
procedure TJustOneApplication.ResetValues;
begin
FMesID:=RegisterWindowMessage(PChar(FMessage));
FMapping:=CreateFileMapping(0,nil,PAGE_READWRITE,0,MaxParamCount * sizeof(TParamValue),PChar(FsMutex + FMessage));
end;
//--------------------------------------------------
procedure TJustOneApplication.SetMutex(Value:string);
begin
if (FsMutex <> Value) then
begin
FsMutex := Value;
ResetValues;
end;
end;

procedure TJustOneApplication.SetMessage(Value:string);
begin
if (FMessage <> Value) then
begin
FMessage := Value;
ResetValues;
end;
end;

function TJustOneApplication.CheckAnotherInstance:boolean;
begin
if FEnabled then
begin
if MutexExists then //Quit application
begin
if Assigned(FOnAnInst) then FOnAnInst(Self);
FreeHook;// Should first free hook then post message
BroadcastFocusMessage;
Application.Terminate;
Result := true;
exit;
end
else
LoadHook;
end;
Result := false;
end; { procedure CheckAnotherInstance }
//-------------------------------------------------
function TJustOneApplication.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 TJustOneApplication.SetEnabled(Value:Boolean);
begin
if FEnabled<>Value then
begin
FEnabled := Value;
if Value then
LoadHook
else
FreeHook;
end;
end; { procedure SetEnabled }
//-------------------------------------------------
procedure TJustOneApplication.BroadcastFocusMessage;
var
data,d:^TParamValue;
iCount:integer;
i,iResult:integer;
BSMRecipients :integer;
begin
{ Don't flash main form }
Application.ShowMainForm := False;

{transfer parameters to another instance. Add by ShengQuanhu}
if FMapping <> 0 then
begin
data:=MapViewOfFile(FMapping,FILE_MAP_WRITE,0,0,0);

d:=data;
if ParamCount > MaxParamCount then iCount := MaxParamCount
else iCount := ParamCount;
for i:= 1 to iCount do
begin
d^.tpv_Count := iCount;
d^.tpv_Param := ParamStr(i);
inc(d);
end;

UnmapviewofFile(data);
end;

{ Post message and inform other instance to focus itself }
BSMRecipients := BSM_APPLICATIONS;
repeat
iResult := BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, FMesID, 0, 0);
until(iResult <> -1);
end; { procedure BroadcastFocusMessage }
//--------------------------------------------------
function TJustOneApplication.AppWindowHook(var M: TMessage): Boolean;
var
hMap:THandle;
data,d:^TParamValue;
i:integer;
iCount:integer;
begin
if (M.Msg=FMesID) then //our message has arrived
begin
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
Application.BringToFront;
if Text <> '' then
begin
if Title='' then FTitle:=Application.Title;
Application.MessageBox(PChar(FText),PChar(FTitle),MB_OK);
end;

{retrieve parameters transfered from another instance, Add by ShengQuanhu}
hMap:=OpenFileMapping(FILE_MAP_WRITE,false,PChar(FsMutex + FMessage));
if hMap=0 then
begin
result := true;
exit;
end;

data:=Mapviewoffile(hMap,FILE_MAP_WRITE,0,0,0);

FParams.Clear;

d:=data;
iCount := d^.tpv_Count;
d^.tpv_Count := 0;//相当于清空FileMapping
if(iCount > MaxParamCount) then iCount := MaxParamCount;
for i:= 1 to iCount do
begin
FParams.Add(d^.tpv_param);
inc(d);
end;

if(Assigned(FReceiveParam)) then FReceiveParam;
{ if main form is minimized, normalize it }
{ set focus to application }

UnmapViewOfFile(data);
Result := True;
end
else //it's not our message-let app to process it
Result := False;
end; { function AppWindowHook }
//--------------------------------------------------
procedure TJustOneApplication.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 TJustOneApplication.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 TJustOneApplication.Destroy;
begin
FParams.Free;
FreeHook;
end; { destructor Destroy }
//--------------------------------------------------

end.

你的程序是干什么用的?最好能给个程序注释

这个类是用来保证你的程序只运行一次，并且可以在第二次运行的时候把参数
传递给已经运行的程序，同时激活第一次运行的程序。

同时，这个类使用的是根据程序运行目录和程序名合成Mutex ，这样，在不同
目录下的同一个程序，可以同时运行。（跟一般的FindWindow不同的地方）。

附加功能 将问题提前

接受答案了.

不错的东西，惠人不浅啊

DreamTiger 先生：
我用的代码是来自上面，可参数 总是 空，为什么呀？

procedure TFormMain.ReceiveParam;
var
i: integer;
a: string;
begin
if JustOneApplication.Params.Count > 0 then
begin
for i := 1 to JustOneApplication.Params.Count do
begin
a := paramstr(i);
if a <> '' then
begin
ListBox2.Items.Add(paramstr(i));
ListBox1.Items.Add(ExtractFileName(paramstr(i)));
end;
end;
end
end;

改成下面这样就好了，谢谢！

procedure TFormMain.ReceiveParam;
var
i: integer;
a: string;
begin
if JustOneApplication.Params.Count > 0 then
begin
for i := 0 to JustOneApplication.Params.Count-1 do
begin
a := JustOneApplication.Params;
if a <> '' then
begin
ListBox2.Items.Add(JustOneApplication.Params);
ListBox1.Items.Add(ExtractFileName(JustOneApplication.Params));
end;
end;
end
end;