要实现这个功能：运行程序时，现在判断这个程序是否已经运行，是：就显示那个程序的窗口为当前窗口，没有就继续运行。

Question

要实现这个功能：运行程序时，现在判断这个程序是否已经运行，是：就显示那个程序的窗口为当前窗口，没有就继续运行。就是让程序只运行一次。最好给出代码。

Answer 1

var
  hMutex : Thandle;
  WaitResult : word;
  BroadcastList : DWORD;
begin
     MessageID := RegisterWindowMessage('Check For Choice Previous Inst');
// register a message to use later on
     hMutex := createMutex(nil,false,pchar('App_Choice')); // grab a mutex
handle
     WaitResult := WaitForSingleObject(hMutex,10); // wait to see
if we can have exclusive use of the mutex
     if ( waitResult = WAIT_TIMEOUT ) then // if we can't then broadcast
the message to make the owner of the mutex respond     { request that the running application takes focus }
       begin
          BroadcastList := BSM_APPLICATIONS;
          BroadcastSystemMessage(
BSF_POSTMESSAGE,@BroadcastList,MessageID,0,0); //32 bit - broadcast the
message to all apps - only a prev inst will hear it.
       end
     else
      begin
      { do the normal stuff}
      Application.Title := 'Choice Organics Purchase & Sales System';
      Application.CreateForm(TMainForm, MainForm);
      Application.Run;
      ReleaseMutex(hMutex); // release the mutex as a politeness      end;
      CloseHandle(hMutex); // close the mutex handle
end.This goes in the MainFormprocedure Tmainform.OnAppMessage(var Msg : TMsg ; Var Handled : Boolean);
begin
{ If it's the special message then focus on this window}
if Msg.Message = MessageID then // if we get the broadcast message from an
another instance of this app that is trying to start up
   begin
      show;
      WindowState := wsMaximized;
      BringToFront;
      SetFocus;
      Handled := true;   end;
end;//And this goes in the TMainForm.FormCreate ;-Application.OnMessage:= OnAppMessage;

Answer 2

在工程文件里：
var
    hMutex: HWND;
    Ret: Integer;
                
{$R *.res}begin
    Application.Initialize;
    Application.Title := 'XXXX';
  {hMutex:=CreateMutex(nil,False,'XXXX');
  Ret:=GetLastError;
  If Ret=ERROR_ALREADY_EXISTS Then
    ReleaseMutex(hMutex)
  else
  begin 
    Application.CreateForm(TMainForm, MainForm);
  Application.Run;
  end;
end.

Answer 3

加上上面的代码，有这个错误，而且以后不能打开工程文件。
     Error in module XXX:Call to Application createForm is Missing or Incorrect.
什么原因？

Answer 4

program Project1;uses
  Forms,
  Windows,
  Messages,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas';{$R *.res}var
  hMutex : Thandle;
  WaitResult : word;
  BroadcastList : DWORD;begin    MessageID := RegisterWindowMessage('Check For Choice Previous Inst');
    // register a message to use later on
     hMutex := createMutex(nil,false,pchar('App_Choice'));
    // grab a mutex  handle
     WaitResult := WaitForSingleObject(hMutex,10); // wait to see if we can have exclusive use of the mutex
     if ( waitResult = WAIT_TIMEOUT ) then
     // if we can't then broadcast  the message to make the owner of the mutex respond     { request that the running application takes focus }
       begin
          BroadcastList := BSM_APPLICATIONS;
          BroadcastSystemMessage(
BSF_POSTMESSAGE,@BroadcastList,MessageID,0,0);
//32 bit - broadcast the message to all apps - only a prev inst will hear it.
       end
     else
      begin
      { do the normal stuff}
      Application.Title := 'Choice Organics Purchase & Sales System';
      Application.CreateForm(TForm1, Form1);
  Application.Run;
      ReleaseMutex(hMutex);
       // release the mutex as a politeness      end;
      CloseHandle(hMutex);
       // close the mutex handle
end.

Answer 5

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.

Answer 6

加上上面的代码，有这个错误，而且以后不能打开工程文件。
     Error in module XXX:Call to Application createForm is Missing or Incorrect.
能不能说说这个错误的原因？应该怎样清除这个错误。谢谢！
分不是问题！！！！！！！！

Answer 7

1。在程序启动的时候重载
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WinClassName := APPNAME;
end;
设置应用程序的WinClassName
2。在工程文件中
  RvHandle := FindWindow(APPNAME, nil);
  if RvHandle > 0 then
  begin
    PostMessage(RvHandle, CM_RESTORE, 0, 0);
    Exit;
  end;
3。设置主窗体的CM_RESTORE事件，将窗体显示到最顶层就OK

Answer 8

program Project1;uses
  Forms,
  windows,
  SysUtils,
  Dialogs,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}var
  hMutex:HWND;
  Error:integer;begin
  Application.Initialize;
  hMutex:=CreateMutex(nil,False,'Only One Instance');
  Error:=GetLastError;
  if Error<>ERROR_ALREADY_EXISTS Then
  begin
    Application.CreateForm(TForm1, Form1);
  Application.Run;
  end
  else
  begin
    MessageDlg('已经有一个程序的实例在运行！',mtInformation,[mbOK],0);
    ReleaseMutex(hMutex);
  end;
end.

Answer 9

首先在工程文件里定义
const
CM_RESTORE = WM_USER + $1000; //自定义消息
MyAppName ='方舟客户管理系统';  
var
RvHandle : hWnd;     //主窗口句柄
begin   // 避免程序二次运行
 RvHandle := FindWindow(MyAppName,nil);
  if RvHandle > 0 then
   begin
        SendMessage(RvHandle,CM_RESTORE,0,0); //发送自定义消息
        Application.MessageBox('客户管理系统已经运行！',
                               '感谢你的使用',
                               MB_OK);
       Halt;
   end;
  Application.Initialize;  ...
end.然后在主窗口的Pas文件里自定义一条和工程文件里一样的消息（注意保持一致）：
const
        CM_RESTORE = WM_USER + $1000;    //自定义消息
        MyAppName = '方舟客户管理系统';
声明：
  private
    procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;implementation:procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WinClassName := MyAppName;
end;procedure TMainForm.RestoreRequest(var message: TMessage); 
begin
if IsIconic(Application.Handle) then   //判断程序是否最小化
   Application.Restore    //如果是则恢复窗体
else
   Application.BringToFront; //否则移至屏幕最前端
end;

Answer 10

program MP3Player;uses
  Forms,
  Windows,
  mp3 in 'mp3.pas' {Form1};
  var
    Hwnd : THandle;
{$R *.res}{begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.}begin
  Hwnd:=FindWindow('TForm1','MP3Player'); //查找是否已有窗体MainForm
  if Hwnd<>0 then
    begin
      SetForegroundWindow(Hwnd); //激活已運行的程序實例
      Application.Terminate; //中止本次實例
    end
  else
    begin
      Application.Initialize;
      Application.CreateForm(TForm1, Form1);
      Application.Run;//執行本次實例
    end;
end.

Answer 11

加上上面的代码，都要出现有这个错误，而且以后不能打开工程文件。而且RUN选项不能使用。      Error in module XXX:Call to Application createForm is Missing or Incorrect.
能不能说说这个错误的原因？应该怎样清除这个错误。谢谢！
分不是问题！！！！！！！！

Answer 12

program Project1;uses
  Forms,
  windows,
  Unit1 in 'Unit1.pas' {Fmmain},
  login in 'login.pas' {Fmlogin},
  fm in 'fm.pas' {Formfm};{$R *.res}
begin
  CreateMutex(nil, True, 'appone');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    MessageBox(0, '汽配管理管理系统已经运行了', '错误！' ,MB_ICONERROR);
    Halt;
  end;
begin
  Application.Initialize;
  application.Title:='欢迎使用汽配管理系统';
  formfm:=tformfm.Create(application);
  formfm.Show;
  formfm.Update;
  while formfm.Timer1.Enabled do
  application.ProcessMessages;
  formfm.Hide;
  formfm.Free;
  application.Title:='用户登陆';
  fmlogin:=tfmlogin.Create(application);
  fmlogin.ShowModal;
  if fmlogin.Edit1.Text='' then
     application.Terminate
     else
  begin
  Application.Title := '汽配管理系统';
  Application.CreateForm(TFmmain, Fmmain);
  Application.Run;
  end;
  end;
end.
这个应该比较简单。