请教：允许程序只运行一个实例，内容如下

Question

怎样允许程序只运行一个实例，看了很多都只能打开程序本身才可以，如果用文档关联程序的方式打开还是不行。记住我要的是后面那种情况

Answer 1

var
 hMutex:HWND;
begin
  hMutex:=CreateMutex(nil,false,'CYGL');//关键这个句柄，你说的那种情况应该是动态的生成句柄吧
  if WaitForSingleObject(hMutex,0)<>wait_TimeOut then
  begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  end    else  begin
  messagebox(hmutex,'程序已经存在，不能重复运行！','系统信息',$00000040);
  hmutex:=findwindow(nil,'CYGL');
  SetForeGroundWindow(hmutex);
  SetActiveWindow(hmutex);
  halt;
  end;end.

Answer 2

var
  vSnapshot: THandle;
  vProcessEntry32: TProcessEntry32;
  vExeName: string;
  vProcessWindowInfo: TProcessWindowInfo;
begin
  ///////Begin 检查是否已经开启了程序             
  vExeName := ExtractFileName(ParamStr(0));
  vSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    vProcessEntry32.dwSize := SizeOf(TProcessEntry32);
    if Process32First(vSnapshot, vProcessEntry32) then
      repeat
        if (vProcessEntry32.th32ProcessID <> GetCurrentProcessId) and
          SameText(ExtractFileName(vProcessEntry32.szExeFile), vExeName) then
        begin
          vProcessWindowInfo.rProcessID := vProcessEntry32.th32ProcessID;
          vProcessWindowInfo.rWindowClass := 'TfrmWebClient';
          vProcessWindowInfo.rWindowHandle := 0;
          EnumWindows(@EnumWindowsProc, Integer(@vProcessWindowInfo));
          if vProcessWindowInfo.rWindowHandle <> 0 then Exit;
        end;
      until not Process32Next(vSnapshot, vProcessEntry32);
  finally
    CloseHandle(vSnapshot);
  end;
  ///////End 检查是否已经开启了程序摘抄自 伴水

Answer 3

uses TlHelp32;
type
  TProcessWindowInfo = record // 进程窗体信息
    rProcessID: THandle; // [in] 进程ID
    rWindowClass: string; // [in] 窗体类名
    rWindowHandle: THandle; // [out] 窗体ID
  end;
  PProcessWindowInfo = ^TProcessWindowInfo;function EnumWindowsProc(
  hwnd: HWND; // handle to parent window
  lParam: LPARAM // application-defined value
  ): BOOL; stdcall;
var
  vProcessID: THandle;
  vBuffer: array[0..255] of Char;
begin
  Result := True;
  GetWindowThreadProcessId(hwnd, vProcessID);
  with PProcessWindowInfo(lParam)^ do
    if vProcessID = rProcessID then
    begin
      GetClassName(hwnd, vBuffer, SizeOf(vBuffer));
      if SameText(vBuffer, rWindowClass) then
      begin
        rWindowHandle := hwnd;
        Result := False;
      end;
    end;
end;少了点东西，呵呵

Answer 4

这种方法好像还不行，好像程序主程序的caption改了，就找不到了.

Answer 5

vProcessWindowInfo.rWindowClass 是你主窗口的类名

Answer 6

在工程 的dpr文件中加入：
var
  hMutex: THandle;begin
  Application.Initialize;
  hMutex := OpenMutex(SYNCHRONIZE, False, 'AAAMutex');
  if hMutex <> 0 then
  begin
    CloseHandle(hMutex);
    Application.MessageBox('系统只允许同时运行一个程序', '系统提示', MB_ICONERROR);
    Exit;
  end;
  hMutex := CreateMutex(nil, True, 'AAAMutex');
  
   Application.CreateForm(TfmMain, fmMain);
   
   
end .

Answer 7

program Project1;uses
  Windows, Forms,
  Unit1 in 'Unit1.pas' {Form1};{$R *.RES}begin
  Application.Initialize;    Application.Title:='我的测试程序';
    CreateMutex(nil,False,'我的测试程序');
    if(GetLastError()=ERROR_ALREADY_EXISTS)then exit;  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
这个肯定没有问题的,
测试环境:D7+WINSP3
楼主给分吧..........