小巧的服务程序源码(转)

    前段时间因要写服务程,但发现程序比较大,不包含窗口类的情况下都要120K以上!实在是太大了! svchost.exe服务程序的大小才 7.76 KB,我想服务程序可以写的很小!
我在网上找找了好长时间终于给我找到精简的服务程序的DELPHI代码(好的DELPHI代码实在是少啊), 我把源代码放上来和大家分享!


program DemoSrv;

Windows NT Service Demo program for Delphi 3
  By Tom Lee, Taiwan, Repubilc of China(Tomm.bbs@csie.nctu.edu.tw)
    JUL 8 1997
    ver 1.01
    The Service will Beep every 10 second.


uses SysUtils, Windows, WinSvc;

const
  ServiceName = 'TomDemoService';
  ServiceDisplayName = 'd99 test 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_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;

  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, 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);
    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, ServiceDisplayName,
      SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, SERVICE_DEMAND_START,
      SERVICE_ERROR_NORMAL, pchar(ParamStr(0)), nil, nil, nil, nil, nil);
    if (schService 0) then
    begin
      Writeln('Install Ok.');
      CloseServiceHandle(schService);
    end
    else
      Writeln('Unable to install ' + ServiceName + ',createService Fail.');
  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_ALL_ACCESS);
    if (schService 0) then
    begin
      try to stop Service at first
        if ControlService(schService, SERVICE_CONTROL_STOP, ssStatus) then
        begin
          Write('Stopping Service ');
          Sleep(1000);
          while (QueryServiceStatus(schService, ssStatus)) do
          begin
            if ssStatus.dwCurrentState = SERVICE_STOP_PENDING 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 = @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.

              (此文原出处:http://www.delphifans.com/infoview/Article_704.html

 

 

 

posted @ 2011-01-28 12:41  bingege  阅读(289)  评论(0编辑  收藏  举报