Lazaurs相同程序实现互斥的方法

猫工

原本用以下方式在Delphi下实现过：

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   CreateMutex(nil, false, '生产线管理系统'); //建立互斥对象
4.   if GetLastError = ERROR_ALREADY_EXISTS then //说明已经有此实例，已经运行
5.   begin
6.     messagebox(0, '该程序已经有一个在运行中！', '警告', 0); //提示程序已运行
7.     halt; //退出
8.   end;
9. end;

复制代码

用上面的方式在Lazaurs下不能实现，所以就找到一个新的办法，现经过测试，有效！
方法共享如下：

1. program project1;
3. {$mode objfpc}{$H+}
5. uses
6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
7.   cthreads,
8.   {$ENDIF}{$ENDIF}
9.   Interfaces, // this includes the LCL widgetset
10.   Forms, Unit1,
11.   windows
12.   { you can add units after this };
14. {$R *.res}
16. var
17.   WindowHandler : THandle;
19. begin
20.   WindowHandler := FindWindow(nil, 'project1');
21.   if WindowHandler > 0 then begin
22.     SetForegroundWindow(WindowHandler);
23.     Halt;
24.   end;
26.   RequireDerivedFormResource := True;
27.   Application.Initialize;
28.   Application.CreateForm(TForm1, Form1);
29.   Application.Run;
30. end.

复制代码

如果你有更好的办法，欢迎交流！

猫工

以下方式在Lazarus下也可以实现互斥：

1. program project1;
3. {$mode objfpc}{$H+}
5. uses
6.   {$IFDEF UNIX}{$IFDEF UseCThreads}
7.   cthreads,
8.   {$ENDIF}{$ENDIF}
9.   Interfaces, // this includes the LCL widgetset
10.   Forms, Unit1,
11.   windows
12.   { you can add units after this };
14. {$R *.res}
16. const
17.   MemFileSize = 1024;
18.   MemFileName = 'one_inst_TST';
19. var
20.   MemHnd, MainFormHnd : HWND; // DWord;
21.   FFileView: Pointer;
22. begin
23.   MemHnd := CreateFileMapping(HWND($FFFFFFFF),nil, PAGE_READWRITE, 0, MemFileSize, MemFileName);
24.   if GetLastError<>ERROR_ALREADY_EXISTS then begin
25.     FFileView:=nil;
26.     Application.Initialize;
27.     Application.CreateForm(TForm1, Form1);
28.     MainFormHnd:= Form1.Handle;
29.     // 写MainForm的处理文件
30.     FFileView := MapViewOfFile(MemHnd,FILE_MAP_ALL_ACCESS,0,0,0);
31.     if FFileView <> nil then begin
32.       CopyMemory( FFileView, @MainFormHnd, 4);
33.       UnmapViewOfFile(FFileView);
34.     end;
35.     Application.CreateForm(TForm1, Form1);
36.     Application.Run;
37.   end
38.   else begin
39.     // 从以前的实例中创建的文件阅读MainForm的句柄
40.     FFileView := MapViewOfFile(MemHnd,FILE_MAP_READ,0,0,0);
41.     CopyMemory( @MainFormHnd, FFileView, 4);
42.     SetForegroundWindow(MainFormHnd); // 激活以前
43.   end;
44.   CloseHandle(MemHnd);
45. end.

复制代码

猫工

保证一个程序一个实例，相同程序互斥的组件：
http://wiki.lazarus.freepascal.org/UniqueInstance
Easy of use: just drop a component in the main form
UniqueInstance provides an easy way to force only one instance per application running at same time.

artpaper123

创建一个文件，每次启动判断一下，
有就不开新进程，
没有就干。

逍遥派掌门人

下面是我在Lazarus里用的代码：

1. program project1;
4. {$mode objfpc}{$H+}
6. uses
7.   {$IFDEF UNIX}{$IFDEF UseCThreads}
8.   cthreads,
9.   {$ENDIF}{$ENDIF}
10.   Interfaces, // this includes the LCL widgetset
11.   Forms, Unit1, LResources, windows;
14. {$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
16. var
17.     hw : HWND;
18.     gt : Integer;
20. begin
21.   {$I project1.lrs}
22.   Application.Title:='www.fpccn.com';
23.   Application.Initialize;
26.   hw := CreateMutex(nil,False,'www.fpccn.com'); {创建互斥体对象}
27.   gt := GetLastError;
30.   if gt <> Error_ALREADY_EXISTS then                    {如果没有发现互斥体对象}
31.   begin
32.     Application.CreateForm(TForm1, Form1);
33.     Application.Run;
34.   end
35.   else begin
36.          Application.Terminate;
37.          ReleaseMutex(hw);                                        {释放互斥体}
38.        end;
39. end.   

复制代码

wzwcn

最好能写出没有依赖平台的代码，上面的都依赖windows了

猫工

linux wince都可以

young0401

保证一个程序一个实例，相同程序互斥的组件：
http://wiki.lazarus.freepascal.org/UniqueInstance
Easy of use: just drop a component in the main form
UniqueInstance provides an easy way to force only one instance per application running at same time.


赞一个,这个好.好强