unit1.pas

防止多个程序运行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  UniqueAppstr='I_AM_UNIQUE_APP';  

var
  MessageID:Integer;
  Wproc:TFNWndProc;
  MutHandle:Thandle;
  Form1: TForm1;

implementation

{$R *.DFM}

//新的窗口处理过程
function NewWndProc(Handle:HWND;Msg:Integer;wParam,lParam:longint):
  longint;stdcall;
begin
  Result:=0;
  if Msg=MessageID then
  begin
    //在这里您可以做其他事情，我在这里只是简单的显示一条消息
    showmessage('我已经运行了,不要再运行我!');
  end
  else
    //其他的消息则调用旧的窗口处理过程
    Result:=CallWindowProc(WProc,Handle,Msg,wParam,lParam); 
end;



procedure TForm1.FormCreate(Sender: TObject);
var
  BSMRecipients:DWORD;
begin
  BSMRecipients:=BSM_APPLICATIONS;
  //注册一个消息，并创建一个唯一的消息标识符
  MessageID:=RegisterWindowMessage(UniqueAppstr);
  //子类化窗口，消息由新的窗口处理程序处理
  WProc:=TFNWndProc(SetWindowLong(Application.Handle,GWL_WNDPROC,Longint(@NewWndProc)));

  //打开互斥对象，判断是否存在
  MutHandle:=OpenMutex(MUTEX_ALL_ACCESS,False,UniqueAppstr);

  if MutHandle=0 then   //若不存在，表明第一次运行，则创建一互斥对象
    MutHandle:=CreateMutex(nil,False,UniqueAppstr)
  else
  begin
    //若存在，表明已经有实例运行，则向广播消息给所有的顶级窗口，并退出程序
    Application.ShowMainForm:=False;
    BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,@BSMRecipients,MessageID,0,0);
    Application.Terminate();
  end;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin 
  SetWindowLong(Application.Handle,GWL_WNDPROC,Longint(WProc));
  CloseHandle(MutHandle);
end;

end.