Unités universelles pour empêcher plusieurs instances d'applications - UniqueInstance.pas

{Unit uniqueInstance; / T / T / T / T / T / T / T}

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

{Vérifiez si l'instance d'application précédente existe, si oui, le précédent / t}

{l'instance sera active et l'instance actuelle sera terminée./t}

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

{Écrit par Savetime, http://savetime.delphibbs.com 2004/6/27 / T / T}

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

{Usage: / t / t / t / t / t / t / t / t}

{Incluez cette unité à votre projet Delphi, plus de travail à faire ./t}

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

{Important: / t / t / t / t / t / t / t / t}

{Vous ne devez pas supprimer la ligne de projet: application.Initialize; / t}

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

{Notes: / t / t / t / t / t / t / t / t}

{Cette unité identifie un nom de fichier EXE d'application par celui-ci. Donc, si vous voulez}

{Pour spécifier un autre nom d'application unique, vous devez modifier la valeur}

{UniqueApplicationName dans CheckPriviousInstance Procedure./t/t}

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

unité unique INSCRANGE;

interface

Utilise des classes, des systèmes, des fenêtres, des formulaires;

mise en œuvre

var

UniquemessageId: Uint;

UniquemitexHandle: Thandle;

PREMERWNDPROC: TFNWNDDPROC;

NextInitProc: pointeur;

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

lparam: lparam): lresult; stdcall;

commencer

// Remarque: utilisez "<>" peut augmenter la vitesse d'application.

Si umsg <> uniquemessageid alors

Résultat: = CallWindowProc (précédentwndproc, hwnd, umsg, wparam, lparam)

d'autre commence

Si isiConic (application.handle) alors application.restore;

SetforegroundWindow (application.handle);

Résultat: = 0;

fin;

fin;

procédure apportant la mise en place de l'avant-terrain;

const

Bsmrecipients: dword = bsm_applications;

commencer

BroadcastSystemMessage (BSF_IGNORECURRENTTASK ou BSF_POSTMESSAGE,

@Bsmrecipients, UniquemessageId, 0, 0);

Arrêt;

fin;

Procédure Sous-CLASSAPPLICATION;

commencer

PREATWNDPROC: = tfnwnddProc (setwindowlong (application.handle, gwl_wndproc,

Integer (@ApplicationWndProc)));

fin;

Procédure CheckPreviousInstance;

var

UniqueApplicationName: PCHA;

commencer

// Nom de l'application unique, défaut par défaut sur le nom du fichier exe,

// Vous pouvez le changer par vous-même.

UniQueApplicationName: = pChar (ExtractFileName (application.exename));

// Enregistrer l'ID de message unique

UniqueMessageId: = RegisterWindowMessage (UniqueApplicationName);

// Créer un objet mutex

UniquemuteXHandle: = CreateMutex (nil, false, uniqueApplicationName);

// Créer un Mutex échoué, terminer l'application

Si uniquesmutexHandle = 0 alors

Arrêt

// Le même nom nommé existe, afficher l'instance précédente

sinon si getlasterror = error_already_exists alors

BringpreiviousInstanceForforeground

// Aucune instance précédente, fenêtre d'application sous-classe

autre

Sous-CLASSAPPLICATION;

// Appelle Next InitProc

Si NextInitProc <> nil alors tprocedure (nextInitProc);

fin;

initialisation

// doit utiliser InitProc pour vérifier l'instance privée,

// car la raison de la demande n'a pas été créée!

NextInitProc: = InitProc;

InitProc: = @CheckPreviousInstance;

finalisation

// Fermez la poignée mutex

si uniquesmutexHandle <> 0 alors CloseHandle (UniquemiteXHandle);

fin.