Aplicativo Executado Uma Só Vez - (RESOLVIDO)

[Paulo Nobre]

Alguém poderia me fornecer um código simples, para verificar se uma determinada aplicação já está sendo rodada?

O código abaixo não está funcionando!!

Se você quiser executar uma única copia do aplicativo, o código de inicialização do arquivo fonte do PROJETO pode ser escrito conforme segue: }

program Project1;

uses

Forms,

Windows,

Dialogs,

Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

Var HprevHist : HWND;

begin

Application.Initialize;

HprevHist := FindWindow(Nil, PChar('TheProgrammer'));

if HprevHist = 0 then begin

Application.Title := 'TheProgrammer';

Application.CreateForm(TForm1, Form1);

Application.Run;

end else

MessageDlg('Você não pode executar outra cópia do aplicativo', mtInformation, [mbOK], 0); {Com esse código o usuário pode iniciar uma nova copia do aplicativo somente se não houver outra anterior. Caso contrario é exibido uma mensagem para o usuário.}

peguei num site para delphi

Paulo Nobre

[Capablanca]

Olá,

Exemplo nº 1

Se você apenas precisa de um código que iniba o usuário abrir outra instância de seu aplicativo, utilize o seguinte:

program Project1;

uses
  Windows,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

var
 hMutex : LongWord;
begin
 hMutex := CreateMutex(nil,False,'OneInstance');

 if WaitForSingleObject(hMutex,0) <> WAIT_TIMEOUT then
 begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
  Application.Run;
 end;

end.

Observe que o código acima não se refere a uma UNIT, mas ao próprio PROJECT SOURCE (menu PROJECT > VIEW SOURCE). Logo, as alterações devem ser feitas no próprio arquivo fonte do PROJETO (e não na UNIT correspondente a ele). Exemplo nº 2 Se você precisa de um rotina que analise se determinado aplicativo já está rodando e, caso afirmativo, seja exibida uma mensagem, utilize o seguinte: Instruções: 1) vá em FILE > CLOSE ALL; 2) depois selecione FILE > NEW > UNIT; 3) apague todo o código da sua UNIT e digite o código abaixo:

unit multinst;

interface

uses Forms, Windows, Dialogs, SysUtils, inifiles;

// The following declaration is necessary because of an error in // the declaration of BroadcastSystemMessage() in the Windows unit function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;   uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;   external 'user32.dll';


const
 MI_NO_ERROR          = 0;
 MI_FAIL_SUBCLASS    = 1;
 MI_FAIL_CREATE_MUTEX = 2;

{ Query this function to determine if error occurred in startup. } { Value will be one or more of the MI_* error flags. }
function GetMIError: Integer;

implementation

const
 UniqueAppStr : PChar = 'application.exe';

var
 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
 { If this is the registered message... }
 if Msg = MessageID then begin
   { if main form is minimized, normalize it }
   { set focus to application }
   if IsIconic(Application.Handle) then begin
     Application.MainForm.WindowState := wsNormal;
     Application.Restore;
   end;
   SetForegroundWindow(Application.MainForm.Handle);
   Result := 0;
 end
 { Otherwise, pass message on to old window proc }
 else
   Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam); end;

procedure SubClassApplication;
begin
 { We subclass Application window procedure so that }
 { Application.OnMessage remains available for user. }
 WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,                                     Longint(@NewWndProc)));
 { Set appropriate error flag if error condition occurred }
 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;
{ This is called when there is already an instance running. }
var
 BSMRecipients: DWORD;
 SGINIFile: TIniFile;
 multi: boolean;
begin
 SGIniFile := TIniFile.Create(ExtractFilePath(ParamStr(0)) +
'sig_gen.ini');
 multi := SGIniFile.ReadBool('Options', 'MultipleInstance', false);   SGINIFile.Free;
 if multi = False then begin
   { Don't flash main form }
   Application.ShowMainForm := False;
   { Post message and inform other instance to focus itself }
   BSMRecipients := BSM_APPLICATIONS;
   BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,       @BSMRecipients, MessageID, 0, 0);
   ShowMessage('Existe outra instância do aplicativo rodando !');
   Application.Terminate;
 end;
end;

procedure InitInstance;
begin
 MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);   if MutHandle = 0 then
   { Mutex object has not yet been created, meaning that no previous }     { instance has been created. }
   DoFirstInstance
 else
   BroadcastFocusMessage;
end;

initialization
 MessageID := RegisterWindowMessage(UniqueAppStr);
 InitInstance;
finalization
 if WProc <> Nil then
   { Restore old window procedure }
   SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc)); end.

4) no menu, selecione FILE > SAVE e salve a sua UNIT como multinst;

5) Pronto. Basta adicionar esta UNIT no projeto do aplicativo no qual vc. quer que ela funcione (se vc. já estiver com o projeto aberto, vá em PROJECT > ADD TO PROJECT e localize a UNIT multinst que você acabou de criar.

6) Você poderá configurar o nome do aplicativo no ShowMessage.

Obs.: creio que este segundo exemplo não seja tão simples como vc. havia pedido, mas funciona corretamente.

Abs.

[Paulo Nobre]

Muito obrigado Capablanca.

Paulo Nobre