當然守護程式 要隱蔽 不要輕易被用戶關掉 給個思路
開始 想做個 windows 服務程式 后來發現 不能跟有界面的exe打交道
uj5u.com熱心網友回復：
做一個 守護程式 檢測另外一個exe是否運行 沒運行就啟動他function TWin32Utils.IsRunning(const AExeName: String): Boolean;
var
szExeName: String;
hSnapshot: THandle;
rEntry32 : TProcessEntry32;
bExists : Boolean;
begin
Result := False;
szExeName := ExtractFileName(AExeName);
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
try
rEntry32.dwSize := Sizeof(rEntry32);
bExists := Process32First(hSnapshot,rEntry32);
while bExists do
begin
if Pos(UpperCase(rEntry32.szExeFile), UpperCase(szExeName)) > 0 then
begin
Result := True;
Break;
end;
bExists := Process32Next(hSnapshot, rEntry32);
end;
finally
CloseHandle(hSnapshot);
end;
end;
當然守護程式 要隱蔽 不要輕易被用戶關掉 給個思路
做一個互相守護方案，A程式中存在一個定時器，定時檢查并啟動B程式，B程式中也存在一個定時器，定時檢查并啟動A程式
開始 想做個 windows 服務程式 后來發現 不能跟有界面的exe打交道
TService.Interactive := True;
uj5u.com熱心網友回復：
感謝樓上回答我開始做的是 windows服務程式 里面定時器 檢測B程式是否運行
Interactive := True;
測驗發現 ShellExecute(0,'open','d:\mytest.exe',nil,nil,SW_SHOWNORMAL); 呼叫B程式時 會報錯 (估計B 有界面的 原因)
uj5u.com熱心網友回復：
winexec試下，我用winexec是沒有問題的uj5u.com熱心網友回復：
winexec('d:\mytest.exe',sw_normal);uj5u.com熱心網友回復：
你是 在什么作業系統 下 測驗的 ？ win2003 win7 下測驗 B程式 界面 都無法顯示
uj5u.com熱心網友回復：
目前問題是 ：win2003 win7 下測驗 B程式 界面 無法顯示 但行程中存在
如果B程式正常作業這樣也可以 (單獨運行B程式是可以顯示界面的)
uj5u.com熱心網友回復：
我的服務器伴侶，通過它每10秒檢測服務器是否運行，如果關閉重新啟動服務器。uj5u.com熱心網友回復：
按照gobiz的思路應該可以。行程里面有的話，它實際上有效果嗎？
uj5u.com熱心網友回復：
請問你的 服務器伴侶 是windows服務嗎 ？ 能給出的 你的思路嗎
uj5u.com熱心網友回復：
可以使用互斥來判斷，exe程式是否在運行。uj5u.com熱心網友回復：
1、程式設定成處啟動模式，開機就啟動；2、程式使用VCL視窗，平時托盤形式，必要時打開視窗。
3、定時5分鐘：搜索EXE的行程，搜索不到，就重新啟動ＥＸＥ。
uj5u.com熱心網友回復：
MArk
uj5u.com熱心網友回復：
win7 下用戶互動桌面 不能實作。可以單獨做一個服務來守護你的程式。
.exe';
end;
procedure TEDSClientMonitorService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
EnableDebugPrivilege;
KillTask(FLocalFileName);
IntAndSet('Cose');
CloseHandle(Mh);
Stopped := true;
//WTSSendMessage(0, WTSGetActiveConsoleSessionId(), 'ss', 4, 'ddddd', 12, 0, 0, s, false);
end;
procedure TEDSClientMonitorService.SetDescription(const Desc: string);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
with reg do begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('SYSTEM\CurrentControlSet\Services\'+Name,false) then
begin
WriteString('Description',Desc);
end;
CloseKey;
end;
finally
reg.Free;
end;
end;
procedure TEDSClientMonitorService.MonitorTimer(Sender: TObject);
var
f: string;
hh, MI: string;
nowtime: TDatetime;
i: integer;
begin
Monitor.Enabled := False;
Monitor.Interval := 1000;
try
nowtime := now;
DateTimeToString(hh, 'hh', nowtime);
DateTimeToString(mi, 'nn', nowtime);
//每天定時重啟
if (hh = '13') and (mi = '30') then
begin
Sleep(60000);
ReStart();
end
else
begin
//超過一天自動重啟
if round((Gettickcount - Fcur) / 1000) > 86400 then
begin
Sleep(60000);
ReStart();
exit;
end;
if ReadMsg = 'Cose' then
begin
Wlog('用戶呼叫關閉服務');
exit;
end;
i := FindProcessID(FLocalFileName);
f := ExtractFilePath(ParamStr(0)) + FLocalFileName;
if i = 0 then
begin
LaunchAppIntoDifferentSession(Pchar(f));
end
else
begin
if i > 1 then
begin
EnableDebugPrivilege;
KillTask(FLocalFileName);
LaunchAppIntoDifferentSession(Pchar(f));
//RefreshTrayIcon();
RemoveDeadIcons();
end;
end;
end;
finally
Monitor.Enabled := True;
end;
end;
uj5u.com熱心網友回復：
uses
Windows, Messages, SysUtils, TlHelp32, Classes, SvcMgr,
SysUnit, ExtCtrls,Registry;
const
CSServiceDescription = '服務描述資訊';
type
TEDSClientMonitorService = class(TService)
Monitor: TTimer;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceCreate(Sender: TObject);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ReStart();
procedure MonitorTimer(Sender: TObject);
procedure ServiceAfterInstall(Sender: TService);
private
MutexNameClient: string;
MutexNameServer: string;
Mh: Cardinal;
//將創建行程的檔案名
FLocalFileName: pchar;
Fcur: Dword;
function AppRunOnce(): boolean;
procedure SetDescription(const Desc: string);
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
EDSClientMonitorService: TEDSClientMonitorService;
implementation
uses ServiceControl;
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
EDSClientMonitorService.Controller(CtrlCode);
end;
//
function TEDSClientMonitorService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
function TEDSClientMonitorService.AppRunOnce(): boolean;
var
MutexHandle: THandle;
s, gt: Cardinal;
begin
MutexHandle := OpenMutex(MUTEX_ALL_ACCESS, True, PChar(MutexNameClient));
gt := GetLastError;
if gt = Error_ALREADY_EXISTS then
begin
result := true;
exit;
end;
if (MutexHandle <> 0) then
begin
result := true;
end
else
begin
Mh := CreateMutex(nil, True, PChar(MutexNameClient));
s := GetLastError();
if (s = ERROR_ALREADY_EXISTS) then
begin
CloseHandle(Mh);
end;
result := false;
end;
end;
//
procedure TEDSClientMonitorService.ServiceStart(Sender: TService;
var Started: Boolean);
var
sfilename: string;
begin
Fcur := Gettickcount;
try
IntAndSet('Start');
sfilename := ExtractFilePath(ParamStr(0)) + FLocalFileName;
if AppRunOnce then
begin
exit;
end;
// LaunchAppIntoDifferentSession(Pchar(sfilename));
except
end;
end;
procedure TEDSClientMonitorService.ReStart();
var
B: boolean;
begin
ServiceStop(self, b);
EnableDebugPrivilege;
KillTask(FLocalFileName);
RefreshTrayIcon();
RemoveDeadIcons();
ServiceStart(self, b);
end;
procedure TEDSClientMonitorService.ServiceAfterInstall(Sender: TService);
begin
SetDescription(CSServiceDescription);
end;
procedure TEDSClientMonitorService.ServiceCreate(Sender: TObject);
begin
MutexNameClient := PChar(ExtractFilePath(ParamStr(0)));
MutexNameClient := StringReplace(MutexNameClient, '\', '', [rfReplaceAll]);
MutexNameClient := StringReplace(MutexNameClient, ':', '', [rfReplaceAll]);
MutexNameServer := MutexNameClient + 'Server';
FLocalFileName := 'Myapp.exe';
end;
procedure TEDSClientMonitorService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
EnableDebugPrivilege;
KillTask(FLocalFileName);
IntAndSet('Cose');
CloseHandle(Mh);
Stopped := true;
//WTSSendMessage(0, WTSGetActiveConsoleSessionId(), 'ss', 4, 'ddddd', 12, 0, 0, s, false);
end;
procedure TEDSClientMonitorService.SetDescription(const Desc: string);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
with reg do begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('SYSTEM\CurrentControlSet\Services\'+Name,false) then
begin
WriteString('Description',Desc);
end;
CloseKey;
end;
finally
reg.Free;
end;
end;
procedure TEDSClientMonitorService.MonitorTimer(Sender: TObject);
var
f: string;
hh, MI: string;
nowtime: TDatetime;
i: integer;
begin
Monitor.Enabled := False;
Monitor.Interval := 1000;
try
nowtime := now;
DateTimeToString(hh, 'hh', nowtime);
DateTimeToString(mi, 'nn', nowtime);
//每天定時重啟
if (hh = '13') and (mi = '30') then
begin
Sleep(60000);
ReStart();
end
else
begin
//超過一天自動重啟
if round((Gettickcount - Fcur) / 1000) > 86400 then
begin
Sleep(60000);
ReStart();
exit;
end;
if ReadMsg = 'Cose' then
begin
Wlog('用戶呼叫關閉服務');
exit;
end;
i := FindProcessID(FLocalFileName);
f := ExtractFilePath(ParamStr(0)) + FLocalFileName;
if i = 0 then
begin
LaunchAppIntoDifferentSession(Pchar(f));
end
else
begin
if i > 1 then
begin
EnableDebugPrivilege;
KillTask(FLocalFileName);
LaunchAppIntoDifferentSession(Pchar(f));
//RefreshTrayIcon();
RemoveDeadIcons();
end;
end;
end;
finally
Monitor.Enabled := True;
end;
end;
end
上一個沒貼全
uj5u.com熱心網友回復：
大牛，借鑒，非常感謝uj5u.com熱心網友回復：
我覺得可以寫個驅動隱藏守護行程uj5u.com熱心網友回復：
寫個驅動？看起來思路很獨特，給大家講一下？
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/63149.html
標籤：VCL組件開發及應用