Определите при выполнении как Формы VCL или Сервис

Поскольку, если они были, они не будут в состоянии обвинить неточные голоса по калибровочные ошибки на сенсорном экране.

12
задан stukelly 14 October 2009 в 17:58
поделиться

6 ответов

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

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

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

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

1
ответ дан 2 December 2019 в 03:48
поделиться

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

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;
4
ответ дан 2 December 2019 в 03:48
поделиться

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

uses
  Forms, ... ;

function IsFormBased : boolean;
begin
  Result := Assigned(Forms.Application.MainForm);
end;
9
ответ дан 2 December 2019 в 03:48
поделиться

НАЧАЛО РЕДАКТИРОВАНИЯ

Поскольку этот вопрос все еще привлекает внимание, я решил обновить ответ, добавив в ответ недостающую информацию и новые патчи для 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;
9
ответ дан 2 December 2019 в 03:48
поделиться

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

System.IsConsole
System.IsLibrary

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

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

TServiceApplication 
or
TApplication

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

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

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

5
ответ дан 2 December 2019 в 03:48
поделиться

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

Так что, возможно, самый простой Решение - это условное определение проекта. т.е. в настройках вашего проекта для сервисного проекта добавьте « SERVICEAPP » к условным определениям.

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

3
ответ дан 2 December 2019 в 03:48
поделиться
Другие вопросы по тегам:

Похожие вопросы: