一个应用程序多次点击时,如何只让它只运行一个

[入库:2005年8月18日] [更新:2007年3月24日]

本文简介:选择自 luckyjan 的 blog

/////////////////////  (一)项目文件  test.dpr //////////////////////
program serialget;

uses
  forms,
  umain in 'umain.pas' {frmmain},
  ulogin in 'uform2.pas' {form2},
  udatamodule in 'udatamodule.pas' {datamodule1: tdatamodule},

{$r *.res}

begin
  application.initialize;

  if createmutex then                 //创建句柄,判断此应用程序是否在运行
  begin
    application.createform(tfrmmain, frmmain);
    application.createform(tform2, form2);
    application.createform(tdatamodule1, datamodule1);
    application.run;
  end else
  begin
    destroymutex;                     //释放句柄
  end;
end.

////////////////  (二)登陆窗体 umain.pas  umain.dfm //////////////////
unit umain;

interface
uses ......
type
  ... ... ...
  private
  public
  end;

var
  frmmain: tfrmmain;

  function createmutex: boolean;     // 全项目公用函数
  procedure destroymutex;            // 全项目公用函数

implementation
uses udatamodule;  //引用数据模块
var mutex: hwnd;

{$r *.dfm}

procedure destroymutex;
begin
  if mutex <> 0 then closehandle(mutex);
end;

function createmutex: boolean;
var
  previnsthandle: thandle;
  apptitle: pchar;
begin
  apptitle := stralloc(100);
  strpcopy(apptitle, application.title);
  result := true;
  mutex := windows.createmutex(nil, false, apptitle);
  if (getlasterror = error_already_exists) or (mutex = 0) then begin
    result := false;
    setwindowtext(application.handle, '');
    previnsthandle := findwindow(nil, apptitle);
    if previnsthandle <> 0 then begin
      if isiconic(previnsthandle) then
        showwindow(previnsthandle, sw_restore)
      else
        bringwindowtotop(previnsthandle);
      setforegroundwindow(previnsthandle);
    end;
    if mutex <> 0 then mutex := 0;
  end;
  strdispose(apptitle);
end;

本文关键:一个应用程序多次点击时,如何只让它只运行一个
  相关方案
Google
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top