delphi 自动安装成服务 ????

[china_hcnet]

有一个问题..郁闷了很久了............就是把程序写成....服务的时候....不知是能否像..双击EXE 那样的..双击自动就注册

服务呢???? 当然我所讲.. 并不是在生成的EXE 加上 /install 参数来安装................不知可否实现...服务程序编译

好后..双击成自动自己把自己安装成系统服务.....不知可朋友..能否实现呢....????????

[china_hcnet]

Thanks , help !!!!!!!!

这些代码对我太有用了.................

[budded]

WinExec(PChar('YourService.exe /install /silent'), 0);

或者，抄一段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;

[僵哥]

可以参考ScktSrvr.dpr。低版本可以在Source\VCL目录下找到，新版Delphi可以在Source\Win32\db目录下找到。
里面有这样一段：

  if Installing or StartService then
  begin
    SvcMgr.Application.Initialize;
    SocketService := TSocketService.CreateNew(SvcMgr.Application, 0);
    SvcMgr.Application.CreateForm(TSocketForm, SocketForm);
    SvcMgr.Application.Run;
  end else
  begin
    
    Forms.Application.ShowMainForm := False;
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TSocketForm, SocketForm);
    SocketForm.Initialize(False);
    Forms.Application.Run;
  end;

你可以把服务的安装代码写在后面的else代码当中(不能用SvcMgr当中自带的注册，否则会搜索命令行开关）。

[constantine]

mark

[wangwest]

谢谢

[mihi1978]

mark