Kopia wikimirror

To jest mirror wiki z pascal.chat. Edycja, historia i logowanie są tam.

AppIsRunning/pl

English · Français · Polski

Sprawdź, czy aplikacja jest już uruchomiona

Oto moduł, który działa zarówno w systemie Windows, jak i Linux

pascal
unit uappisrunning;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils
      {$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
      {$IFDEF LINUX},process{$ENDIF};
    // JwaTlHelp32 znajduje się w fpc\packages\winunits-jedi\src\jwatlhelp32.pas
    
    // Zwraca TRUE jeśli EXEName jest uruchomiony w systemie Windows lub Linux
    // Nie przekazuj rozszerzenia .exe do Linuksa!
    function AppIsRunning(const ExeName: string):Boolean;
    
    implementation
    
    // Te funkcje zwracają Zero, jeśli aplikacja NIE jest uruchomiona
    // Zastąp je, jeśli masz lepszą implementację
    
    {$IFDEF WINDOWS}
    function WindowsAppIsRunning(const ExeName: string): integer;
    var
      ContinueLoop: BOOL;
      FSnapshotHandle: THandle;
      FProcessEntry32: TProcessEntry32;
    
    begin
      FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
      ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
      Result := 0;
    
      while integer(ContinueLoop) <> 0 do
        begin
        if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
          UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
          UpperCase(ExeName))) then
          begin
          Inc(Result);
          // Czy SendMessage(Exit-Message) jest możliwe?
          end;
        ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
        end;
    
      CloseHandle(FSnapshotHandle);
    end;
    {$ENDIF}
    
    {$IFDEF LINUX}
    function LinuxAppIsRunning(const ExeName: string): integer;
    var
      t: TProcess;
      s: TStringList;
    
    begin
      Result := 0;
      t := tprocess.Create(nil);
      t.CommandLine := 'ps -C ' + ExeName;
      t.Options := [poUsePipes, poWaitonexit];
    
        try
        t.Execute;
        s := TStringList.Create;
          try
          s.LoadFromStream(t.Output);
          Result := Pos(ExeName, s.Text);
          finally
          s.Free;
          end;
        finally
        t.Free;
        end;
    
    end;
    {$ENDIF}
    
    function AppIsRunning(const ExeName: string):Boolean;
    begin
    
    {$IFDEF WINDOWS}
      Result:=(WindowsAppIsRunning(ExeName) > 0);
    {$ENDIF}
    
    {$IFDEF LINUX}
      Result:=(LinuxAppIsRunning(ExeName) > 0);
    {$ENDIF}
    
    end;
    end.

Zobacz także


From the Free Pascal wiki, page "AppIsRunning/pl", as the Internet Archive kept it on 2022-08-18, last changed on 2022-01-06. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

Wersja 3, ostatnia zmiana: WikiArchive, .