//从论坛上copy来，事先自己并未验证
引用秋风兄的代码：
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(洞庭风)(
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(饭桶的马甲（抵制日货）)(
得分: 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(我很笨，但是我不傻！)(
看看这个吧，编译已经通过了
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的，找一个严谨的方法。