Unidades universales para prevenir múltiples instancias de aplicaciones: uniqueinstance.pas

{Unidad uniqueinstance;/t/t/t/t/t/t/t/t}

{/t/t/t/t/t/t/t/t/t}

{Compruebe si existe una instancia de aplicación anterior, en caso afirmativo, el anterior/t}

{La instancia estará activa, y la instancia actual se terminará ./t}

{/t/t/t/t/t/t/t/t/t}

{Escrito por SaveTime, http://savetime.delphibbs.com 2004/6/27/t/t}

{/t/t/t/t/t/t/t/t/t}

{Uso:/t/t/t/t/t/t/t/t}

{Incluya esta unidad para su proyecto Delphi, no más trabajo para hacer ./t}

{/t/t/t/t/t/t/t/t/t}

{Importante:/t/t/t/t/t/t/t/t}

{No debe eliminar la línea del proyecto: Application.Initialize;/T}

{/t/t/t/t/t/t/t/t/t}

{Notas:/t/t/t/t/t/t/t/t}

{Esta unidad identifica una aplicación por nombre de archivo EXE de IT. Entonces, si quieres}

{Para especificar otro nombre de aplicación único, debe cambiar el valor}

{UniqueApplicationName in checkPriviousInstance Procedimiento./t/t}

{/t/t/t/t/t/t/t/t/t}

Unidad única en la instancia;

interfaz

utiliza clases, sysutils, ventanas, formularios;

implementación

varilla

Uniquemessageid: uint;

Uniquemutexhandle: thandle;

AnteriorwndProc: tfnwndproc;

NextInitProc: puntero;

function ApplicationWndProc (hwnd: hwnd; umsg: uint; wparam: wparam;

Lparam: Lparam): lResult; stdcall;

comenzar

// NOTA: Use "<>" puede aumentar la velocidad de la aplicación.

Si umsg <> uniquemessageid entonces

Resultado: = CallWindowProc (anteriorWNDProc, HWND, UMSG, WPARAM, LPARAM)

De lo contrario, comience

if isiconic (aplicación.handle) y luego application.restore;

SetForeGroundWindow (Application.Handle);

Resultado: = 0;

fin;

fin;

procedimiento traer pliegiosos en la parte del otro;

estúpido

BsmRecipients: dword = bsm_applications;

comenzar

BroadcastSystemessage (bsf_ignorecurrentTask o bsf_postmessage,

@BSMrecipients, uniquemessageId, 0, 0);

Detener;

fin;

Procedimiento de subclaseplicación;

comenzar

AnteriorwndProc: = tfnwndproc (setwindowlong (application.handle, gwl_wndproc,

Entero (@AplicationWndProc)));

fin;

Procedimiento de control de revisión;

varilla

UniqueApplicationName: PCHAR;

comenzar

// Nombre único de la aplicación, configurado predeterminado en el nombre del archivo exe,

// Puedes cambiarlo a ti mismo.

UniqueApplicationName: = Pchar (ExtractFileName (Application.exename));

// registrar una identificación de mensaje única

UniquemessageId: = RegisterWindowMessage (uniqueApplicationName);

// Crear objeto mutex

Uniquemutexhandle: = createMutex (nil, falso, uniqueApplicationName);

// Crear mutex falló, rescindir la aplicación

Si uniquemutexhandle = 0 entonces

Detener

// Existe el mismo mutex llamado, muestra una instancia anterior

más si getLasterRor = error_already_exists entonces

Traer plato para la estancia

// sin caso anterior, ventana de aplicación de subclase

demás

Aplicación de subclase;

// llama al siguiente initproc

si nextInitProc <> nil entonces tprocedure (nextInitProc);

fin;

inicialización

// debe usar initproc para verificar la instancia privada,

// ¡como la razón de la aplicación no ha sido creada!

NextInitProc: = initProc;

Initproc: = @checkpreviousInstance;

finalización

// Cierre el mango mutex

si uniquemutexhandle <> 0 luego cierrehandle (uniquemutexhandle);

fin.