Delphi allows the program to run only once [The representative of the advanced hacker]

Source: Internet
Author: User

Unit RunOne;
Interface
Const
Mi_querymediawhandle = 1;
Mi_respond=whandle = 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 = 'newcq ';


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
Mi_querymediawhandle:
// 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_respond=whandle,
Application. MainForm. Handle );
End;
Mi_respond=whandle:
// 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_query?whandle,
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.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.