Unit universal untuk mencegah beberapa contoh aplikasi - unikinstance.pas

{Unit unikinstance;/t/t/t/t/t/t/t}

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

{Periksa apakah ada contoh aplikasi sebelumnya, jika ya, sebelumnya/t}

{instance akan aktif, dan instance saat ini akan berakhir./t}

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

{Ditulis oleh 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}

{Sertakan unit ini ke proyek Delphi Anda, tidak ada lagi pekerjaan yang harus dilakukan./T}

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

{Penting:/t/t/t/t/t/t/t/t}

{Anda tidak boleh menghapus baris proyek: application.Initialize;/t}

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

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

{Unit ini mengidentifikasi aplikasi dengan nama file EXE itu. Jadi, jika Anda mau}

{Untuk menentukan nama aplikasi unik lainnya, Anda harus mengubah nilainya}

{UniqueApplicationName dalam prosedur checkpriviousinstance./t/t}

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

unit unikinstance;

antarmuka

menggunakan kelas, sysutils, windows, formulir;

pelaksanaan

var

UniquemessageId: uint;

Uniquemutexhandle: Thandle;

Sebelumnyaproc: tfnwndproc;

NextInitproc: pointer;

Fungsi ApplicationWndProc (hwnd: hwnd; UMSG: uint; wParam: wParam;

LPARAM: LPARAM): LRESULT; stdcall;

mulai

// Catatan: Gunakan "<>" dapat meningkatkan kecepatan aplikasi.

Jika UMSG <> uniquemessageId maka

Hasil: = CallWindowProc (sebelumnyawndProc, hwnd, UMSG, WPARAM, LPARAM)

lagi mulai

jika isiconic (application.handle) maka application.restore;

SetForegroundWindow (Application.Handle);

Hasil: = 0;

akhir;

akhir;

Prosedur MembawaPreiviousinstanceFroundground;

const

BSMRecipients: DWORD = BSM_APPLICATION;

mulai

BroadcastSystemMessage (BSF_IGNORECURRENTASK atau BSF_POSTMESSAGE,

@Bsmrecipients, uniquemessageId, 0, 0);

Berhenti;

akhir;

prosedur subklass aplikasi;

mulai

Sebelumnyaproc: = tfnwndproc (setWindowlong (application.handle, gwl_wndproc,

Integer (@ApplicationWndProc)));

akhir;

Prosedur CheckPreviousinstance;

var

UniqueApplicationName: pchar;

mulai

// Nama aplikasi unik, disetel default ke nama file exe,

// Anda dapat mengubahnya pada diri sendiri.

UniqueApplicationName: = pchar (extractFileName (application.exename));

// Daftarkan ID Pesan yang Unik

UniquemessageId: = registerWindowMessage (uniqueApplicationName);

// Buat Objek Mutex

UniquemutexHandle: = createMutex (nil, false, uniqueApplicationName);

// Buat mutex gagal, hentikan aplikasi

Jika uniquemutexHandle = 0 lalu

Berhenti

// ada mutex bernama yang sama, tunjukkan contoh sebelumnya

lain jika getlasterror = error_already_exists

Bawalah foreground

// tidak ada contoh sebelumnya, jendela aplikasi subkelas

kalau tidak

SubclassApplication;

// hubungi initproc berikutnya

jika nextInitproc <> nil maka tprocedure (nextInitproc);

akhir;

inisialisasi

// Harus menggunakan initproc untuk memeriksa contoh pribadi,

// Karena alasan aplikasi belum dibuat!

NextInitproc: = initproc;

Initproc: = @CheckPreviousInstance;

finalisasi

// tutup pegangan mutex

jika uniquemutexHandle <> 0 maka closeHandle (uniquemutexHandle);

akhir.