如何安装一个系统服务?

http://borland.mblogger.cn/aiirii/posts/2968.aspx安裝與刪除指定Service

运用Delphi编写Windows NT中服务程序 (2000年7月29日)
---- 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每次启动时，此程序自动执
行，你可以在控制面板中的服务项目来启动、暂停、恢复、停止

VCL源码，如何安装服务procedure TServiceApplication.RegisterServices(Install, Silent: Boolean);  procedure InstallService(Service: TService; SvcMgr: Integer);
  var
    TmpTagID, Svc: Integer;
    PTag, PSSN: Pointer;
    Path: string;
  begin
    Path := ParamStr(0);
    with Service do
    begin
      if Assigned(BeforeInstall) then BeforeInstall(Service);
      TmpTagID := TagID;
      if TmpTagID > 0 then PTag := @TmpTagID else PTag := nil;
      if ServiceStartName = '' then
        PSSN := nil else
        PSSN := PChar(ServiceStartName);
      Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName),
        SERVICE_ALL_ACCESS, GetNTServiceType, GetNTStartType, GetNTErrorSeverity,
        PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies),
        PSSN, PChar(Password));
      TagID := TmpTagID;
      if Svc = 0 then
        RaiseLastOSError;
      try
        try
          if Assigned(AfterInstall) then AfterInstall(Service);
        except
          on E: Exception do
          begin
            DeleteService(Svc);
            raise;
          end;
        end;
      finally
        CloseServiceHandle(Svc);
      end;
    end;
  end;  procedure UninstallService(Service: TService; SvcMgr: Integer);
  var
    Svc: Integer;
  begin
    with Service do
    begin
      if Assigned(BeforeUninstall) then BeforeUninstall(Service);
      Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS);
      if Svc = 0 then RaiseLastOSError;
      try
        if not DeleteService(Svc) then RaiseLastOSError;
      finally
        CloseServiceHandle(Svc);
      end;
      if Assigned(AfterUninstall) then AfterUninstall(Service);
    end;
  end;
var
  SvcMgr: Integer;
  i: Integer;
  Success: Boolean;
  Msg: string;
begin
  Success := True;
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr = 0 then RaiseLastOSError;
  try
    for i := 0 to ComponentCount - 1 do
      if Components[i] is TService then
      try
        if Install then
          InstallService(TService(Components[i]), SvcMgr) else
          UninstallService(TService(Components[i]), SvcMgr)
      except
        on E: Exception do
        begin
          Success := False;
          if Install then
            Msg := SServiceInstallFailed else
            Msg := SServiceUninstallFailed;
          with TService(Components[i]) do
            MessageDlg(Format(Msg, [DisplayName, E.Message]), mtError, [mbOK],0);
        end;
      end;
    if Success and not Silent then
      if Install then
        MessageDlg(SServiceInstallOK, mtInformation, [mbOk], 0) else
        MessageDlg(SServiceUninstallOK, mtInformation, [mbOk], 0);
  finally
    CloseServiceHandle(SvcMgr);
  end;
end;

谢谢各位,,
谢谢 Kingron的回答.这正是我想要的..

调试易

如何安装一个系统服务?

解决方案 »