InStall SerVice Demo

{      InStall SerVice Demo     }
{                               }
{      2011元旦By[haiou327]     }
{                               }
{                               }
var
  status: string;

function InstallService(PathName, Name, DisplayName: PChar): Boolean;
var
  schSCManager, schService: THANDLE;
  //strDir: array[0..1023] of char;
  //lpszBinaryPathName: PChar;
begin
  schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if schSCManager = 0 then
  begin
    MessageBox(0, '联接服务控制管理器失败', 'Error', MB_OK);
    Result := false;
    exit;
  end;
  //GetCurrentDirectory(1024, strDir); // 取到应用程序所在的目录
  //strlcat(strDir, '\ScvProject.exe', 1024); // 当前目录下的服务应用
  //lpszBinaryPathName := strDir;
  schService := CreateService(
    schSCManager, // 服务控制管理句柄
    Name, // 服务名称 需要和 服务应用名 相同
    DisplayName, // 显示的服务名称
    SERVICE_ALL_ACCESS, // 存取权利
    SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, // 服务类型 and SERVICE_INTERACTIVE_PROCESS
    SERVICE_AUTO_START, // 启动类型
    SERVICE_ERROR_NORMAL, // 错误控制类型
    PathName, // 服务程序
    nil, // 组服务名称
    nil, // 组标识
    nil, // 依赖的服务
    nil, // 启动服务帐号
    nil); // 启动服务口令
  if schService = 0 then
  begin
    MessageBox(0, '无法建立指定的服务对象', 'Error', MB_OK);
    Result := false; exit;
  end;
  CloseServiceHandle(schService);
  MessageBox(0, '已经成功地安装了服务对象', '信息', MB_OK);
  Result := true;
end;


function StartService(AServName: string): Boolean; //use WinSvc
var
  SCManager, hService: SC_HANDLE;
  lpServiceArgVectors: PChar;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  Result := SCManager <> 0;
  if Result then
  try
    hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);
    Result := hService <> 0;
    if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then
      Exception.Create('The specified service does not exist');
    if hService <> 0 then
    try
      lpServiceArgVectors := nil;
      Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));
      if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then
        Result := True;
    finally
      CloseServiceHandle(hService);
    end;
  finally
    CloseServiceHandle(SCManager);
  end;
end;


function StopService(AServName: string): Boolean;
var
  SCManager, hService: SC_HANDLE;
  SvcStatus: TServiceStatus;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  Result := SCManager <> 0;
  if Result then
  try
    hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);
    Result := hService <> 0;
    if Result then
    try //停止并卸载服务;
      Result := ControlService(hService, SERVICE_CONTROL_STOP, SvcStatus);
      //删除服务，这一句可以不要;
     DeleteService(hService);
    finally
      CloseServiceHandle(hService);
    end;
  finally
    CloseServiceHandle(SCManager);
  end;
end;


function GetServiceStatusString(sServiceName: string): string;
var
  hService, hSCManager: SC_HANDLE;
  SS: TServiceStatus;
begin
  hSCManager := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
  if hSCManager = 0 then
  begin
    result := 'Can not open the service control manager';
    exit;
  end;
  hService := OpenService(hSCManager, PChar(sServiceName), SERVICE_QUERY_STATUS);
  if hService = 0 then
  begin
    CloseServiceHandle(hSCManager);
    result := 'Can not open the service';
    exit;
  end;
  if not QueryServiceStatus(hService, SS) then
    result := 'Can not query the service status'
  else
  begin
    case SS.dwCurrentState of
      SERVICE_CONTINUE_PENDING:
        result := 'continue is pending';
      SERVICE_PAUSE_PENDING:
        result := ' pause is pending';
      SERVICE_PAUSED:
        result := ' is paused';
      SERVICE_RUNNING:
        result := 'is running';
      SERVICE_START_PENDING:
        result := 'is starting';
      SERVICE_STOP_PENDING:
        result := 'is stopping';
      SERVICE_STOPPED:
        result := 'is not running';
    else
      result := 'Unknown Status';
    end;
  end;
  CloseServiceHandle(hSCManager);
  CloseServiceHandle(hService);
end;

procedure scanstatus;
begin
  begin
    status := GetServiceStatusString('test');
    //Form1.btn1.Caption:='安装服务';
    Form1.lbl1.Caption := status;
    Form1.btn1.Enabled := True;
    Form1.btn2.Enabled := True;
    Form1.btn3.Enabled := True;
    if status = 'is not running' then
    begin
      Form1.btn1.Caption:='服务已安装';
      Form1.btn3.Caption:='已停止...';
      Form1.btn2.Caption:='运行服务';
      Form1.btn1.Enabled := False;
      Form1.btn3.Enabled := False;
    end;
    if status = 'is running' then
    begin
      Form1.btn1.Caption:='服务已安装';
      Form1.btn2.Caption:='运行中...';
      Form1.btn3.Caption:='停止服务';
      Form1.btn1.Enabled := False;
      Form1.btn2.Enabled := False;
    end;
    if status = 'is starting' then
    begin
      Form1.btn1.Caption:='服务已安装';
      Form1.btn2.Caption:='运行中...';
      Form1.btn1.Enabled := False;
      Form1.btn2.Enabled := False;
    end;
    if status = 'Can not open the service' then
    begin
      Form1.btn1.Caption:='安装服务';;
      Form1.btn2.Caption:='运行服务';
      Form1.btn3.Caption:='停止服务';
      Form1.btn2.Enabled := False;
      Form1.btn3.Enabled := False;
    end;
  end;
end;


procedure TForm1.btn1Click(Sender: TObject);
begin
  InstallService(PChar(ExtractFileDir(ParamStr(0))+'\sct.exe'), 'Test', '0haiou');
  status := GetServiceStatusString('test');
  ScanStatus;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  if StartService('TEst') = True then
    ShowMessage('服务启动成功')
  else
    ShowMessage('error');
  scanstatus;
end;


procedure TForm1.btn3Click(Sender: TObject);
begin
  if StopService('TEst') = True then
    ShowMessage('成功停止')
  else
    ShowMessage('error');
  scanstatus;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  scanstatus;
end;