引用秋風兄的代碼：
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;
第二個
http://dev.csdn.Net/article/20/20379.shtm 看都沒有看，來不及了，有待考證
第三個
回復人： fj218(洞庭風) ( 
) 信譽：103
uses這個單元即可
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.
第四個
據說這個簡單明了，有待我來考證
回復人： fei19790920(飯桶的馬甲（抵制日貨）) ( 
) 信譽：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.
第五個
好像和上一個類似，但是感覺嚴謹，學習一下
回復人： zdq801104(我很笨，但是我不傻！) ( 
) 信譽：90
看看這個吧，編譯已經通過了
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
//定義自己的項目名稱，作為要創建的互斥區名，最好有自己的特點以防止重復
Project:='RunOnlyOnce_MyProject';
//將lpMutexAttributes設為nil,bInitialOwner設為True(即本程序擁有該互斥區)
mHandle:=CreateMutex(nil,True,PChar(Project));
if GetLastError=ERROR_ALREADY_EXISTS then
//該互斥區已存在則表明已有本程序的另一個實例在運行
begin
ShowMessage('已經有該程序在運行');
//保存程序標題
AppName:=Application.Title;
//不顯示本窗口
Application.ShowMainForm:=False;
//改變程序標題，以使函數FindWindow找到的是前一個實例窗口
Application.Title:='destroy me';
//尋找前一個實例窗口句柄
PreviousInstanceWindow:=FindWindow(nil,PChar(AppName));
//已經找到
if PreviousInstanceWindow<>0 then
//如果該窗口最小化則恢復
if IsIconic(PreviousInstanceWindow) then
ShowWindow(PreviousInstanceWindow,SW_RESTORE)
else
//如果程序在後台則將其放到前台
SetForegroundWindow(PreviousInstanceWindow);
//中止本實例
Application.Terminate;
end;
finalization
//該互斥區對象仍存在則關閉對象
if mHandle<>0 then
CloseHandle(mHandle);
end.
以上都是delphi版的，我愛Delphi，可是我卻沒有辦法用，項目都是vb的。討厭vb卻沒有辦法
下面這個是vb的，絕對好用，不是我寫的，轉自誰，也找不到了，謝謝那天幫助我的兄台！！
模塊裡面
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 ''菜單彈出
''在有一個實例運行的情況下把該實例拉到前台，不允許運行兩個實例
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主窗體相應調整
If App.PrevInstance = True Then
Dim lngPreHandle As Long
lngPreHandle = FindWindow(vbNullString, "歡迎登錄上海時代航運MIS！") ''找登陸窗口，找到就是把登陸拉最前面
If CBool(lngPreHandle) Then
ForceForegroundWindow lngPreHandle
End
End If
lngPreHandle = FindWindow(vbNullString, "時代航運管理信息系統") ''找不到登陸窗口，就找主窗口，把主窗口拉前面
If CBool(lngPreHandle) Then
ForceForegroundWindow lngPreHandle
End
End If
End ''本來不可能存在既沒有登陸窗口又沒有主窗口的情況，但是為了以防萬一，還是再這裡多一個end
End If
vb的這個不嚴謹，通過findwindow的名字都不嚴謹，只是我的窗口名字還算牛，一般不會重復，有時間要多研究Delphi的，找一個嚴謹的方法。
