Как не допустить запуск второй копии программы VIII - API - Не стандартные примеры на Delphi - Каталог статей

{*******************************************************}
{                                                       }
{                     HTMLCoolEdit                      }
{                                                       }
{           Copyright (c) 1999-2000 PROFOX              }
{                                                       }
{*******************************************************}

unit multinst;

interface

uses Forms, Windows, Dialogs, SysUtils;

const

MI_NO_ERROR = 0;

MI_FAIL_SUBCLASS = 1;

MI_FAIL_CREATE_MUTEX = 2;

function GetMIError: Integer;
function InitInstance : Boolean;

implementation

uses RegWork, FileWork;

var

UniqueAppStr : PChar;

MessageId: Integer;

WProc: TFNWndProc = Nil;

MutHandle: THandle = 0;

MIError: Integer = 0;

function GetMIError: Integer;
begin

Result := MIError;

end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;
begin

Result := 1;

if Msg = MessageID then begin

if IsIconic(Application.Handle) then OpenIcon(Application.Handle)

else SetForegroundWindow(Application.Handle);

FileWork.LoadFileName(RegWork.RWGetParamStr1);

end

else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedure SubClassApplication;
begin

WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

if WProc = Nil then MIError := MIError or MI_FAIL_SUBCLASS;

end;

procedure DoFirstInstance;
begin

SubClassApplication;

MutHandle := CreateMutex(Nil, False, UniqueAppStr);

if MutHandle = 0 then MIError := MIError or MI_FAIL_CREATE_MUTEX;

end;

procedure BroadcastFocusMessage;
begin

Application.ShowMainForm := False;

PostMessage(HWND_BROADCAST, MessageId,0,0);

end;

function InitInstance : Boolean;
begin

MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

if MutHandle = 0 then begin

ShowWindow(Application.Handle, SW_ShowNormal);

Application.ShowMainForm:=True;

DoFirstInstance;

result := True;

end else begin

RegWork.RWSetParamStr1;

BroadcastFocusMessage;

result := False;

end;

initialization
begin

UniqueAppStr := PChar(Application.ExeName);

MessageID := RegisterWindowMessage(UniqueAppStr);

ShowWindow(Application.Handle, SW_Hide);

Application.ShowMainForm:=FALSE;

end;

finalization
begin

if WProc <> Nil then

SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));

end;

end.

Категория: API | Добавил: DelphiAiX (09.05.2012)

Просмотров: 451 | Рейтинг: 0.0/0

Всего комментариев: 0

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]

Все материалы размещенные на сайте пренадлежат их владельцам и предоставляются исключительно в ознакомительных целях.
Администрация ответственности за содержание материала не несет и убытки не возмещает.
По истечению 24 часов материал должен быть удален с вашего компьютера.
Незаконная реализация карается законами РФ и Украины : "Об авторском и смежном праве".
При копировании материала, ссылка на сайт обязательна! Сделать бесплатный сайт с uCoz | Карта сайта | Карта форума