首页 > 代码库 > Delphi 不使用自带模板创建服务

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

2024-09-02 17:14:11   219人阅读

[delphi] view plain copy
 
  1. <pre name="code" class="delphi">program Project1;  
  2.   
  3.   
  4. uses  
  5.   Windows,  
  6.   WinSvc;  
  7.   
  8.   
  9. const  
  10.   ServiceName: pchar = ‘SnowWings Service‘;  
  11.   DisplayName: pchar = ‘Skysword‘;  
  12.   Description: pchar = ‘雪羽服务器控制台‘;  
  13.   
  14.   
  15. var  
  16.   Status:       TServiceStatus;  
  17.   StatusHandle: SERVICE_STATUS_HANDLE;  
  18.   ServiceTable: array [0 .. 1] of TServiceTableEntry;  
  19.   Stopped:      boolean;  
  20.   Paused:       boolean;  
  21.   
  22.   
  23.   { 我们自己要实现的功能代码写在这里 }  
  24. procedure ServiceMain;  
  25. begin  
  26.   repeat  
  27.     if not Paused then  
  28.     begin  
  29.       // Beep(1000, 1000);  
  30.       Sleep(1000);  
  31.     end;  
  32.   until Stopped;  
  33. end;  
  34. { 服务处理程序：一个服务处理程序内可以包含一个服务或多个服务的执行代码，但是它们都拥有固定的三个部分：服务main函数，服务ServiceMain函数和服务Control Handler函数。 
  35.   服务配置程序：服务配置程序包括：服务的创建、服务的卸载、服务信息的查询、修改等； }  
  36.   
  37.   
  38. procedure ServiceCtrlHandler(Control: dword); stdcall; // 服务控制函数  
  39. begin  
  40.   case Control of  
  41.     SERVICE_CONTROL_STOP: // 停止服务  
  42.       begin  
  43.         Stopped               := True;  
  44.         Status.dwCurrentState := SERVICE_STOP_PENDING;  
  45.         SetServiceStatus(StatusHandle, Status);  
  46.       end;  
  47.     SERVICE_CONTROL_PAUSE: // 暂停服务  
  48.       begin  
  49.         Paused                := True;  
  50.         Status.dwCurrentState := SERVICE_PAUSED;  
  51.         SetServiceStatus(StatusHandle, Status);  
  52.       end;  
  53.     SERVICE_CONTROL_CONTINUE: // 继续服务  
  54.       begin  
  55.         Paused                := False;  
  56.         Status.dwCurrentState := SERVICE_RUNNING;  
  57.         SetServiceStatus(StatusHandle, Status);  
  58.       end;  
  59.     SERVICE_CONTROL_INTERROGATE:  
  60.       SetServiceStatus(StatusHandle, Status);  
  61.     SERVICE_CONTROL_SHUTDOWN:  
  62.       Stopped := True;  
  63.   end;  
  64. end;  
  65.   
  66.   
  67. procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;  
  68. begin  
  69.   StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);  
  70.   if StatusHandle <> 0 then  
  71.   begin  
  72.     ZeroMemory(@Status, SizeOf(Status));  
  73.     Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or  
  74.       SERVICE_INTERACTIVE_PROCESS;  
  75.     Status.dwCurrentState     := SERVICE_START_PENDING;  
  76.     Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or  
  77.       SERVICE_ACCEPT_PAUSE_CONTINUE;  
  78.     Status.dwWaitHint := 1000;  
  79.     SetServiceStatus(StatusHandle, Status);  
  80.     Stopped               := False;  
  81.     Paused                := False;  
  82.     Status.dwCurrentState := SERVICE_RUNNING;  
  83.     SetServiceStatus(StatusHandle, Status);  
  84.     ServiceMain; // 入口  
  85.     Status.dwCurrentState := SERVICE_STOPPED;  
  86.     SetServiceStatus(StatusHandle, Status);  
  87.   end;  
  88. end;  
  89.   
  90.   
  91. procedure UninstallService(ServiceName: pchar);  
  92. var  
  93.   SCManager: SC_HANDLE;  
  94.   Service:   SC_HANDLE;  
  95. begin  
  96.   SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  
  97.   if SCManager = 0 then  
  98.     Exit;  
  99.   try  
  100.     Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);  
  101.     ControlService(Service, SERVICE_CONTROL_STOP, Status);  
  102.     DeleteService(Service);  
  103.     CloseServiceHandle(Service);  
  104.   finally  
  105.     CloseServiceHandle(SCManager);  
  106.   end;  
  107. end;  
  108.   
  109.   
  110. /// ////////////////  
  111. { 添加一个服务的描述信息,你是否采用了更简洁的方法,这是一个例子 }  
  112. function SetServiceDescription(SH: THandle; Desc: pchar): Bool;  
  113. const  
  114.   SERVICE_CONFIG_DESCRIPTION: dword = 1;  
  115. var  
  116.   OSVersionInfo:        TOSVersionInfo;  
  117.   ChangeServiceConfig2: function(hService: SC_HANDLE; dwInfoLevel: dword;  
  118.     lpInfo: Pointer):   Bool; StdCall;  
  119.   LH:                   THandle;  
  120. begin  
  121.   Result                            := False;  
  122.   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);  
  123.   GetVersionEx(OSVersionInfo);  
  124.   if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and // NT? 环境判断 ，可以去掉  
  125.     (OSVersionInfo.dwMajorVersion >= 5) then  
  126.   begin  
  127.     LH     := GetModuleHandle(advapi32);  
  128.     Result := LH <> 0;  
  129.     if not Result then  
  130.       Exit;  
  131.     ChangeServiceConfig2 := GetProcAddress(LH, ‘ChangeServiceConfig2A‘);  
  132.     Result               := @ChangeServiceConfig2 <> nil;  
  133.     if not Result then  
  134.       Exit;  
  135.     Result := ChangeServiceConfig2(SH, SERVICE_CONFIG_DESCRIPTION, @Desc);  
  136.     { if Result then 
  137.       FreeLibrary(LH); }  
  138.   end;  
  139. end;  
  140.   
  141.   
  142. procedure InstallService(ServiceName, DisplayName, Description: pchar;  
  143.   FileName: string);  
  144. const  
  145.   SERVICE_CONFIG_DESCRIPTION: dword = 1;  
  146. var  
  147.   SCManager: SC_HANDLE;  
  148.   Service:   SC_HANDLE;  
  149.   Args:      pchar;  
  150. begin  
  151.   SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  
  152.   if SCManager = 0 then  
  153.     Exit;  
  154.   try  
  155.     Service := CreateService(SCManager, ServiceName, DisplayName,  
  156.       SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or  
  157.       SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE,  
  158.       pchar(FileName), nil, nil, nil, nil, nil);  
  159.     try  
  160.       SetServiceDescription(Service, Description);  
  161.     except  
  162.     end;  
  163.     Args := nil;  
  164.     StartService(Service, 0, Args);  
  165.     CloseServiceHandle(Service);  
  166.   finally  
  167.     CloseServiceHandle(SCManager);  
  168.   end;  
  169. end;  
  170.   
  171.   
  172. begin  
  173.   if ParamStr(1) = ‘/u‘ then  
  174.   begin  
  175.     UninstallService(ServiceName);  
  176.   end  
  177.   else  
  178.   begin  
  179.     ServiceTable[0].lpServiceName := ServiceName;  
  180.     ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;  
  181.     ServiceTable[1].lpServiceName := nil;  
  182.     ServiceTable[1].lpServiceProc := nil;  
  183.     StartServiceCtrlDispatcher(ServiceTable[0]);  
  184.     InstallService(ServiceName, DisplayName, Description,  
  185.       pchar(ParamStr(0)));  
  186.   end;  
  187.   
  188.   
  189. end.</pre><br>  
  190. <br>  
  191. <pre></pre>  
  192. <br>  
  193.      
 

http://blog.csdn.net/warrially/article/details/8258911

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


联系
我们