//工程引用此单元就能防止同时出现多个实例
unit MultInst;
interface
uses Windows ,Messages, SysUtils, Classes, Forms;
implementation
const
  STR_UNIQUE    = '{2BE6D96E-827F-4BF9-B33E-8740412CDE96}';
  MI_ACTIVEAPP  = 1;  {激活应用程序}
  MI_GETHANDLE  = 2;  {取得句柄}
var
  iMessageID    : Integer;
  OldWProc      : TFNWndProc;
  MutHandle     : THandle;
  BSMRecipients : DWORD;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := 0;
  if Msg = iMessageID then
  begin
    case wParam of
      MI_ACTIVEAPP: {激活应用程序}
        if lParam<>0 then
        begin
          {收到消息的激活前一个实例}
          {为什么要在另一个程序中激活?}
          {因为在同一个进程中SetForegroundWindow并不能把窗体提到最前}
          if IsIconic(lParam) then
            OpenIcon(lParam)
          else
            SetForegroundWindow(lParam);
          Application.Terminate; {终止本实例}
        end;
      MI_GETHANDLE: {取得程序句柄}
        begin
          PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP, Application.Handle);
        end;
    end;
  end
  else
    Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;
procedure InitInstance;
begin
  {取代应用程序的消息处理}
  OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
  {打开互斥对象}
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE);
  if MutHandle = 0 then
  begin
    {建立互斥对象}
    MutHandle := CreateMutex(nil, False, STR_UNIQUE);
  end
  else
  begin
    Application.ShowMainForm  :=  False;
    {已经有程序实例,广播消息取得实例句柄}
    BSMRecipients := BSM_APPLICATIONS;
    BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);
  end;
end;
initialization
  {注册消息}
  iMessageID  := RegisterWindowMessage(STR_UNIQUE);
  InitInstance;
finalization
  {还原消息处理过程}
  if OldWProc <> Nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));
  {关闭互斥对象}
  if MutHandle <> 0 then
    CloseHandle(MutHandle);
end.

Delphi单元文件之-防止程序重复执行的更多相关文章

  1. Delphi单元文件引用名称问题

    Delphi新版本的单元文件格式变化了,如windows变成了winapi.windows,如果想在单元引用中使用简称,则需要在工程选项中配置: 这样就可以使用全名或简写来引用单元了.

  2. Delphi单元文件之-简体繁体互转

    Function GBCht2Chs(GBStr: String): AnsiString; {GBK繁体转简体} Var   len:integer;   pGBCHTChar: PChar;   ...

  3. delphi基础篇之单元文件

    Delphi单元文件 unit MainFrm; {库单元文件头} interface        {接口部分由Interface开始implementation结束.声明引用的单元,常量,数据类型 ...

  4. Delphi窗体创建释放过程及单元文件小结(转)

    Delphi窗体创建释放过程及单元文件小结 Delphi中的窗体,有模式窗体与非模式窗体两种.两种窗体的调用方式不同,模式窗体使用ShowModal显示,非模式窗体使用Show显示.当显示模式窗体的时 ...

  5. Delphi项目构成之单元文件PAS

    单元文件是Pascal源文件,扩展名为.pas. 有三种类型的单元文件: 窗体/数据模块和框架的单元文件(form/data module and frame units),一般由Delphi自动生成 ...

  6. Delphi 如何在程序中执行动态生成的Delphi代码

    如何在程序中执行动态生成的Delphi代码 经常发现有人提这类问题,或者提问内容最后归结成这种问题 前些阵子有位高手写了一个“执行动态生成的代码”,这是真正的高手,我没那种功力,我只会投机取巧. 这里 ...

  7. 如何在程序中执行动态生成的Delphi代码

    如何在程序中执行动态生成的Delphi代码 经常发现有人提这类问题,或者提问内容最后归结成这种问题 前些阵子有位高手写了一个“执行动态生成的代码”,这是真正的高手,我没那种功力,我只会投机取巧. 这里 ...

  8. Linux shell编程02 shell程序的执行 及文件权限

    第一个shell脚本 1.       shell编程的方式 交互式shell编程 非交互式shell编程:执行的语句存放到一个文件 shell脚本:可以任意文件名,建议扩展名为sh 2.       ...

  9. 在WINDOWS任务计划程序下执行PHP文件 PHP定时功能的实现

    最近需要做一个定时任务功能,从网站找了很多相关的代码,windows实现方法综合起来大概就两种, 一.使用PHP ignore_user_abort 函数 即使关掉浏览器也能正常运行:(个人感觉PHP ...

随机推荐

  1. QT输入输出(一) 之 QDataStream 测试

    QT提供了两个高级别的流类---QDataStream和QTextStream,可以从任意的输入输出设备读取或写入数据. QDataStream用于读写二进制数据,它的优点是:在读写数据的时候已经严格 ...

  2. DOM-判断元素节点类型

    http://stackoverflow.com/questions/384286/javascript-isdom-how-do-you-check-if-a-javascript-object-i ...

  3. UDP套接口编程

    常用的UDP实现的程序:DNS域名系统,NFS网络文件系统,SNMP简单网络管理协议 ssize_t recvfrom(int sockfd,void *buff,size_t nbytes,int ...

  4. plsql配置连接远程数据库

    一.首先安装PL/SQL Developer 下载地址:https://yunpan.cn/cM3njKpfK8MnT 访问密码 996a 二.再安装instantclient_11_2 下载地址:h ...

  5. iOS 本地企业发布流程

    今天和后台弄了一下本地企业ipa发布, 准备工具:要发布的ipa文件一个,一个plist plist文件格式内容: <?xml version="1.0" encoding= ...

  6. Linux系统编程——进程间通信:命名管道(FIFO)

    命名管道的概述 无名管道,因为没有名字,仅仅能用于亲缘关系的进程间通信(很多其它详情.请看<无名管道>).为了克服这个缺点.提出了命名管道(FIFO).也叫有名管道.FIFO 文件. 命名 ...

  7. 10分钟学会基于ASP.NET的 JQuery实例 (转)

    本文介绍如何在ASP.NET(ASP.NET/AJAX)里使用基于JQuery的AJAX技术.(源代码下载见最后) 在使用JQuery前,请到www.jquery.com下载最新版本的js代码,然后再 ...

  8. 【摘要】获得HTML元素的绝对位置

    function findAbsolutePosition(obj) { var curleft = curtop = 0; if (obj.offsetParent) { do { curleft ...

  9. ORACLE AUTOMATIC STORAGE MANAGEMENT翻译-第二章ASM Instance(4)完

    ASM安全 这个小节主要描写叙述与ASM相关的各种安全配置话题,像 配置ASM须要的userids.groupids:ASM权限如 SYSOPER,SYSDBA和新的SYSASM权限,最后还有ASM ...

  10. C++ SFINAE

    1. 什么是SFINAE 在C++中有很多的编程技巧(Trick), SFINAE就是其中一种, 他的全义可以翻译为”匹配失败并不是一个错误(Substitution failure is not a ...