Поскольку, если они были, они не будут в состоянии обвинить неточные голоса по калибровочные ошибки на сенсорном экране.
Фактически я закончил проверку переменной application.showmainform .
Проблема с isFormBased skamradt в том, что часть этого кода вызывается до создания основной формы.
Я использую программную библиотеку под названием SvCom_NTService от aldyn-software. Одна из целей - ошибки; либо для их регистрации, либо для отображения сообщения. Я полностью согласен с @Rob; наш код следует лучше поддерживать и обрабатывать это вне функций.
Другое предназначение - для неудачных соединений и запросов к базе данных; У меня другая логика в моих функциях для открытия запросов. Если это сервис, он вернет nil, но продолжит процесс. Но если в приложении возникают неудачные запросы / соединения, я хотел бы отобразить сообщение и остановить приложение.
Вы можете попробовать что-то вроде этого
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;
Основная форма объекта приложения (Forms.application) будет равна нулю, если это не приложение на основе форм.
uses
Forms, ... ;
function IsFormBased : boolean;
begin
Result := Assigned(Forms.Application.MainForm);
end;
НАЧАЛО РЕДАКТИРОВАНИЯ
Поскольку этот вопрос все еще привлекает внимание, я решил обновить ответ, добавив в ответ недостающую информацию и новые патчи для 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;
Я сомневаюсь, что
System.IsConsole
System.IsLibrary
даст вам ожидаемые результаты.
Все, что я могу придумать, - это передать объект Application как TObject методу, где вам нужно сделать это различие и проверить, является ли имя класса переданного объекта равным
TServiceApplication
or
TApplication
Тем не менее, не должно быть ' Вам необходимо знать, выполняется ли ваш код в службе или в графическом интерфейсе. Вероятно, вам следует переосмыслить свой дизайн и заставить вызывающего абонента передавать объект для обработки сообщений, которые вы хотите (или не хотите) отображать. (Я предполагаю, что он предназначен для отображения сообщений / исключений, которые вы хотели бы знать).
вам не нужно знать, выполняется ли ваш код в службе или в графическом интерфейсе. Вероятно, вам следует переосмыслить свой дизайн и заставить вызывающего абонента передавать объект для обработки сообщений, которые вы хотите (или не хотите) отображать. (Я предполагаю, что он предназначен для отображения сообщений / исключений, которые вы хотели бы знать). вам не нужно знать, выполняется ли ваш код в службе или в графическом интерфейсе. Вероятно, вам следует переосмыслить свой дизайн и заставить вызывающего абонента передавать объект для обработки сообщений, которые вы хотите (или не хотите) отображать. (Я предполагаю, что он предназначен для отображения сообщений / исключений, которые вы хотели бы знать).Отдельный проект не может (или я должен сказать, что в идеале не является) одновременно службой и приложением форм, по крайней мере, если вы можете различать объект приложения Forms и объект SvcMgr Application - предположительно, у вас должны быть отдельные проекты для кода форм и кода службы.
Так что, возможно, самый простой Решение - это условное определение проекта. т.е. в настройках вашего проекта для сервисного проекта добавьте « SERVICEAPP » к условным определениям.
Затем, когда вам нужно изменить поведение, просто: mode с этим переключателем, определенным в среде IDE, но это не идеальный способ создания служебного приложения, поэтому я бы не рекомендовал его только на основании этого. Это метод, который обычно используется только тогда, когда у вас есть EXE, который вы хотите запустить как службу, но у вас нет возможности изменить исходный код, чтобы превратить его в «правильную» службу.