• 程序只允许运行一个+重复运行程序提前


    其实是很简单的代码....系统的发一下

    首先工程启动部分, 要检测是否重复运行:

    uses
      Forms,
      Windows,
      Unit1 in 'Unit1.pas' {Form1},
      Unit2 in 'Unit2.pas' {DM: TDataModule};
    
    {$R *.res}
    
    var
      nMutex: HWND;
      nBSMRecipients: DWORD;
      nWParam: Integer;
    begin
      Application.Initialize;
      Application.MainFormOnTaskbar := True;
    
      {单一启动验证}
      nMutex := CreateMutex(nil, False, PChar(CST_SYSMUTEX));
      if GetLastError <> ERROR_ALREADY_EXISTS then
      begin
        Application.CreateForm(TForm1, Form1);
        Application.CreateForm(TDM, DM);
      end
      else
      begin
        {发送广播消息,通知已经启动的程序前台显示}
        nBSMRecipients := BSM_APPLICATIONS;
        nWParam := 0;
        BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
          @nBSMRecipients, BSMMsgID, nWParam, 0);
      end;
    
      Application.Run;
    end.

    然后编辑DataModule单元, 定义常量以及处理重复运行的通知

    uses
      SysUtils, Classes, AppEvnts, Windows;
    
    type
      TDM = class(TDataModule)
        ApplicationEvents1: TApplicationEvents;
        procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      DM: TDM;
    
    const
      {GUID作为程序唯一标识, 防止重复 通过Ctrl+Shift+G生成}
      CST_SYSMUTEX: string = '{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}';
    
    function BSMMsgID: Cardinal;
    
    implementation
    
    uses
      Forms;
    
    var
      FBSMMsgID: Cardinal; {重复运行消息ID}
    
    function SysMutex: string;
    begin
      Result := CST_SYSMUTEX;
    end;
    
    function BSMMsgID: Cardinal;
    begin
      Result := FBSMMsgID;
    end;
    
    procedure ForegroundApp;
    var
      nForegroundWin, nForegroundTHreadID: integer;
    begin
      {窗口提前}
      Application.Restore;
      nForegroundWin := GetForegroundWindow;
      nForegroundTHreadID := GetWindowThreadProcessID(nForegroundWin, nil);
      if AttachThreadInput(GetcurrentThreadID, nForegroundTHreadID, True) then
      begin
        SetForegroundWindow(Application.Handle);
        AttachThreadInput(GetCurrentTHreadID, nForegroundTHreadID, False);
      end
    end;
    
    {$R *.dfm}
    
    procedure TDM.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    begin
      if Msg.message = BSMMsgID then
      begin
        ForegroundApp;
      end;
    end;
    
    initialization
      FBSMMsgID := RegisterWindowMessage(PChar(CST_SYSMUTEX));
    
    end.
  • 相关阅读:
    AS出现Connection timed out
    关于eclipse出现The selection cannot be launched,and there are no recent launches
    第十周周赛题解
    FJUT 2401 尼克的任务
    关于3月份的学习总结
    人生的第一题图论
    第六周周赛题解
    Drupal8 社区文档之积极的Drupal版本
    Drupal8 社区文档之Drupal安全吗
    Drupal8 社区文档之技术堆栈
  • 原文地址:https://www.cnblogs.com/lzl_17948876/p/3722924.html
Copyright © 2020-2023  润新知