請問如何編寫一個NT Service? |
尚未結案
|
naposhao
初階會員 發表:18 回覆:38 積分:31 註冊:2002-10-13 發送簡訊給我 |
各位大哥好: 小弟現正編寫一個NT Service的程式, 此程式應每隔約十五秒時間便會報時一次, 但小弟的程式只能於電腦開啟時, 執行一次檢查, 請各位高手指教!! 此程式共分為三個分段, 程式如下: {====================================================================}
program prjShutDown; uses
SvcMgr,
uShutControl in 'uShutControl.pas' {ShutDown2000: TService},
uShutThread in 'uShutThread.pas'; {$R *.RES} begin
Application.Initialize;
Application.CreateForm(TShutDown2000, ShutDown2000);
Application.Run;
end. {====================================================================} unit uShutControl; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
uShutThread; type
TShutDown2000 = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end; var
ShutDown2000: TShutDown2000;
DThread : ShutItDown; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall;
begin
ShutDown2000.Controller(CtrlCode);
end; function TShutDown2000.GetServiceController: TServiceController;
begin
Result := ServiceController;
end; procedure TShutDown2000.ServiceStart(Sender: TService; var Started: Boolean);
begin
DThread := ShutItDown.Create(False);
Started := true;
end; procedure TShutDown2000.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
DThread.Terminate;
Stopped := true;
end; procedure TShutDown2000.ServicePause(Sender: TService; var Paused: Boolean);
begin
DThread.Suspend;
Paused := True;
end; procedure TShutDown2000.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
DThread.Resume;
Continued := True;
end; end. {====================================================================} unit uShutThread; interface uses
Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF}, SysUtils, Dialogs; type
ShutItDown = class(TThread)
private
procedure SetName;
protected
procedure Execute; override;
end; implementation { Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure ShutItDown.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; } {$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF} { ShutItDown } procedure ShutItDown.SetName;
{$IFDEF MSWINDOWS}
var
ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
ThreadNameInfo.FType := $1000;
ThreadNameInfo.FName := 'ShutOnMyWay';
ThreadNameInfo.FThreadID := $FFFFFFFF;
ThreadNameInfo.FFlags := 0;
try
RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
except
end;
{$ENDIF}
end; procedure ShutItDown.Execute;
var HH, MM, SS, S100:word;
begin
// SetName;
{ Place thread code here }
if not Terminated then begin
DecodeTime(now, HH, MM, SS, S100);
ShowMessage('Running ' IntToStr(HH) ':' IntToStr(MM));
sleep(15000);
Resume;
end;
end; end.
|
william
版主 發表:66 回覆:2535 積分:3048 註冊:2002-07-11 發送簡訊給我 |
procedure ShutItDown.Execute; var HH, MM, SS, S100:word; begin // SetName; { Place thread code here } while not Terminated do begin DecodeTime(now, HH, MM, SS, S100); ShowMessage('Running ' IntToStr(HH) ':' IntToStr(MM)); sleep(15000); // Resume; end; end; |
naposhao
初階會員 發表:18 回覆:38 積分:31 註冊:2002-10-13 發送簡訊給我 |
|
naposhao
初階會員 發表:18 回覆:38 積分:31 註冊:2002-10-13 發送簡訊給我 |
|
william
版主 發表:66 回覆:2535 積分:3048 註冊:2002-07-11 發送簡訊給我 |
I think what you want is to create an interactive service. Set the Interactive property of your service to True. BTW, you codes do not free the thread, here is a modified one:
unit uShutControl; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, uShutThread; type TShutDown2000 = class(TService) procedure ServiceStart(Sender: TService; var Started: Boolean); procedure ServiceStop(Sender: TService; var Stopped: Boolean); procedure ServicePause(Sender: TService; var Paused: Boolean); procedure ServiceContinue(Sender: TService; var Continued: Boolean); procedure ServiceCreate(Sender: TObject); private { Private declarations } DThread : ShutItDown; public function GetServiceController: TServiceController; override; { Public declarations } end; var ShutDown2000: TShutDown2000; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall; begin ShutDown2000.Controller(CtrlCode); end; function TShutDown2000.GetServiceController: TServiceController; begin Result := ServiceController; end; procedure TShutDown2000.ServiceStart(Sender: TService; var Started: Boolean); begin if not Assigned(DThread) then DThread := ShutItDown.Create(False) else DThread.Resume; Started := true; end; procedure TShutDown2000.ServiceStop(Sender: TService; var Stopped: Boolean); begin if Assigned(DThread) then begin DThread.Terminate; DThread.WaitFor; FreeAndNil(DThread); end; Stopped := true; end; procedure TShutDown2000.ServicePause(Sender: TService; var Paused: Boolean); begin DThread.Suspend; Paused := True; end; procedure TShutDown2000.ServiceContinue(Sender: TService; var Continued: Boolean); begin DThread.Resume; Continued := True; end; procedure TShutDown2000.ServiceCreate(Sender: TObject); begin DThread := nil; end; end.In fact, service is a special kind of thread and you could write your checking code inside the OnExecute event instead of creating another thread. |
naposhao
初階會員 發表:18 回覆:38 積分:31 註冊:2002-10-13 發送簡訊給我 |
|
naposhao
初階會員 發表:18 回覆:38 積分:31 註冊:2002-10-13 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |