delphi 防止程序双开 更好的 Best!

代码

unit  wdRunOnce;   
  
{ *******************************************  
 * brief: 让程序只运行一次  
 * autor: linzhenqun  
 * date: 2005-12-28  
 * email: [email protected]  
 * blog: http://blog.csdn.net/linzhengqun  
******************************************** }   
  
interface   
  
(*  程序是否已经运行，如果运行则激活它  *)   
function  AppHasRun(AppHandle: THandle): Boolean;   
  
  
implementation   
uses   
  Windows, Messages;   
  
const   
  MapFileName  =   ' {CAF49BBB-AF40-4FDE-8757-51D5AEB5BBBF} ' ;   
  
type   
   // 共享内存   
  PShareMem  =  ^TShareMem;   
  TShareMem  =   record   
    AppHandle: THandle;   // 保存程序的句柄   
   end ;   
  
var   
  hMapFile: THandle;   
  PSMem: PShareMem;   
  
procedure  CreateMapFile;   
begin   
  hMapFile : =  OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));   
   if  hMapFile  =   0   then   
   begin   
    hMapFile : =  CreateFileMapping($FFFFFFFF,  nil , PAGE_READWRITE,  0 ,   
      SizeOf(TShareMem), MapFileName);   
    PSMem : =  MapViewOfFile(hMapFile, FILE_MAP_WRITE  or  FILE_MAP_READ,  0 ,  0 ,  0 );   
     if  PSMem  =   nil   then   
     begin   
      CloseHandle(hMapFile);   
      Exit;   
     end ;   
    PSMem^.AppHandle : =   0 ;   
   end   
   else   begin   
    PSMem : =  MapViewOfFile(hMapFile, FILE_MAP_WRITE  or  FILE_MAP_READ,  0 ,  0 ,  0 );   
     if  PSMem  =   nil   then   
     begin   
      CloseHandle(hMapFile);   
     end   
   end ;   
end ;   
  
procedure  FreeMapFile;   
begin   
  UnMapViewOfFile(PSMem);   
  CloseHandle(hMapFile);   
end ;   
  
function  AppHasRun(AppHandle: THandle): Boolean;   
var   
  TopWindow: HWnd;   
begin   
  Result : =  False;   
   if  PSMem  <>   nil   then   
   begin   
     if  PSMem^.AppHandle  <>   0   then   
     begin   
      SendMessage(PSMem^.AppHandle, WM_SYSCOMMAND, SC_RESTORE,  0 );   
      TopWindow : =  GetLastActivePopup(PSMem^.AppHandle);   
       if  (TopWindow  <>   0 )  and  (TopWindow  <>  PSMem^.AppHandle)  and   
        IsWindowVisible(TopWindow)  and  IsWindowEnabled(TopWindow)  then   
        SetForegroundWindow(TopWindow);   
      Result : =  True;   
     end   
     else   
      PSMem^.AppHandle : =  AppHandle;   
   end ;   
end ;   
  
initialization   
  CreateMapFile;   
  
finalization   
  FreeMapFile;   
  
end .  

 

接下去就稍有点小麻烦了 把上面的代码保存成单元文件 比如 wdRunOnce.pas

然后加到项目文件里面如下

代码

program  AccessCH;   
  
uses   
  Forms,   
  Unit1  in   ' Unit1.pas '   { Form1 }  ,   
  wdRunOnce  in   ' wdRunOnce.pas ' ;      // 在这里不要忘记加单元文件   
  
{ $R *.res }   
  
begin   
  Application.Initialize;   
if   not  AppHasRun(Application.Handle)  then    // 这里不要忘记给个传入句柄判定是否创建窗体   
  Application.CreateForm(TForm1, Form1);   
  Application.Run;   
end .  

 

 

转载于:https://www.cnblogs.com/rogee/archive/2010/09/20/1832014.html