首页  编辑  

非常小巧的服务

Tags: /超级猛料/Core.驱动,VxD,服务/   Date Created:

非常小巧的服务

下面的服务实际上是按照标准的Windows的服务编写过程来做,Delphi封装的服务的确不太好,一运行占用内存太多,同时线程数过多。

//------------------------------------------------------//

program DemoSrv;

// Windows NT Service Demo Program for Delphi 3

// By Tom Lee , Taiwan , Repubilc of China  ( Tomm.bbs@csie.nctu.edu.t

w )

// JUL 8 1997

// ver 1.01

// The service will beep every 10 second .

uses SysUtils,Windows,WinSvc,Dialogs;

const

    ServiceName='TomDemoService';

    ServiceDisplayName='Tom Lee Demo Service';

    SERVICE_WIN32_OWN_PROCESS=$00000010;

    SERVICE_DEMAND_START=$00000003;

    SERVICE_ERROR_NORMAL=$00000001;

    EVENTLOG_ERROR_TYPE=$0001;

// declare global variable

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_ARG

UMENT_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,@sS

tring,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) th

en

             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) t

hen exit;

    // Create the event object. The control handler function signals

    // this event when it receives the "stop" control code.

    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*10);

    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,Thand

lerFunction(@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) t

hen

    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);

//          Writeln('123');

         Writeln('Unable to install '+ServiceName+',GetModuleFileName

Fail.');

         exit;

    end;

    FreeMem(lpszPath);

    schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

    if (schSCManager>0) then

    begin

         schService:=CreateService(schSCManager,ServiceName,ServiceDi

splayName,

         SERVICE_ALL_ACCESS,SERVICE_WIN32_OWN_PROCESS,SERVICE_DEMAND_

START,

         SERVICE_ERROR_NORMAL,lpszPath,nil,nil,nil,nil,nil);

         if (schService>0) then

         begin

              Writeln('Install Ok.');

              CloseServiceHandle(schService);

         end

         else

//          Writeln('123');

           Writeln('Unable to install '+ServiceName+',CreateService F

ail.');

    end

    else

        Writeln('Unable to install '+ServiceName+',OpenSCManager Fail

.');

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_AL

L_ACCESS);

          if (schService>0) then

          begin

               // Try to stop service at first

               if ControlService(schService,SERVICE_CONTROL_STOP,ssSt

atus) then

               begin

                    Write('Stopping Service ');

                    Sleep(1000);

                    while (QueryServiceStatus(schService,ssStatus)) d

o

                    begin

                         if ssStatus.dwCurrentState=SERVICE_STOP_PEND

ING then

                         begin

                              Write('.');

                              Sleep(1000);

                         end

                         else

                             break;

                    end;

                    writeln;

                    if ssStatus.dwCurrentState=SERVICE_STOPPED then

                       Writeln('Service Stop Now')

                    else

                    begin

                         CloseServiceHandle(schService);

                         CloseServiceHandle(schSCManager);

                         Writeln('Service Stop Fail');

                         exit;

                    end;

               end;

               // Remove the service

               if (DeleteService(schService)) then

                   Writeln('Service Uninstall Ok.')

               else

                   Writeln('DeleteService fail ('+GetLastErrorText+')

.');

               CloseServiceHandle(schService);

          end

          else

              Writeln('OpenService fail ('+GetLastErrorText+').');

          CloseServiceHandle(schSCManager);

    end

    else

        Writeln('OpenSCManager fail ('+GetLastErrorText+').');

end;

// Main Program Begin

begin

    if (ParamCount=1) then

    begin

         if ParamStr(1)='/?' then

         begin

              Writeln('----------------------------------------');

              Writeln('DEMOSRV usage help');

              Writeln('----------------------------------------');

              Writeln('DEMOSRV /install to install the service');

              Writeln('DEMOSRV /remove to uninstall the service');

              Writeln('DEMOSRV /? Help');

              Halt;

         end;

         if Uppercase(ParamStr(1))='/INSTALL' then

         begin

              InstallService;

              Halt;

         end;

         if Uppercase(ParamStr(1))='/REMOVE' then

         begin

              UnInstallService;

              Halt;

         end;

    end;

    // Setup service table which define all services in this process

    with ServiceTableEntry[0] do

    begin

         lpServiceName:=ServiceName;

         lpServiceProc:=TServiceMainFunction(@ServiceMain);

    end;

    // Last entry in the table must have nil values to designate the

end of the table

    with ServiceTableEntry[1] do

    begin

         lpServiceName:=nil;

         lpServiceProc:=nil;

    end;

    if not StartServiceCtrlDispatcher(ServiceTableEntry[0]) then

    begin

         AddToMessageLog('StartServiceCtrlDispatcher Error!');

         Halt;

    end;

end.

//------------------------------------------------------//