各位大哥好: 小弟現正編寫一個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.

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;

謝謝版主的指導, 但當中出現了一個小錯誤: 「應用程式發生例外, 不明的軟體例外錯誤(0x0eedfade)於位置0x77e69b01」 請版主繼續教我, 謝謝

謝謝版主的指導, 但當中出現了一個小錯誤: 「應用程式發生例外, 不明的軟體例外錯誤(0x0eedfade)於位置0x77e69b01」 請版主繼續教我, 謝謝

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.

To 版主William, 首先是多謝版主的建議及教導,但小弟因最近這星期面對考試, 會於日後試用更改後的程式, 到時再向版主報告是否程式編寫成功。 From : Napo Shao

多謝William的Email及建議, 現正研究, 已初步掌握, 若有成品將於日後放上討論區。