求一简单NT服务程序

Question

本人初学NT服务程序，不得要领，想求一简单例子学习（自带的scktsrvr太复杂：）
要求：简单，完整，能不停地执行某一过程（例如：SendSMS()，我知道是在一个线程的Execute事件里调用）
谢谢

Answer 1

http://www.52delphi.com/tips/delphi/system/25102302101.htm运用Delphi编写Windows NT中服务程序 
 
作者：不详    发布时间：2002-10-30    阅读642 次    类型：[转载] 
 
 
---- Windows NT服务程序不同于一般的运行程序，它不需要NT登录进去，只需要开机进入NT系统便可以运行，一般用于系统服务方面的应用，学会编写NT服务程序对网络管理人员而言是非常重要的，Delphi4.0作为一种高效、快速、强大的开发语言，为开发NT服务程序提供了非常便捷的方法，加上其可视化界面以及与数据库的完美结合，使我们开发与数据库有关的NT服务程序变得非常简单，下面以编写一个NT定期备份程序为例，介绍如何运用Delphi编写Windows NT的服务程序。 ---- 打开Delphi编辑器，选择菜单中的File|New，在New Item中选择Service Application项，Delphi便自动为你建立一个基于TServiceApplication的新工程，TserviceApplication是一个封装NT服务程序的类，它包含一个Tservice1对象以及服务程序的装卸、注册、取消方法。 ---- 将Tservice1对象的属性做下列更改： DisplayName与Name改为：DataBackup，
ServiceStartName属性改为系统管理员
用户(如DOMAIN\Administrator)和Password则输入用户密码---- 这样，服务程序运行时将自己以该用户的权限操作NT。 ---- 这样，一个NT服务程序编写已经完成，在Delphi编辑器中选择菜单Run|Parameters，在Parameters中输入/install，程序编译运行后，一个名为DataBackup的NT服务程序已经安装好，你可以双击控制面板中的服务项目，将会看到此服务程序，只是此服务程序没有任何东西而已；在Delphi编辑器中选择菜单Run|Parameters，在Parameters中输入/uninstall，程序编译运行后，系统将会将此服务程序卸掉。 ---- 服务程序是通过控制一个线程的生成、暂停、继续、停止来达到服务目的的，因此我们必须加入一个Tsession对象来编写文件自动备份代码，在Delphi编辑器中选择菜单中的File|New，在New Item中选择Thread Object项，Delphi会提示你为该Tsession对象输入一个名称(输入DataCopy),Delphi便生成了一个基于Tsession的DataCopy对象，并提供了一个Execute过程供重载，我们要Execute过程中输入以下程序： var
   Hour, Min, Sec, MSec: Word;
   TimeStamp,DirectoryEdit1,DirectoryEdit2:String;
   SearchRec: TSearchRec;
   Source,Temp,Dest:Pchar;
   F,F1:THandle;
   FF,FF1:WIN32_FIND_DATA;
Begin
   {每次文件备份执行时间}
   TimeStamp:='12:00';
   {文件备份源目录}
   DirectoryEdit1:='C:\temp';
   {文件备份目录}
   DirectoryEdit2:='C:\temp1';
   while True do
       begin
        DecodeTime(Time,Hour, Min, Sec, MSec);
          IF Trim(TimeStamp)=Format
('%-2.2d:%-2.2d',[Hour,Min]) then
          begin
            GetMem(Source,250);
            GetMem(Dest,250);
            GetMem(Temp,250);StrPcopy(Dest,DirectoryEdit2+''+FormatDateTime('YYYYMMDD',Date));
CreateDirectory(Dest,nil);
IFFindFirst(DirectoryEdit1+'\*.*',faAnyFile,
 SearchRec)=0 then
              begin
                repeat
StrPcopy(Source,DirectoryEdit1+'\'+SearchRec.Name);StrPcopy(Dest,DirectoryEdit2+'\'
+FormatDateTime('YYYYMMDD',Date)+'\'+SearchRec.Name);
                  copyfile(Source,Dest,False);
                until FindNext(SearchRec)< >0;
              end;
            SysUtils.FindClose(SearchRec);
           FindClose(F);
           FreeMem(Source,250);
           FreeMem(Dest,250);
           FreeMem(Temp,250);
          end;
        sleep(60000);
   end;end;---- 此线程执行时每隔一分钟将检查一次时间，看是否到了备份时间，如果是则将DirectoryEdit1中的所有文件拷到DirectoryEdit2目录中去。 
---- 现在编写服务控制DataCopy线程的代码，在TdataBackup对象中的OnStart、OnStop、OnPause、OnContinue事件中分别输入如下代码： procedure TDataBackup.DataBackupStart
(Sender: TService;
  var Started: Boolean);
begin
   DataThread:= TDataCopy.Create(False);
   Started := True;
end;procedure TDataBackup.DataBackupStop
(Sender: TService;
  var Stopped: Boolean);
begin
  DataThread.Terminate;
  Stopped := True;
end;procedure TDataBackup.DataBackupPause
(Sender: TService;
  var Paused: Boolean);
begin
  DataThread.Suspend;
  Paused := True;
end;procedure TDataBackup.DataBackupContinue
(Sender: TService;
  var Continued: Boolean);
begin
  DataThread.Resume;
  Continued := True;
end;---- 这样一个文件自动备份程序已经完成，编译好后，加上/install参数执行程序，系统会将此服务程序安装，由于服务程序中StartType属性为stAuto，NT每次启动时，此程序自动执行，你可以在控制面板中的服务项目来启动、暂停、恢复、停止它，也可以加上/uninstall参数执行程序来卸掉它。通过上述例子我们可以看到，用Delphi编写NT服务器程序十分方便，而且你也可以在Tservice对象上加许多非可视化控件来与数据库关联，实现很多复杂的功能。

Answer 2

为什么老兄都是找到这个例子呢
（我用GOOGLE或者直接在CSDN里搜索都有这个例子）
但遗憾的是，用这个例子我本没有看到它备份呀，
当然也没有出错，难道大家就没有一个实用一点的例子吗
当然还是谢谢这位仁兄。

Answer 3

怎么没人关注呀
CSDN怎么会是这样子了呀？？》》》

Answer 4

在OnExecute中写个循环,加上循环结束条件即可.其他的delphi都给你封装好了.

Answer 5

to： westfly(西翔)
  那如果是用线程呢

Answer 6

//我现在这样可以了，但服务停不下来
procedure TService1.ServiceExecute(Sender: TService);
begin
  while True do
  begin
    //do something
    Sleep(60000);
  end;
end;

Answer 7

>>但遗憾的是，用这个例子我本没有看到它备份呀，
根據你提的要求, 我貼出來的這個例子, 我覺得比較簡單, 說得也清楚!!你在線程中的 ONExcute中加個
將while True do
改為:
while not Terminated do
begin
 YouProcedure();
end;就可啊!!!

Answer 8

http://passmatlab.myetang.com/DELPHI/article/system/03.htm

Answer 9

//我一用线程就不能执行服务了。不知怎么回事，以下是我的代码，请大家指教：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceShutdown(Sender: TService);
    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
  Service1: TService1;implementationuses Unit2;{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  WriteTimeThread :=WriteTime.Create(False);
  Started := True;
end;procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  WriteTimeThread.Terminate;
  WriteTimeThread.Free;
  Stopped := True;
end;procedure TService1.ServiceShutdown(Sender: TService);
begin
  WriteTimeThread.Terminate;
  WriteTimeThread.Free;
end;procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
  WriteTimeThread.Suspend;
  Paused := True;
end;procedure TService1.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  WriteTimeThread.Resume;
  Continued := True;
end;end.

Answer 10

unit Unit2;interfaceuses
  Classes,Sysutils,windows;type
  WriteTime = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;var
  WriteTimeThread : WriteTime;implementation{ WriteTime }procedure WriteTime.Execute;
var
  f: TextFile;
begin
  AssignFile(f, 'd:\s.txt');
  Append(f);
  while not Terminated do
  begin
    Writeln(f,DateTimeToStr(Now));
    Flush(f);    
    Sleep(60000);
  end;
  CloseFile(f);
end;end.

Answer 11

unit SerAppAriu;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;var
  Service1: TService1;implementationuses unit2;
{$R *.DFM}
var
  WriteTimeThread: TWriteTime;procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  WriteTimeThread := TWriteTime.Create(False);
  Started := True;
end;
procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
  WriteTimeThread.Suspend;
  Paused := True;
end;procedure TService1.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  WriteTimeThread.Resume;
  Continued := True;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  WriteTimeThread.Terminate;
  WriteTimeThread.WaitFor;
  WriteTimeThread.Free;
  Stopped := True;
end;end.

Answer 12

unit Unit2;interfaceuses
  Classes,Sysutils,windows;type
  TWriteTime = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;var
  WriteTimeThread : TWriteTime;implementation{ WriteTime }procedure TWriteTime.Execute;
var
  f: TextFile;
begin
  FreeOnTerminate := false;
  AssignFile(f, 'd:\s.txt');
  Append(f);
  while not Terminated do
  begin
    Writeln(f,DateTimeToStr(Now));
    Flush(f);    
    Sleep(1000);
  end;
  CloseFile(f);
end;end.

Answer 13

你的代碼有些小問題, 我改正了, 在我的電腦試驗, 很正常!!1, 'd:\s.txt' 現在的代碼, 必須保證這個文件存在, 要麼你要加些檢查的代碼, 如沒有, 則建立先, 要不然, 會出錯的!2, 在Delphi编辑器中选择菜单Run|Parameters，在Parameters中输入/install，程序编译运行后，
註冊後, 服務是沒有啟動的, 要麼你重新開機, 要麼在服務中手動啟動才開始工作!!如果還有不懂, 參考上面我第一個回復!
再是重申, 上面的代碼, 在我的機器上測試過, 正常, 如果你的不正常, 先檢查自己的原因!

Answer 14

美女真是好, 隨便說几句
>>我帮不上什么忙，只能帮你顶！
就能
>>谢谢各位的热情帮助，特别是百合妹妹呵呵!!!!

Answer 15

to aiirii(ari-爱的眼睛) :
  谢谢您的热情帮助，我的QQ是：34939858，能交你这个朋友吗？
  现在唯一的问题是：正常启动服务后，并没有往“D:\s.txt”文件中写日志
  注：“D:\s.txt”已经存在再启动服务的。  我怀疑是某些用户没有权限，我又把登录用户设置为系统管理员了，
  服务能正常启动、重启、停止，但就是不写日志。
  你那里能写日志吗，你估计这是什么原因呢？

Answer 16

没在D下写过服务,
在DOTNET下写很容易
:)

Answer 17

我如果把“TWriteTime.Execute”写日志的代码直接写到
Service1.Execute事件中，就能正常写日志，但那样一来
又不能停止服务了。

Answer 18

to aiirii(ari-爱的眼睛) :
  终于可以了
  刚才复制你的代码后，
  关联Service1的那几个事件时，
  竟然漏掉了关联“Start”事件，
  呵呵，好高兴，我结帖了
  --------------------------
  --------------------------
  对了，如果您高兴的话，别忘了加我QQ：34939858
  再一次向你说声“谢谢”