关于程序只运行一次的问题

核心提示：//从论坛上copy来，事先自己并未验证引用秋风兄的代码： application.Title := 'PerRecord'; Application.Initialize; mHandle := Windows.CreateMutex(nil, true, 'PerRecord'

//从论坛上copy来，事先自己并未验证

引用秋风兄的代码：
  application.Title := 'PerRecord';
  Application.Initialize;
  mHandle := Windows.CreateMutex(nil, true, 'PerRecord');
  if mHandle <> 0 then
  begin
　  if GetLastError = Windows.ERROR_ALREADY_EXISTS then
　  begin
　　  fHandle := FindWindow('TfrmLogin', nil);
　　  if fHandle = 0 then
　　　  fHandle := FindWindow('TfrmPer', nil);
　　  if fHandle <> 0 then
　　  begin
　　　  ShowWindow(fHandle, SW_SHOW);
　　　  SetForeGroundWindow(fHandle);
　　  end;
　　  Windows.ReleaseMutex(mHandle);
　　  Halt;
　  end;
  end;

  Application.CreateForm(TdmPer, dmPer);
  Application.CreateForm(TfrmPer, frmPer);
  Application.Run;

第二个

http://dev.csdn.net/article/20/20379.shtm 看都没有看，来不及了，有待考证

第三个

回复人： fj218(洞庭风) ( ) 信誉：103

uses这个单元即可

unit RunOne;

interface

const
  MI_QUERYWINDOWHANDLE　 = 1;
  MI_RESPONDWINDOWHANDLE = 2;

  MI_ERROR_NONE　　　　  = 0;
  MI_ERROR_FAILSUBCLASS  = 1;
  MI_ERROR_CREATINGMUTEX = 2;

// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;

implementation

uses Forms, Windows, SysUtils;

const
  UniqueAppStr = 'ShuanYuan_SoftWare';

var
  MessageId: Integer;
  WPRoc: TFNWndProc;
  MutHandle: THandle;
  MIError: Integer;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
  Longint; stdcall;
begin
  Result := 0;
  // If this is the registered message...
  if Msg = MessageID then
  begin
　  case wParam of
　　  MI_QUERYWINDOWHANDLE:
　　　  // A new instance is asking for main window handle in order
　　　  // to focus the main window, so normalize app and send back
　　　  // message with main window handle.
　　　  begin
　　　　  if IsIconic(Application.Handle) then
　　　　  begin
　　　　　  Application.MainForm.WindowState := wsNormal;
　　　　　  Application.Restore;
　　　　  end;
　　　　  PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
　　　　　  Application.MainForm.Handle);
　　　  end;
　　  MI_RESPONDWINDOWHANDLE:
　　　  // The running instance has returned its main window handle,
　　　  // so we need to focus it and go away.
　　　  begin
　　　　  SetForegroundWindow(HWND(lParam));
　　　　  Application.Terminate;
　　　  end;
　  end;
  end
  // Otherwise, pass message on to old window proc
  else
　  Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  // We subclass Application window procedure so that
  // Application.OnMessage remains available for user.
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
　  Longint(@NewWndProc)));
  // Set appropriate error flag if error condition occurred
  if WProc = nil then
　  MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
  // Create the mutex with the (hopefully) unique string
  MutHandle := CreateMutex(nil, False, UniqueAppStr);
  if MutHandle = 0 then
　  MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
  BSMRecipients: DWord;
begin
  // Prevent main form from Flashing
  Application.ShowMainForm := False;
  // Post message to try to establish a dialogue with previous instance
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
　  @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
　  Application.Handle);
end;

procedure InitInstance;
begin
  SubClassApplication;　 // hook application message loop
  MutHandle := OpenMutex(MUTEX_ALL_access, False, UniqueAppStr);
  if MutHandle = 0 then
　  // Mutex object has not yet been created, meaning that no previous
　  // instance has been created.
　  DoFirstInstance
  else
　  BroadcastFocusMessage;
end;

initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  // Restore old application window procedure
  if WProc <> Nil then
　  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
  if MutHandle <> 0 then CloseHandle(MutHandle);  // Free mutex
end.

第四个

据说这个简单明了，有待我来考证

回复人： fei19790920(饭桶的马甲（抵制日货）) ( ) 信誉：103

得分: 0

program Project1;

uses
  Forms,windows,
  Unit1 in 'Unit1.pas' {Form1};

var hw:hwnd;

{$R *.RES}
begin
  Application.Initialize;
  application.title:='test';//名字自己定义
  CreateMutex(nil, false, 'ADManager');
  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
　  Application.CreateForm(TForm1, Form1);
　  Application.Run;
  end;
end.

第五个

好像和上一个类似，但是感觉严谨，学习一下

回复人： zdq801104(我很笨，但是我不傻！) ( ) 信誉：90

看看这个吧，编译已经通过了
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
　  { Private declarations }
  public
　  { Public declarations }
  end;

var
  Form1: TForm1;
  //保存Mutex句柄
  mHandle:THandle;
  PreviousInstanceWindow:HWnd;
  Project:String;
  AppName:String;
implementation

{$R *.dfm}
initialization
  //定义自己的项目名称，作为要创建的互斥区名，最好有自己的特点以防止重复
  Project:='RunOnlyOnce_MyProject';
  //将lpMutexAttributes设为nil,bInitialOwner设为True(即本程序拥有该互斥区)
  mHandle:=CreateMutex(nil,True,PChar(Project));
  if GetLastError=ERROR_ALREADY_EXISTS then
　 //该互斥区已存在则表明已有本程序的另一个实例在运行
　  begin
　　  ShowMessage('已经有该程序在运行');
　　  //保存程序标题
　　  AppName:=Application.Title;
　　  //不显示本窗口
　　  Application.ShowMainForm:=False;
　　  //改变程序标题，以使函数FindWindow找到的是前一个实例窗口
　　  Application.Title:='destroy me';
　　  //寻找前一个实例窗口句柄
　　  PreviousInstanceWindow:=FindWindow(nil,PChar(AppName));
　　  //已经找到
　　  if PreviousInstanceWindow<>0 then
　　  //如果该窗口最小化则恢复
　　　　 if IsIconic(PreviousInstanceWindow) then
　　　　　 ShowWindow(PreviousInstanceWindow,SW_RESTORE)
　　　  else
　　　  //如果程序在后台则将其放到前台
　　　　 SetForegroundWindow(PreviousInstanceWindow);
　　　　 //中止本实例
　　　  Application.Terminate;
　　  end;
　  finalization
　  //该互斥区对象仍存在则关闭对象
　　  if mHandle<>0 then
　　　  CloseHandle(mHandle);
end.

以上都是delphi版的，我爱delphi，可是我却没有办法用，项目都是vb的。讨厌vb却没有办法

下面这个是vb的，绝对好用，不是我写的，转自谁，也找不到了，谢谢那天帮助我的兄台！！

模块里面

Option Explicit

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

Public Const WM_CONTEXTMENU = &H7B ''菜单弹出

''在有一个实例运行的情况下把该实例拉到前台，不允许运行两个实例
Public Function ForceForegroundWindow(ByVal hWnd As Long) As Boolean
　 Dim ThreadID1 As Long
　 Dim ThreadID2 As Long
　 Dim nRet As Long

　 If hWnd = GetForegroundWindow() Then
　　  ForceForegroundWindow = True
　 Else
　　  ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
　　  ThreadID2 = GetWindowThreadProcessId(hWnd, ByVal 0&)
　　  If ThreadID1 <> ThreadID2 Then
　　　　 Call AttachThreadInput(ThreadID1, ThreadID2, True)
　　　　 nRet = SetForegroundWindow(hWnd)
　　　　 Call AttachThreadInput(ThreadID1, ThreadID2, False)
　　  Else
　　　　 nRet = SetForegroundWindow(hWnd)
　　  End If
　　  If IsIconic(hWnd) Then
　　　　 Call ShowWindow(hWnd, SW_RESTORE)
　　  Else
　　　　 Call ShowWindow(hWnd, SW_SHOW)
　　  End If
　　  ForceForegroundWindow = CBool(nRet)
　 End If
End Function

sub main或者是主窗体，这里用的是sub main主窗体相应调整

If App.PrevInstance = True Then

　  Dim lngPreHandle As Long
　 
　  lngPreHandle = FindWindow(vbNullString, "欢迎登录上海时代航运MIS！") ''找登陆窗口，找到就是把登陆拉最前面
　 
　  If CBool(lngPreHandle) Then
　　　 
　　　  ForceForegroundWindow lngPreHandle
　　　　　 
　　　  End
　　　　　 
　  End If

　  lngPreHandle = FindWindow(vbNullString, "时代航运管理信息系统") ''找不到登陆窗口，就找主窗口，把主窗口拉前面
　 
　  If CBool(lngPreHandle) Then
　　　 
　　　  ForceForegroundWindow lngPreHandle
　　　　　 
　　　  End
　　　　　 
　  End If
　 
　  End ''本来不可能存在既没有登陆窗口又没有主窗口的情况，但是为了以防万一，还是再这里多一个end
　 
End If

vb的这个不严谨，通过findwindow的名字都不严谨，只是我的窗口名字还算牛，一般不会重复，有时间要多研究delphi的，找一个严谨的方法。