国产探花免费观看_亚洲丰满少妇自慰呻吟_97日韩有码在线_资源在线日韩欧美_一区二区精品毛片,辰东完美世界有声小说,欢乐颂第一季,yy玄幻小说排行榜完本

首頁 > 學(xué)院 > 開發(fā)設(shè)計(jì) > 正文

關(guān)于程序只運(yùn)行一次的問題

2019-11-18 18:16:09
字體:
供稿:網(wǎng)友

//從論壇上copy來,事先自己并未驗(yàn)證

引用秋風(fēng)兄的代碼:
  application.Title := 'PerRecord';
  Application.Initialize;
  mHandle := Windows.CreateMutex(nil, true, 'PerRecord');
  if mHandle <> 0 then
  begin
    if GetLastError = Windows.ERROR_ALREADY_EXISTS then
    begin
      fHandle := FindWindow('TfrmLogin', nil);
      if fHandle = 0 then
        fHandle := FindWindow('TfrmPer', nil);
      if fHandle <> 0 then
      begin
        ShowWindow(fHandle, SW_SHOW);
        SetForeGroundWindow(fHandle);
      end;
      Windows.ReleaseMutex(mHandle);
      Halt;
    end;
  end;

  Application.CreateForm(TdmPer, dmPer);
  Application.CreateForm(TfrmPer, frmPer);
  Application.Run;

第二個(gè)

http://dev.csdn.net/article/20/20379.shtm 看都沒有看,來不及了,有待考證

第三個(gè)

回復(fù)人: fj218(洞庭風(fēng)) ( 五級(jí)(中級(jí))) 信譽(yù):103

uses這個(gè)單元即可

unit RunOne;

interface

const
  MI_QUERYWINDOWHANDLE   = 1;
  MI_RESPONDWINDOWHANDLE = 2;

  MI_ERROR_NONE          = 0;
  MI_ERROR_FAILSUBCLASS  = 1;
  MI_ERROR_CREATINGMUTEX = 2;

// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;

implementation

uses Forms, Windows, SysUtils;

const
  UniqueAppStr = 'ShuanYuan_SoftWare';

var
  MessageId: Integer;
  WPRoc: TFNWndProc;
  MutHandle: THandle;
  MIError: Integer;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
  Longint; stdcall;
begin
  Result := 0;
  // If this is the registered message...
  if Msg = MessageID then
  begin
    case wParam of
      MI_QUERYWINDOWHANDLE:
        // A new instance is asking for main window handle in order
        // to focus the main window, so normalize app and send back
        // message with main window handle.
        begin
          if IsIconic(Application.Handle) then
          begin
            Application.MainForm.WindowState := wsNormal;
            Application.Restore;
          end;
          PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
            Application.MainForm.Handle);
        end;
      MI_RESPONDWINDOWHANDLE:
        // The running instance has returned its main window handle,
        // so we need to focus it and go away.
        begin
          SetForegroundWindow(HWND(lParam));
          Application.Terminate;
        end;
    end;
  end
  // Otherwise, pass message on to old window proc
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  // We subclass Application window procedure so that
  // Application.OnMessage remains available for user.
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
    Longint(@NewWndProc)));
  // Set appropriate error flag if error condition occurred
  if WProc = nil then
    MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
  // Create the mutex with the (hopefully) unique string
  MutHandle := CreateMutex(nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
  BSMRecipients: DWord;
begin
  // Prevent main form from Flashing
  Application.ShowMainForm := False;
  // Post message to try to establish a dialogue with previous instance
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
    @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
    Application.Handle);
end;

procedure InitInstance;
begin
  SubClassApplication;   // hook application message loop
  MutHandle := OpenMutex(MUTEX_ALL_access, False, UniqueAppStr);
  if MutHandle = 0 then
    // Mutex object has not yet been created, meaning that no previous
    // instance has been created.
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;

initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  // Restore old application window procedure
  if WProc <> Nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
  if MutHandle <> 0 then CloseHandle(MutHandle);  // Free mutex
end.

第四個(gè)

據(jù)說這個(gè)簡(jiǎn)單明了,有待我來考證

回復(fù)人: fei19790920(飯桶的馬甲(抵制日貨)) ( 一星(中級(jí))) 信譽(yù):103 得分: 0

program Project1;

uses
  Forms,windows,
  Unit1 in 'Unit1.pas' {Form1};

var hw:hwnd;

{$R *.RES}
begin
  Application.Initialize;
  application.title:='test';//名字自己定義
  CreateMutex(nil, false, 'ADManager');
  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
end.

第五個(gè)

好像和上一個(gè)類似,但是感覺嚴(yán)謹(jǐn),學(xué)習(xí)一下

回復(fù)人: zdq801104(我很笨,但是我不傻!) ( 三級(jí)(初級(jí))) 信譽(yù):90

看看這個(gè)吧,編譯已經(jīng)通過了
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  //保存Mutex句柄
  mHandle:THandle;
  PreviousInstanceWindow:HWnd;
  Project:String;
  AppName:String;
implementation

{$R *.dfm}
initialization
  //定義自己的項(xiàng)目名稱,作為要?jiǎng)?chuàng)建的互斥區(qū)名,最好有自己的特點(diǎn)以防止重復(fù)
  Project:='RunOnlyOnce_MyProject';
  //將lpMutexAttributes設(shè)為nil,bInitialOwner設(shè)為True(即本程序擁有該互斥區(qū))
  mHandle:=CreateMutex(nil,True,PChar(Project));
  if GetLastError=ERROR_ALREADY_EXISTS then
   //該互斥區(qū)已存在則表明已有本程序的另一個(gè)實(shí)例在運(yùn)行
    begin
      ShowMessage('已經(jīng)有該程序在運(yùn)行');
      //保存程序標(biāo)題
      AppName:=Application.Title;
      //不顯示本窗口
      Application.ShowMainForm:=False;
      //改變程序標(biāo)題,以使函數(shù)FindWindow找到的是前一個(gè)實(shí)例窗口
      Application.Title:='destroy me';
      //尋找前一個(gè)實(shí)例窗口句柄
      PreviousInstanceWindow:=FindWindow(nil,PChar(AppName));
      //已經(jīng)找到
      if PreviousInstanceWindow<>0 then
      //如果該窗口最小化則恢復(fù)
         if IsIconic(PreviousInstanceWindow) then
           ShowWindow(PreviousInstanceWindow,SW_RESTORE)
        else
        //如果程序在后臺(tái)則將其放到前臺(tái)
         SetForegroundWindow(PreviousInstanceWindow);
         //中止本實(shí)例
        Application.Terminate;
      end;
    finalization
    //該互斥區(qū)對(duì)象仍存在則關(guān)閉對(duì)象
      if mHandle<>0 then
        CloseHandle(mHandle);
end.

以上都是delphi版的,我愛delphi,可是我卻沒有辦法用,項(xiàng)目都是vb的。討厭vb卻沒有辦法

下面這個(gè)是vb的,絕對(duì)好用,不是我寫的,轉(zhuǎn)自誰,也找不到了,謝謝那天幫助我的兄臺(tái)!!

模塊里面

Option Explicit

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

Public Const WM_CONTEXTMENU = &H7B ''菜單彈出


''在有一個(gè)實(shí)例運(yùn)行的情況下把該實(shí)例拉到前臺(tái),不允許運(yùn)行兩個(gè)實(shí)例
Public Function ForceForegroundWindow(ByVal hWnd As Long) As Boolean
   Dim ThreadID1 As Long
   Dim ThreadID2 As Long
   Dim nRet As Long

   If hWnd = GetForegroundWindow() Then
      ForceForegroundWindow = True
   Else
      ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow, ByVal 0&)
      ThreadID2 = GetWindowThreadProcessId(hWnd, ByVal 0&)
      If ThreadID1 <> ThreadID2 Then
         Call AttachThreadInput(ThreadID1, ThreadID2, True)
         nRet = SetForegroundWindow(hWnd)
         Call AttachThreadInput(ThreadID1, ThreadID2, False)
      Else
         nRet = SetForegroundWindow(hWnd)
      End If
      If IsIconic(hWnd) Then
         Call ShowWindow(hWnd, SW_RESTORE)
      Else
         Call ShowWindow(hWnd, SW_SHOW)
      End If
      ForceForegroundWindow = CBool(nRet)
   End If
End Function

sub main或者是主窗體,這里用的是sub main主窗體相應(yīng)調(diào)整

If App.PrevInstance = True Then

    Dim lngPreHandle As Long
   
    lngPreHandle = FindWindow(vbNullString, "歡迎登錄上海時(shí)代航運(yùn)MIS!") ''找登陸窗口,找到就是把登陸拉最前面
   
    If CBool(lngPreHandle) Then
       
        ForceForegroundWindow lngPreHandle
           
        End
           
    End If

    lngPreHandle = FindWindow(vbNullString, "時(shí)代航運(yùn)管理信息系統(tǒng)") ''找不到登陸窗口,就找主窗口,把主窗口拉前面
   
    If CBool(lngPreHandle) Then
       
        ForceForegroundWindow lngPreHandle
           
        End
           
    End If
   
    End ''本來不可能存在既沒有登陸窗口又沒有主窗口的情況,但是為了以防萬一,還是再這里多一個(gè)end
   
End If

vb的這個(gè)不嚴(yán)謹(jǐn),通過findwindow的名字都不嚴(yán)謹(jǐn),只是我的窗口名字還算牛,一般不會(huì)重復(fù),有時(shí)間要多研究delphi的,找一個(gè)嚴(yán)謹(jǐn)?shù)姆椒ā?/P>


上一篇:firebird嵌入式數(shù)據(jù)庫

下一篇:Windows的DDE原理

發(fā)表評(píng)論 共有條評(píng)論
用戶名: 密碼:
驗(yàn)證碼: 匿名發(fā)表
學(xué)習(xí)交流
熱門圖片

新聞熱點(diǎn)

疑難解答

圖片精選

網(wǎng)友關(guān)注

主站蜘蛛池模板: 湘阴县| 犍为县| 西贡区| 凤城市| 随州市| 巴林右旗| 吉木乃县| 玉门市| 温宿县| 英吉沙县| 山西省| 宜君县| 龙山县| 旌德县| 阳谷县| 大厂| 焉耆| 疏附县| 桐梓县| 胶州市| 武义县| 湛江市| 花莲市| 北安市| 磐安县| 绵阳市| 商河县| 密山市| 九龙县| 三原县| 区。| 罗城| 湟源县| 忻州市| 隆安县| 台湾省| 钦州市| 介休市| 阜新市| 安新县| 湟源县|