Verificando se executável está rodando antes de instalar uma nova versão


O código abaixo verifica se determinado executável está em execução antes de começar a instalação do novo pacote.

Vamos utilizar no nosso exemplo o executável notepad.exe. Se ele estiver em execução, exibiremos uma mensagem e não abriremos o instalador.


[Code]
const
  LEN_EXEFILE = 260;

type
  PROCESSENTRY32 = record
    dwSize: cardinal;
    cntUsage: cardinal;
    th32ProcessID: cardinal;
    th32DefaultHeapID: cardinal;
    th32ModuleID: cardinal;
    cntThreads: cardinal;
    th32ParentProcessID: cardinal;
    pcPriClassBase: cardinal;
    dwFlags: cardinal;
    szExeFile: Array[0..LEN_EXEFILE] Of Char;
 end;
 HANDLE = cardinal;

const
 TH32CS_SNAPHEAPLIST = $1;
 TH32CS_SNAPPROCESS = $2;
 TH32CS_SNAPTHREAD = $4;
 TH32CS_SNAPMODULE = $8;

function Process32First(
 hSnapshot: HANDLE;
 var lpProcess: PROCESSENTRY32): Integer;
  external 'Process32First@kernel32.dll stdcall';

function Process32Next(
 hSnapshot: HANDLE;
 var lpProcess: PROCESSENTRY32): Integer;
  external 'Process32Next@kernel32.dll stdcall';

function CloseHandle(hSnapshot: HANDLE): Integer;
external 'CloseHandle@kernel32.dll stdcall';

function CreateToolhelp32Snapshot(
 lFlags: cardinal;
 lProcessID: cardinal): HANDLE;
  external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';

//-------------------------------------------------------------------

function ProcessRunning(sProcessName : String): Boolean;
var
  hSnapshot: HANDLE;
  PInfo: PROCESSENTRY32;
  nResult: Integer;
  bRunning: Boolean;
  sTemp: String;
  i: Integer;

begin

  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  If hSnapshot = -1 Then
  begin
     Result := False;
     Msgbox('Failed to get snapshot of running processes.',
        mbError, MB_OK);
     Exit;
  end;

  bRunning := False;
  PInfo.dwSize := SizeOf(PInfo);
  nResult := Process32First(hSnapshot, PInfo);

  while (nResult <> 0) and (not bRunning) do
  begin
     i := 0;
     sTemp := '';
     while (i < LEN_EXEFILE) and (PInfo.szExeFile[i] > Chr(0)) do
     begin
        sTemp := sTemp + PInfo.szExeFile[i];
        i := i + 1;
     end;

if CompareText(sTemp, sProcessName) = 0 then

     begin
        bRunning := True;
     end;

     PInfo.dwSize := SizeOf(PInfo);
     nResult := Process32Next(hSnapshot, PInfo)
  end;

  CloseHandle(hSnapshot);
  Result := bRunning;

end;

function InitializeSetup(): Boolean;
var
  nMsgBoxResult: Integer;

begin
  Result := True;

  nMsgBoxResult := IDOK;

while ProcessRunning('notepad.exe') and

        (nMsgBoxResult <> IDCANCEL) do
  begin

nMsgBoxResult := Msgbox('Notepad is running. Please close to continue.',

        mbError, MB_RETRYCANCEL)
  end;

if nMsgBoxResult = IDCANCEL then

  begin
     Result := False;
  end;

end; 





Comentários

Copyright © 2018 Anderson Bravo
www.andersonbravo.com.br
anderson@andersonbravo.com.br