【转】Delphi 不使用自带模板创建服务

program Project1;


uses
  Windows,
  WinSvc;


const
  ServiceName: pchar = 'SnowWings Service';
  DisplayName: pchar = 'Skysword';
  Description: pchar = '雪羽服务器控制台';


var
  Status:       TServiceStatus;
  StatusHandle: SERVICE_STATUS_HANDLE;
  ServiceTable: array [0 .. 1] of TServiceTableEntry;
  Stopped:      boolean;
  Paused:       boolean;


  { 我们自己要实现的功能代码写在这里 }
procedure ServiceMain;
begin
  repeat
    if not Paused then
    begin
      // Beep(1000, 1000);
      Sleep(1000);
    end;
  until Stopped;
end;
{ 服务处理程序：一个服务处理程序内可以包含一个服务或多个服务的执行代码，但是它们都拥有固定的三个部分：服务main函数，服务ServiceMain函数和服务Control Handler函数。
  服务配置程序：服务配置程序包括：服务的创建、服务的卸载、服务信息的查询、修改等； }


procedure ServiceCtrlHandler(Control: dword); stdcall; // 服务控制函数
begin
  case Control of
    SERVICE_CONTROL_STOP: // 停止服务
      begin
        Stopped               := True;
        Status.dwCurrentState := SERVICE_STOP_PENDING;
        SetServiceStatus(StatusHandle, Status);
      end;
    SERVICE_CONTROL_PAUSE: // 暂停服务
      begin
        Paused                := True;
        Status.dwCurrentState := SERVICE_PAUSED;
        SetServiceStatus(StatusHandle, Status);
      end;
    SERVICE_CONTROL_CONTINUE: // 继续服务
      begin
        Paused                := False;
        Status.dwCurrentState := SERVICE_RUNNING;
        SetServiceStatus(StatusHandle, Status);
      end;
    SERVICE_CONTROL_INTERROGATE:
      SetServiceStatus(StatusHandle, Status);
    SERVICE_CONTROL_SHUTDOWN:
      Stopped := True;
  end;
end;


procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;
begin
  StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
  if StatusHandle <> 0 then
  begin
    ZeroMemory(@Status, SizeOf(Status));
    Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or
      SERVICE_INTERACTIVE_PROCESS;
    Status.dwCurrentState     := SERVICE_START_PENDING;
    Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or
      SERVICE_ACCEPT_PAUSE_CONTINUE;
    Status.dwWaitHint := 1000;
    SetServiceStatus(StatusHandle, Status);
    Stopped               := False;
    Paused                := False;
    Status.dwCurrentState := SERVICE_RUNNING;
    SetServiceStatus(StatusHandle, Status);
    ServiceMain; // 入口
    Status.dwCurrentState := SERVICE_STOPPED;
    SetServiceStatus(StatusHandle, Status);
  end;
end;


procedure UninstallService(ServiceName: pchar);
var
  SCManager: SC_HANDLE;
  Service:   SC_HANDLE;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then
    Exit;
  try
    Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
    ControlService(Service, SERVICE_CONTROL_STOP, Status);
    DeleteService(Service);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;


/// ////////////////
{ 添加一个服务的描述信息,你是否采用了更简洁的方法,这是一个例子 }
function SetServiceDescription(SH: THandle; Desc: pchar): Bool;
const
  SERVICE_CONFIG_DESCRIPTION: dword = 1;
var
  OSVersionInfo:        TOSVersionInfo;
  ChangeServiceConfig2: function(hService: SC_HANDLE; dwInfoLevel: dword;
    lpInfo: Pointer):   Bool; StdCall;
  LH:                   THandle;
begin
  Result                            := False;
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and // NT? 环境判断 ，可以去掉
    (OSVersionInfo.dwMajorVersion >= 5) then
  begin
    LH     := GetModuleHandle(advapi32);
    Result := LH <> 0;
    if not Result then
      Exit;
    ChangeServiceConfig2 := GetProcAddress(LH, 'ChangeServiceConfig2A');
    Result               := @ChangeServiceConfig2 <> nil;
    if not Result then
      Exit;
    Result := ChangeServiceConfig2(SH, SERVICE_CONFIG_DESCRIPTION, @Desc);
    { if Result then
      FreeLibrary(LH); }
  end;
end;


procedure InstallService(ServiceName, DisplayName, Description: pchar;
  FileName: string);
const
  SERVICE_CONFIG_DESCRIPTION: dword = 1;
var
  SCManager: SC_HANDLE;
  Service:   SC_HANDLE;
  Args:      pchar;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then
    Exit;
  try
    Service := CreateService(SCManager, ServiceName, DisplayName,
      SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or
      SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE,
      pchar(FileName), nil, nil, nil, nil, nil);
    try
      SetServiceDescription(Service, Description);
    except
    end;
    Args := nil;
    StartService(Service, 0, Args);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;


begin
  if ParamStr(1) = '/u' then
  begin
    UninstallService(ServiceName);
  end
  else
  begin
    ServiceTable[0].lpServiceName := ServiceName;
    ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
    ServiceTable[1].lpServiceName := nil;
    ServiceTable[1].lpServiceProc := nil;
    StartServiceCtrlDispatcher(ServiceTable[0]);
    InstallService(ServiceName, DisplayName, Description,
      pchar(ParamStr(0)));
  end;


end.