请教如何检查程序已经在运行？

Question

我想在第二次打开程序时提示“程序已经在运行”，
具体怎么做呢？
是要查系统进程吗？

Answer 1

不用了，改一下子代码
加上
    implementation
        var hnd:THandle;
        initialization
                   hnd:=CreateMutex(nil,True,'irgendseinmaliges');
                   if GetLastError=ERROR_ALREADY_EXISTS then Halt;
       finalization
                    if hnd<>0 then CloseHandle(hnd);
end.
这个代码可以防止程序执行两次

Answer 2

var
  pe:PROCESSENTRY32;
  me:MODULEENTRY32;
  hp,hm:Thandle;
  b,b1:boolean;
begin
  hp:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
  pe.dwSize:=SizeOf(pe);
  b:=Process32First(hp,pe);
  while  b do
  begin
    hm:=CreateToolHelp32SnapShot(TH32CS_SNAPModule,pe.th32ProcessID);
    me.dwSize:=sizeof(ModuleEntry32);
    if Module32First(hm,me) then
    begin
    b1:=Module32First(hm,me);
    while  b1 do
    begin
//      if me.th32ModuleID=pe.th32ModuleID then
        listbox1.Items.Add(copy(me.szExePath,length(extractfilepath(me.szExePath))+1,length(me.szExePath)-length(extractfilepath(me.szExePath))));  //移到路径只要文件名；
      b1:=Module32Next(hm,me);
    end;
  end;
    b:=Process32Next(hp,pe);
end;这段代码可以列出当前所有在运行的EXE文件和DLL文件；
你在LISTBOX1中查找是否有你想要查找的文件（如DELPHI32.EXE），用一个循环就可搞定；
for i:=0 to listbox1.items.count-1 do
   begin
       if listbox1.items[i]='delphi32.exe' then
          begin
             存在，执行存在代码；
             break;
          end
       else
          不存在;
   end;

Answer 3

const
  CM_Restore=WM_User + $1003;
  MyAppName='YourProgramName';
var
  RvHandle: hWnd;{$R *.res}begin       
  RvHandle := FindWindow(MyAppName, NIL);
  if RvHandle>0 then
  begin
    PostMessage(RvHandle, CM_Restore, 0, 0);
    exit;
  end;再在主窗体加入下面2个函数
procedure TfMain.CreateParams(var Params: TCreateParams);
begin
  Inherited CreateParams(Params);
  Params.WinClassname := MyAppName;
end;procedure TfMain.RestoreRequest(var Message: TMessage);
begin
  if IsIconic(Application.Handle)=True then
    Application.Restore
  else
    Application.BringToFront;
end;

Answer 4

program Project1;uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}
var
    hMutex:hWnd;
begin
  Application.Initialize;
  Application.Title:='test';
  hMutex:=CreateMutex(nil,false,'test');
  if GetLastError<>Error_Already_Exists then
  begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end
  else
  begin
    Application.MessageBox('本程序只允许同时运行一个','Error');
    ReleaseMutex(hMutex);
  end;
end.

Answer 5

.......    public    aa:word;    .......    procedure TForm1.FormCreate(Sender: TObject);    begin    //搜索系统数据库看程序是否正在运行    if GlobalFindAtom('Project1') =0  then  // Project1为EXE文件名    //假如没有找到该EXE文件，就把此EXE文件名添加到系统数据库    aa := GlobalAddAtom(' Project1')    else    begin  //如果该程序已经运行，显示信息并退出程序    MessageDlg('该程序正在运行！', mtWarning, [mbOK], 0);    Halt;    end;    end;    .......    procedure TForm1.FormDestroy(Sender: TObject);    begin    { 退出程序时，从数据表中删除添加的文件名 }    GlobalDeleteAtom(aa);    end;

Answer 6

这个是最简单的阿，分给我把
var
  hMutex:THandle;begin
  hMutex := CreateMutex(nil,TRUE,'C$s Just power');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
     MessageDlg('已有一个同样的程序在运行!',mtWarning,[mbOK],0);
     CloseHandle(hMutex);
     exit;
  end;