服务停止问题

[XD王]

界面控制系统服务的安装、启动、停止和卸载，其中全部函数均为winAPI函数。
在未使用界面之前，服务的4个功能都可以良好的实现，未出现异常。
但是
在嵌入到界面中后，服务停止时，在任务管理器中显示的服务进程并没有马上销毁。
而是在10几秒后 ，产生一个错误报告才销毁。在服务管理器中 启动和停止服务，结果一样。

疑问：是否是因为界面的问题？ 还是创建的服务本身有问题？（可是在未用界面时可以正常实现。。）
求高手指点~~

[XD王]

program AServiceTest;

uses
windows, Messages, ShellApi, WinSvc,SvcMgr, SysUtils,Dialogs;

{$R *.res}
const
id_Button1 = 100;
id_Button2 = 200;
id_Button3 = 300;
id_Button4 = 400;
id_Button5 = 500;
id_Button6 = 600;
Qidong = 7 ;
Tingzhi = 8 ;
Xiezai = 9 ;
ServiceName = 'AServiceTest';
ServiceDisplayName='AService';

var
ServiceStatusHandle:SERVICE_STATUS_HANDLE;
ssStatus:TServiceStatus;
dwErr:DWORD;
ServiceTableEntry:array [0..1] of TServiceTableEntry;
hServerStopEvent:THandle;

// Get error message
function GetLastErrorText:string;
var
dwSize:DWORD;
lpszTemp:LPSTR;
begin
dwSize:=512;
lpszTemp:=nil;
try
GetMem(lpszTemp,dwSize);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil,GetLastError,LANG_NEUTRAL,lpszTemp,dwSize,nil);
finally
Result:=StrPas(lpszTemp);
FreeMem(lpszTemp);
end;
end;

// Write error message to Windows NT Event Log
procedure AddToMessageLog(sMsg:string);
var
sString:array [0..1] of string;
hEventSource:THandle;
begin
hEventSource:=RegisterEventSource(nil,ServiceName);

if hEventSource>0 then
begin
sString[0]:=ServiceName+' error: '+IntToStr(dwErr);
sString[1]:=sMsg;
ReportEvent(hEventSource,EVENTLOG_ERROR_TYPE,0,0,nil,2,0,@sString,nil);
DeregisterEventSource(hEventSource);
end;
end;

function ReportStatusToSCMgr(dwState,dwExitCode,dwWait:DWORD):BOOL;
begin
Result:=True;
with ssStatus do
begin
if (dwState=SERVICE_START_PENDING) then
dwControlsAccepted:=0
else
dwControlsAccepted:=SERVICE_ACCEPT_STOP;

dwCurrentState:=dwState;
dwWin32ExitCode:=dwExitCode;
dwWaitHint:=dwWait;

if (dwState=SERVICE_RUNNING) or (dwState=SERVICE_STOPPED) then
dwCheckPoint:=0
else
inc(dwCheckPoint);
end;

Result:=SetServiceStatus(ServiceStatusHandle,ssStatus);
if not Result then AddToMessageLog('SetServiceStauts');
end;

procedure ServiceStop;
begin
if (hServerStopEvent>0) then
begin
SetEvent(hServerStopEvent);
end;
end;

procedure ServiceStart;
var
dwWait:DWORD;
begin
// Report Status
if not ReportStatusToSCMgr(SERVICE_START_PENDING,NO_ERROR,3000) then exit;
hServerStopEvent:=CreateEvent(nil,TRUE,False,nil);
if hServerStopEvent=0 then
begin
AddToMessageLog('CreateEvent');
exit;
end;
if not ReportStatusToSCMgr(SERVICE_RUNNING,NO_ERROR,0) then
begin
CloseHandle(hServerStopEvent);
exit;
end;
// Service now running , perform work until shutdown
while True do
begin
// Wait for Terminate
MessageBeep(1);
dwWait:=WaitforSingleObject(hServerStopEvent,1);
if dwWait=WAIT_OBJECT_0 then
begin
CloseHandle(hServerStopEvent);
exit;
end;
Sleep(1000*30); //23 秒 临界 销毁时不发生错误 ？？
end;
end;

procedure Handler(dwCtrlCode:DWORD);stdcall;
begin
// Handle the requested control code.
case dwCtrlCode of

SERVICE_CONTROL_STOP:
begin
ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0);
ServiceStop;
ReportStatusToSCMgr(SERVICE_STOPPED,GetLastError,0);
exit;
end;

SERVICE_CONTROL_INTERROGATE:
begin
end;

SERVICE_CONTROL_PAUSE:
begin
end;

SERVICE_CONTROL_CONTINUE:
begin
end;

SERVICE_CONTROL_SHUTDOWN:
begin
end;

// invalid control code
else
end;

// Update the service status.
ReportStatusToSCMgr(ssStatus.dwCurrentState, NO_ERROR, 0);
end;

procedure ServiceMain;
begin
// Register the handler function with dispatcher;
ServiceStatusHandle:=RegisterServiceCtrlHandler(ServiceName,ThandlerFunction(@Handler));
if ServiceStatusHandle=0 then
begin
ReportStatusToSCMgr(SERVICE_STOPPED,GetLastError,0);
exit;
end;

ssStatus.dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
ssStatus.dwServiceSpecificExitCode:=0;
ssStatus.dwCheckPoint:=1;

// Report current status to SCM (Service Control Manager)
if not ReportStatusToSCMgr(SERVICE_START_PENDING,NO_ERROR,3000) then
begin
ReportStatusToSCMgr(SERVICE_STOPPED,GetLastError,0);
exit;
end;
// Start Service
ServiceStart;
end;

procedure InstallService;
var
schService:SC_HANDLE;
schSCManager:SC_HANDLE;
lpszPath:LPSTR;
dwSize:DWORD;
begin
dwSize:=512;
GetMem(lpszPath,dwSize);
if GetModuleFileName(0,lpszPath,dwSize)=0 then
begin
FreeMem(lpszPath);
MessageDlg('Unable to install.',mtError,[mbOk],0);
exit;
end;
FreeMem(lpszPath);

schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if (schSCManager>0) then
begin
schService:=CreateService(schSCManager,ServiceName,ServiceDisplayName,
SERVICE_ALL_ACCESS,SERVICE_WIN32_OWN_PROCESS,SERVICE_AUTO_START,
SERVICE_ERROR_IGNORE,lpszPath,nil,nil,nil,nil,nil);

if (schService>0) then
begin
MessageDlg('Install OK.',mtInformation,[mbOk],0);
CloseServiceHandle(schService);
end
else
MessageDlg('Install Fail.',mtError,[mbOk],0);
end
else
MessageDlg('Unable to install.',mtError,[mbOk],0);
end;


procedure UnInstallService;
var
schService:SC_HANDLE;
schSCManager:SC_HANDLE;
begin
schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
if (schSCManager>0) then
begin
schService:=OpenService(schSCManager,ServiceName,SERVICE_ALL_ACCESS);
if (schService>0) then
begin
// Try to stop service at first
if ControlService(schService,SERVICE_CONTROL_STOP,ssStatus) then
begin
//returns the most recent service status information reported
while (QueryServiceStatus(schService,ssStatus)) do
begin
if ssStatus.dwCurrentState=SERVICE_STOP_PENDING then
begin
Write('.');
Sleep(1000);
end
else
break;
end;

if ssStatus.dwCurrentState<>SERVICE_STOPPED then
begin
CloseServiceHandle(schService);
CloseServiceHandle(schSCManager);
MessageDlg('Service Stop Fail.',mtError,[mbOk],0);
exit;
end;
end;

// Remove the service
if (DeleteService(schService)) then
MessageDlg('Service Uninstall Ok.',mtInformation,[mbOk],0)
else
MessageDlg('DeleteService fail .',mtError,[mbOk],0);

CloseServiceHandle(schService);
end
else
MessageDlg('OpenService fail .',mtError,[mbOk],0);
CloseServiceHandle(schSCManager);
end
else
MessageDlg('Open Service fail .',mtError,[mbOk],0);
end;

[XD王]

function PlainWinProc(hWnd:THandle; nMsg:UINT;
  wParam,lParam:Cardinal):Cardinal;export;stdcall;
var
  Rect:TRect;
begin
  result:=0;

  case nMsg of
    wm_Create:
     begin
      CreateWindowEx(0,'Button','&HELLO',ws_Child or ws_Visible or
                        ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button1,hInstance,nil);
      CreateWindowEx(0,'Button','&退出',ws_Child or ws_Visible or
                        ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button2,hInstance,nil);
      CreateWindowEx(0,'Button','&安装服务',ws_Child or ws_Visible or
                        ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button3,hInstance,nil);
      CreateWindowEx(0,'Button','&启动服务',ws_Child or ws_Visible or
                        ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button4,hInstance,nil);
      CreateWindowEx(0,'Button','&停止服务',ws_Child or ws_Visible or
                       ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button5,hInstance,nil);
      CreateWindowEx(0,'Button','&卸载服务',ws_Child or ws_Visible or
                        ws_Border or bs_PushButton,
                        0,0,80,30,hWnd,id_Button6,hInstance,nil);
     end;
    wm_Size:
     begin
      GetClientRect(hWnd,Rect);
      SetWindowPos(GetDlgItem(hWnd,id_Button1),0,Rect.Right div 2-215,
                   Rect.Bottom div 2-50,0,0,swp_NoZOrder or swp_NoSize);
      SetWindowPos(GetDlgItem(hWnd,id_Button2),0,Rect.Right div 2-65,
                 Rect.Bottom div 2-50,0,0,swp_NoZOrder or swp_NoSize);
      SetWindowPos(GetDlgItem(hWnd,id_Button3),0,Rect.Right div 2-300,
                 Rect.Bottom div 2-10,0,0,swp_NoZOrder or swp_NoSize);
      SetWindowPos(GetDlgItem(hWnd,id_Button4),0,Rect.Right div 2-200,
                 Rect.Bottom div 2-10,0,0,swp_NoZOrder or swp_NoSize);
      SetWindowPos(GetDlgItem(hWnd,id_Button5),0,Rect.Right div 2-100,
                 Rect.Bottom div 2-10,0,0,swp_NoZOrder or swp_NoSize);
      SetWindowPos(GetDlgItem(hWnd,id_Button6),0,Rect.Right div 2,
                 Rect.Bottom div 2-10,0,0,swp_NoZOrder or swp_NoSize);

     end;

    wm_Command:               //按键触发
    begin
        case    LoWord(wParam) of
             id_Button1:
                    begin
                        if HiWord(wParam)=bn_Clicked then
                           MessageBox(hWnd,'OK','Demo',MB_OK);
                    end;
             id_Button2:
                    begin
                        if HiWord(wParam)=bn_Clicked then
                         Halt;
                    end;
             id_Button3:            //安装
                    begin
                        if HiWord(wParam)=bn_Clicked then
                           InstallService;
                    end;
             id_Button4:            //启动
                    begin
                        if HiWord(wParam)=bn_Clicked then
                            StartClick;
                    end;
             id_Button5:            //停止
                    begin
                        if HiWord(wParam)=bn_Clicked then
                            StopClick;
                    end;
             id_Button6:            //卸载
                    begin
                        if HiWord(wParam)=bn_Clicked then
                          UnInstallService;
                    end;
           end;

    end;

    wm_DropFiles:
      begin
        MessageBox(hWnd,'Drop File','Plain API',MB_OK);
        DragFinish(wParam);
      end;

    wm_Destroy:
         PostQuitMessage(0);
    else

         result:=DefWindowProc(hWnd,nMsg,wParam,lParam);
    end;
end;

procedure WinMain;
var
  hWnd,hWnd2:THandle;
  Msg:TMsg;
  Rect:TRect;
  WndClassEx:TWndClassEx;
  wParam:Cardinal;
begin
  WndClassEx.cbSize:=SizeOf(TWndClassEx);
  WndClassEx.lpszClassName:='PlainWindow';
  WndClassEx.style:=CS_HREDRAW or CS_VREDRAW;
  WndClassEx.hInstance:=Hinstance;
  WndClassEx.lpfnWndProc:=@PlainWinProc;
  WndClassEx.cbClsExtra:=0;
  WndClassEx.cbWndExtra:=0;
  WndClassEx.hIcon:=LoadIcon(Hinstance,Pchar('MAINICON'));
  WndClassEx.hIconSm:=LoadIcon(Hinstance,Pchar('MAINICON'));
  WndClassEx.hCursor:=LoadCursor(0,idc_Arrow);
  WndClassEx.hbrBackground:=GetStockObject(black_Brush);
  WndClassEx.lpszMenuName:=nil;

  if RegisterClassEx(WndClassEx)=0 then
  begin
    MessageBox(0,'Invaild Class registration','Plain API',MB_OK);
    exit;
  end
  else begin
    hWnd:=CreateWindowEx( WS_EX_ACCEPTFILES,
                         WndClassEx.lpszClassName,
                         'Demo',ws_OverlappedWindow,
                         cw_UseDefault,0,cw_UseDefault,0,0,0,
                         Hinstance,nil);
    if hWnd=0 then
      MessageBox(0,'Window not Created','Demo',MB_OK)
    else begin
      ShowWindow(hwnd,SW_ShowNormal);
      while GetMessage(Msg,0,0,0) do
         begin
            TranslateMessage(Msg);
            DispatchMessage(Msg);
                    ServiceTableEntry[0].lpServiceName:=ServiceName;
         ServiceTableEntry[0].lpServiceProc:=TServiceMainFunction(@ServiceMain);
         ServiceTableEntry[1].lpServiceName:=nil;
         ServiceTableEntry[1].lpServiceProc:=nil;
         if not StartServiceCtrlDispatcher(ServiceTableEntry[0]) then
           begin
             AddToMessageLog('StartServiceCtrlDispatcher Error!');
           end;
         end;
      end;
   end;
end;


begin
   WinMain;

end.

以上 是程序全部代码

[XD王]

已经解决了，是服务分派机的问题。。。

[XD王]

已经解决了，是服务分派机的问题。。。

[Alex-16888]

贴出错误信息