在服务里启动执行程序没有界面只有进程

dyonggan 2017-03-20 10:56:54
我在写一个服务程序,里面加一个定时器,定时器用来监控'Project1.exe'是否在运行,如果没有运行,调用winexe或ShellExecute启动该程序。现在我通过日志看到也执行了winexe或ShellExecute,通过资源管理器查看'Project1.exe'程序的进程也加进来了,就是看不到程序的界面。请老师指点迷津,不胜感激!


unit UService;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, ULog, TlHelp32, Registry,ShellAPI;

type
TService1 = class(TService)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
FTrying: Integer;
function getFilePath():String;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
Service1: TService1;

implementation

{$R *.DFM}

function KillTask(TaskName: String): Byte;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop) <> 0 do begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))= UpperCase(TaskName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(TaskName))) then
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
end;
end;

function GetMyOSVer: String;
var
VersionInfo : TOSVersionInfo;
OSName : String;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
if Windows.GetVersionEx( VersionInfo ) then
begin
with VersionInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s : OSName := 'Win32s';
VER_PLATFORM_WIN32_WINDOWS : OSName := 'Windows 95';
VER_PLATFORM_WIN32_NT : OSName := 'Windows NT';
end;
Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) +
#13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')';
end;
end
else
Result := '';
end;

procedure Reboot;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
var
hToken: THandle;
tkp: TTokenPrivileges;
tkpo: TTokenPrivileges;
zero: DWORD;
begin
if Pos( 'Windows NT', GetMyOSVer) = 1 then
begin
zero := 0;
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then Exit;
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then Exit;
if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[ 0 ].Luid ) then Exit;
tkp.PrivilegeCount := 1;
tkp.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;

AdjustTokenPrivileges( hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero );
if Boolean( GetLastError() ) then
Exit
else
ExitWindowsEx( EWX_FORCE or EWX_REBOOT , 0 );
end
else
begin
ExitWindowsEx( EWX_FORCE or EWX_REBOOT, 0 );
end;
end;

function IsAppRespondig9X(dwThreadId: DWORD): Boolean;
type
TIsHungThread = function(dwThreadId: DWORD): BOOL; stdcall;
var
hUser32: THandle;
IsHungThread: TIsHungThread;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungThread := GetProcAddress(hUser32, 'IsHungThread');
if Assigned(IsHungThread) then
begin
Result := not IsHungThread(dwThreadId);
end;
end;
end;


function IsAppRespondigNT(wnd: HWND): Boolean;
type
TIsHungAppWindow = function(wnd:hWnd): BOOL; stdcall;
var
hUser32: THandle;
IsHungAppWindow: TIsHungAppWindow;
begin
Result := True;
hUser32 := GetModuleHandle('user32.dll');
if (hUser32 > 0) then
begin
@IsHungAppWindow := GetProcAddress(hUser32, 'IsHungAppWindow');
if Assigned(IsHungAppWindow) then
begin
Result := not IsHungAppWindow(wnd);
end;
end;
end;

function IsAppRespondig(Wnd: HWND): Boolean;
begin
if not IsWindow(Wnd) then
begin
Exit;
end;
if Win32Platform = VER_PLATFORM_WIN32_NT then
Result := IsAppRespondigNT(wnd)
else
Result := IsAppRespondig9X(GetWindowThreadProcessId(Wnd,nil));
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;

function TService1.getFilePath: String;
var
IniPath:string;
reg:TRegistry;
begin
Result := '';
reg := TRegistry.Create;
try
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE', false) then
begin
if reg.OpenKey('HxExpress',True) then
begin
IniPath := reg.ReadString('IniPath');
if IniPath<>'' then
begin
if FileExists(IniPath+'Project1.exe') then
begin
Result := IniPath+'Project1.exe';
end
else
begin
Result := '';
end;
end
else
begin
Result := '';
end;
end
else
begin
Result := '';
end;
end
else
begin
Result := '';
end;
except
on e:Exception do
begin
Result := '';
end;
end;
finally
reg.CloseKey;
reg.Free;
end;

end;


function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TService1.Timer1Timer(Sender: TObject);
var
HM: HWND;
FileName:string;
FLog:TLog;
begin
FLog := TLog.Create;
FLog.WriteToFile('11');
HM := FindWindow(PChar('TForm2'), nil);
FLog.WriteToFile('12');
try
if HM <> 0 then
begin
FLog.WriteToFile('13');
if not IsAppRespondig(HM) then
begin
FLog.WriteToFile('14');
FileName := getFilePath();
FLog.WriteToFile('FileName:'+FileName);
if FileName<>'' then
begin
FLog.WriteToFile('15'+FileName);
KillTask(FileName);
Sleep(5000);
// Winexec(Pchar(FileName),SW_SHOW);
ShellExecute(HM,'open',PChar(FileName),nil,nil,SW_SHOWNORMAL);
Inc(FTrying);
if FTrying > 6 then
Reboot;
end;
end
else
begin
FLog.WriteToFile('17');
end;
end
else
begin
FLog.WriteToFile('16');
FileName := getFilePath();
FLog.WriteToFile('FileName:'+FileName);
if FileName<>'' then
begin
KillTask(FileName);
Sleep(5000);
//Winexec(Pchar(FileName),1);
ShellExecute(HM,'open',PChar(FileName),nil,nil,SW_SHOWNORMAL);
Inc(FTrying);
if FTrying > 6 then
Reboot;
end;
end;
finally
Flog.Free;
end;
end;

end.
...全文
25083 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
dyonggan 2017-03-23
  • 打赏
  • 举报
回复
引用 1 楼 lyhoo163 的回复:
 ShellExecute(Self.Handle,'open',PChar(FileName), nil, nil, SW_SHOWNORMAL); 
试试
我试了试,发现服务没有Handle属性
  • 打赏
  • 举报
回复
如果是在XP、2003上运行,可以服务属性里选上“允许与桌面交互”,否则只能用CreateProcessAsUser加载。参考:https://msdn.microsoft.com/en-us/library/windows/desktop/ms683502(v=vs.85).aspx
lyhoo163 2017-03-20
  • 打赏
  • 举报
回复
 ShellExecute(Self.Handle,'open',PChar(FileName), nil, nil, SW_SHOWNORMAL); 
试试

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧