//從論壇上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)) (  ) 信譽(yù):103
) 信譽(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(飯桶的馬甲(抵制日貨)) (  ) 信譽(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(我很笨,但是我不傻!) (  ) 信譽(yù):90
) 信譽(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>
新聞熱點(diǎn)
疑難解答
圖片精選
網(wǎng)友關(guān)注