{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.