Определите, работает ли как VCL Forms или Service

Ответ 1

Я действительно закончил проверку переменной application.showmainform.

Проблема с skamradt isFormBased заключается в том, что часть этого кода вызывается до создания основной формы.

Я использую библиотеку программного обеспечения под названием SvCom_NTService от aldyn-программного обеспечения. Одна из целей - ошибки; либо для их регистрации, либо для отображения сообщения. Я полностью согласен с @Rob; наш код следует лучше поддерживать и обрабатывать вне функций.

Другое намерение - для неудачных подключений и запросов к базе данных; У меня есть другая логика в моих функциях для открытия запросов. Если это услуга, то она вернет нуль, но продолжит процесс. Но если в приложении возникают неудачные запросы/подключения, я хотел бы отобразить messaage и остановить приложение.

Ответ 2

НАЧАТЬ ИЗМЕНЕНИЯ

Так как это все еще, кажется, получает некоторое внимание, я решил обновить ответ с отсутствием информации и новых патчей для Windows. В любом случае вы не должны копировать/вставлять код. Код - это просто демонстрация того, как все должно быть сделано.

КОНЕЦ РЕДАКТИРОВАНИЯ:

Вы можете проверить, является ли родительский процесс SCM (диспетчер управления сервисом). Если вы работаете как служба, это всегда так, и никогда не будет работать в качестве стандартного приложения. Также я думаю, что у SCM всегда один и тот же PID.

Вы можете проверить это следующим образом:

type
  TAppType = (atUnknown, atDesktop, atService);

var
  AppType: TAppType;

function InternalIsService: Boolean;
var
  PL: TProcessList;
  MyProcessId: DWORD;
  MyProcess: PPROCESSENTRY32;
  ParentProcess: PPROCESSENTRY32;
  GrandParentProcess: PPROCESSENTRY32;
begin
  Result := False;

  PL := TProcessList.Create;
  try
    PL.CreateSnapshot;
    MyProcessId := GetCurrentProcessId;

    MyProcess := PL.FindProcess(MyProcessId);
    if MyProcess <> nil then
    begin
      ParentProcess := PL.FindProcess(MyProcess^.th32ParentProcessID);
      if ParentProcess <> nil then
      begin
        GrandParentProcess := PL.FindProcess(ParentProcess^.th32ParentProcessID);

        if GrandParentProcess <> nil then
        begin
          Result := SameText(string(ParentProcess^.szExeFile), 'services.exe') and
            (SameText(string(GrandParentProcess^.szExeFile), 'winlogon.exe') or
             SameText(string(GrandParentProcess^.szExeFile), 'wininit.exe'));
        end;
      end;
    end;
  finally
    PL.Free;
  end; 
end;

function IsService: Boolean;
begin
  if AppType = atUnknown then
  begin
    try
      if InternalIsService then
        AppType := atService
      else
        AppType := atDesktop;
    except
      AppType := atService;
    end;
  end;

  Result := AppType = atService;
end;

initialization
  AppType := atUnknown;

TProcessList реализуется следующим образом (опять же THashTable не включен, но любая хеш-таблица должна быть в порядке):

type
  TProcessEntryList = class(TList)
  private
    function Get(Index: Integer): PPROCESSENTRY32;
    procedure Put(Index: Integer; const Value: PPROCESSENTRY32);
  public
    property Items[Index: Integer]: PPROCESSENTRY32 read Get write Put; default;
    function Add(const Entry: TProcessEntry32): Integer; reintroduce;
    procedure Clear; override;
  end;

  TProcessList = class
  private
    ProcessIdHashTable: THashTable;
    ProcessEntryList: TProcessEntryList;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure CreateSnapshot;
    function FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
  end;

implementation

{ TProcessEntryList }

procedure TProcessEntryList.Clear;
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    FreeMem(Items[i]);
    Inc(i);
  end;

  inherited;
end;

procedure TProcessEntryList.Put(Index: Integer; const Value: PPROCESSENTRY32);
var
  Item: Pointer;
begin
  Item := inherited Get(Index);
  CopyMemory(Item, Value, SizeOf(tagPROCESSENTRY32));
end;

function TProcessEntryList.Get(Index: Integer): PPROCESSENTRY32;
begin
  Result := PPROCESSENTRY32(inherited Get(Index));
end;

function TProcessEntryList.Add(const Entry: TProcessEntry32): Integer;
var
  EntryCopy: PPROCESSENTRY32;
begin
  GetMem(EntryCopy, SizeOf(tagPROCESSENTRY32));
  CopyMemory(EntryCopy, @Entry, SizeOf(tagPROCESSENTRY32));

  Result := inherited Add(EntryCopy);  
end;

{ TProcessList }

constructor TProcessList.Create;
begin
  inherited;

  ProcessEntryList := TProcessEntryList.Create;
  ProcessIdHashTable := THashTable.Create;
end;

destructor TProcessList.Destroy;
begin
  FreeAndNil(ProcessIdHashTable);
  FreeAndNil(ProcessEntryList);

  inherited;
end;

function TProcessList.FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
var
  ItemIndex: Integer;
begin
  Result := nil;
  if not ProcessIdHashTable.ContainsKey(IntToStr(ProcessId)) then
    Exit;

  ItemIndex := Integer(ProcessIdHashTable.Item[IntToStr(ProcessId)]);
  Result := ProcessEntryList.Items[ItemIndex];
end;

procedure TProcessList.CreateSnapshot;
var
  SnapShot: THandle;
  ProcessEntry: TProcessEntry32;
  ItemIndex: Integer;
begin
  SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapShot <> 0 then
  try
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if Process32First(SnapShot, ProcessEntry) then
    repeat
      ItemIndex := ProcessEntryList.Add(ProcessEntry);
      ProcessIdHashTable.Add(IntToStr(ProcessEntry.th32ProcessID), TObject(ItemIndex));
    until not Process32Next(SnapShot, ProcessEntry);
  finally
    CloseHandle(SnapShot);
  end;
end;

Ответ 3

Основная форма приложения (Forms.application) будет равна нулю, если это не приложение на основе форм.

uses
  Forms, ... ;

function IsFormBased : boolean;
begin
  Result := Assigned(Forms.Application.MainForm);
end;

Ответ 4

Я сомневаюсь, что

System.IsConsole
System.IsLibrary

даст вам ожидаемые результаты.

Все, что я могу представить, это передать объект приложения как TObject методу, в котором вам нужно выполнить это различие и проверить, что переданный объект classname является

TServiceApplication 
or
TApplication

Тем не менее, вам не нужно знать, работает ли ваш код в службе или графическом интерфейсе. Вероятно, вы должны переосмыслить свой дизайн и заставить вызывающего передать объект для обработки сообщений, которые вы хотите (или не хотите) показывать. (Я предполагаю, что это для показа сообщений/исключений, которые вы хотели бы знать).

Ответ 5

Как насчет соответствия GetCurrentProcessId против EnumServicesStatusEx?
Параметр lpServices указывает на буфер, который получает массив структур ENUM_SERVICE_STATUS_PROCESS. Совпадение выполняется с идентификатором процесса перечисления: ServiceStatusProcess.dwProcessId в этой структуре.

Другая опция использует WMI для запроса Win32_Service экземпляров, где ProcessId=GetCurrentProcessId.

Ответ 6

Вы можете попробовать что-то вроде этого

Function IsMyformInsideaWindowsService(aForm:TObject) :Boolean;
Begin
   Result:=aForm.ClassParent.ClassName='TService';  //When a form is running under a service the Class Parent is a TService
End;

Ответ 7

Один проект не может (или, я должен сказать, в идеале не является) как сервисом, так и приложением форм, по крайней мере, если вы не можете отличить объект приложения Forms и SvcMgr Объект приложения - вы должны иметь отдельные проекты для кода форм и кода службы.

Поэтому, возможно, самым простым решением является условное определение проекта. т.е. в настройках вашего проекта для проекта службы добавьте " SERVICEAPP" в Условные Определения.

Тогда, когда вам нужно просто изменить поведение:

{$ifdef SERVICEAPP}
{$else}
{$endif}

Для ремней и брекетов вы можете принять один из ранее описанных тестов в рамках некоторого кода запуска, чтобы убедиться, что ваш проект скомпилирован с определенным символом.

program ... ;

 :

begin
{$ifdef SERVICEAPP}
  // test for service app - ASSERT if not
{$else}
  // test for forms app - ASSERT if not
{$endif}
  :
end.

Возможно, ваше приложение Forms фактически работает как служба, используя грубую технику, которая позволяет любому приложению запускаться как служба.

В этом случае ваше приложение всегда будет приложением Forms, и самый простой способ справиться с этой ситуацией - иметь переключатель командной строки, который вы укажете только в определении сервиса для своего исполняемого файла, поэтому что ваше приложение может ответить соответствующим путем тестирования этого ключа командной строки.

Это позволяет вам более легко тестировать поведение "режима обслуживания", так как вы можете запустить приложение в режиме "отладки" с помощью этого переключателя, определенного из среды IDE, но это не идеальный способ создания службы поэтому я бы не рекомендовал его только в силу этого. Это метод, который обычно используется только тогда, когда у вас есть EXE, который вы хотите запустить как услугу, но не имеете возможности изменить исходный код, чтобы превратить его в "правильную" службу.

Ответ 8

вы можете использовать метод GetStdHandle для получения консольного дескриптора. При запуске приложений, поскольку служба Windows не выводит console.if GetStdHandle равно нулю означает, что ваше приложение запускается как служба Windows.

{$APPTYPE CONSOLE} // important

uses
   uServerForm in 'uServerForm.pas' {ServerForm},
 uWinService in 'uWinService.pas' {mofidWinServer: TService},

  Windows,
  System.SysUtils,
  WinSvc,
  SvcMgr,
  Forms,etc;
function RunAsWinService: Boolean;
var
  H: THandle;
begin
  if FindCmdLineSwitch('install', ['-', '/'], True) then
    Exit(True);
  if FindCmdLineSwitch('uninstall', ['-', '/'], True) then
    Exit(True);
  H := GetStdHandle(STD_OUTPUT_HANDLE);
  Result := H = 0;
end;


begin       
  if RunAsWinService then
  begin

    SvcMgr.Application.Initialize;
    SvcMgr.Application.CreateForm(TmofidWinServer, mofidWinServer);
    SvcMgr.Application.Run;
  end
  else
  begin
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TServerForm, ServerForm);
    Forms.Application.Run;
  end;
end.

Ответ 9

Ответ от "Runner" (fooobar.com/questions/509894/...) выглядел очень полезным, но я не мог использовать его, поскольку не определены ни TProcessList, ни CreateSnapshot. Поиск "TProcessList CreateSnapshot" в Google просто найдет 7 страниц, включая этот, и зеркала/кавычки этой страницы. Нет кода. Увы, моя репутация слишком низкая, чтобы отправить ему комментарий, спросив, где я могу найти код TProcessList.

Другая проблема: на моем компьютере (Win7 x64) "services.exe" НЕ находится внутри "winlogon.exe". Он находится внутри "wininit.exe". Поскольку это, кажется, деталь реализации Windows, я предлагаю не запрашивать великого родителя. Кроме того, services.exe не обязательно должен быть прямым родителем, поскольку процессы могут быть разветвлены.

Итак, это моя версия, использующая TlHelp32 напрямую, решая все проблемы:

uses
  Classes, TlHelp32;

function IsRunningAsService: boolean;

  function FindProcess(FSnapshotHandle: THandle; PID: DWORD; var lppe: TProcessEntry32): boolean;
  var
    ContinueLoop: BOOL;
  begin
    ContinueLoop := Process32First(FSnapshotHandle, lppe);
    while Integer(ContinueLoop) <> 0 do
    begin
      if lppe.th32ProcessID = PID then
      begin
        result := true;
        Exit;
      end;
      ContinueLoop := Process32Next(FSnapshotHandle, lppe);
    end;
    result := false;
  end;

var
  CurProcessId: DWORD;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  ExeName, PrevExeName: string;
  DeadlockProtection: TList<Integer>;
begin
  Result := false;

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    CurProcessId := GetCurrentProcessId;
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ExeName := '';
    while FindProcess(FSnapshotHandle, CurProcessId, FProcessEntry32) do
    begin
      if DeadlockProtection.IndexOf(FProcessEntry32.th32ProcessID) > -1 then break;
      DeadlockProtection.Add(FProcessEntry32.th32ProcessID);

      PrevExeName := ExeName;
      ExeName     := FProcessEntry32.szExeFile;

      (*
      Result := SameText(PrevExeName, 'services.exe') and // Parent
                SameText(ExeName,     'winlogon.exe');    // Grandparent
      *)

      Result := SameText(ExeName, 'services.exe'); // Parent

      if Result then Exit;

      CurProcessId := FProcessEntry32.th32ParentProcessID;
    end;
  finally
    CloseHandle(FSnapshotHandle);
    DeadlockProtection.Free;
  end;
end;

Этот код работает, даже в приложениях без MainForm (например, приложений CLI).

Ответ 10

Проверьте, является ли ваш Applicatoin экземпляром TServiceApplication:

IsServiceApp := Application is TServiceApplication;

Ответ 11

Я не нашел простой ответ, который можно легко использовать и не требует перекомпиляции, и позволяет использовать один exe как службу и приложение. Вы можете установить свою программу в качестве службы с параметром командной строки, например "...\myapp.exe -s", а затем проверить ее из программы:

если ParamStr (ParamCount) = '-s', затем