// Der folgende
Code verhindert mehrere Instanzen eines Programms. unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure WndProc(var M: TMessage); override;
end;
var
Form1: TForm1;
MyMsg: Cardinal;
UniqueStr: string = 'DBR_Mutex'; // eindeutig pro Programm, evtl. GUID
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
MyMsg := RegisterWindowMessage(PChar(UniqueStr));
end;
procedure TForm1.WndProc(var M: TMessage);
begin
if M.Msg = MyMsg then begin
SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
SetForegroundWindow(Application.Handle);
end;
inherited;
end;
end.
//------------------ und im Projekt-Quelltext -------------------------
program Project1;
uses
Forms, Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var
h: THandle;
begin
h := CreateMutex(nil, false, PChar(UniqueStr));
if GetLastError = ERROR_ALREADY_EXISTS then begin
SendMessage(HWND_BROADCAST, RegisterWindowMessage(PChar(UniqueStr)), 0, 0);
exit;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
if h <> 0 then closehandle(h);
end.
//------------------------------------------------------- // Variante 2 program TEST;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' { Form1 } ,
Unit2 in 'Unit2.pas' { Form2 } ;
{$R *.res}
var
mh, nf: THandle;
const
UniqueStr = '*DBR Einmalig*'; // z.B.
MyCaption = 'TestProgramm'; // z.B.
begin
mh := CreateMutex(nil, false, PChar(UniqueStr));
if GetLastError = ERROR_ALREADY_EXISTS then
begin
nf := findwindow(nil, MyCaption);
{nf := getparent(nf);} // kommt auf das Programm an
if isiconic(nf) then
showwindow(nf, sw_restore);
SetForegroundWindow(nf);
exit;
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.Title := 'TEST';
Application.CreateForm(TForm1, Form1);
Form1.Caption := MyCaption;
Application.CreateForm(TForm2, Form2);
Application.Run;
if mh <> 0 then
closehandle(mh);
end.
//------------------------------------------------------- // Zusätzliche Variante program Project1;
uses
Forms, Windows, Dialogs,
Unit1 in 'Unit1.pas' {Form1};
const
atm = '{41F6DA10-2CA9-40B6-96D3-BE55F8798B04}'; // z.B.
{$R *.RES}
begin
Application.Initialize;
if GlobalFindAtom(atm) = 0 then begin
GlobalAddAtom(atm);
Application.CreateForm(TForm1, Form1);
Application.Run;
end else
ShowMessage('This application can be started only once per Windows session,'
+ ' you need to restart system to run program again.');
end.
|
Zugriffe seit 6.9.2001 auf Delphi-Ecke





