Solved

Applicatiuon running in service under WinNT

Posted on 1998-03-19
3
236 Views
Last Modified: 2010-04-06
Hi Yee,

I've got a problem. I'd like to write a program wich runs
under WindowsNT, among the services.
How can I do that?

Thanks in advance

Andrew
0
Comment
Question by:bandi081497
  • 2
3 Comments
 
LVL 3

Expert Comment

by:altena
ID: 1360619
You can, but it will be hard.

I prefer to write these in C/C++, but there is
no reason why you cannot do this in Delphi.

Read all material on services from the microsoft developer
network (available online: www.microsoft.com/msdn)

I learned a lot from the "simple-service" sample (in c) that
is in the win32-SDK. You should download that one too from the
msdn site.

But take your time, as this will not be easy.
0
 
LVL 2

Expert Comment

by:greendot
ID: 1360620
Here is a code example I picked up a while back somewhere...
I'm not sure if it works or not.  I have yet to compile it, but it might be your answer.

---------------------------------------------------------

unit DemoService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, WinSvc;

const
     ServiceName='DemoService';  

type
  TfrmMain = class(TForm)
    cmdStart: TButton;
    cmdStop: TButton;
    stsMessage: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdStopClick(Sender: TObject);
    procedure cmdStartClick(Sender: TObject);
  private
    { Private declarations }
    schService:SC_HANDLE;
    schSCManager:SC_HANDLE;
    ssStatus:TServiceStatus;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}


procedure TfrmMain.FormCreate(Sender: TObject);
begin
     schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
     if (schSCManager<=0) then
     begin
          MessageDlg('Demo Service is not installed.',mtError,[mbOk],0);
          Application.Terminate;
     end;

     schService:=OpenService(schSCManager,ServiceName,SERVICE_ALL_ACCESS);
     if (schService<=0) then
     begin
          MessageDlg('Demo Service can not open.',mtError,[mbOk],0);
          Application.Terminate;
     end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     CloseServiceHandle(schService);
     CloseServiceHandle(schSCManager);
end;

procedure TfrmMain.cmdStopClick(Sender: TObject);
begin
     if ControlService(schService,SERVICE_CONTROL_STOP,ssStatus) then
     begin
          stsMessage.SimpleText:='Stopping Service Now ';
          Sleep(1000);
          while (QueryServiceStatus(schService,ssStatus)) do
          begin
               Application.ProcessMessages;
               if ssStatus.dwCurrentState=SERVICE_STOP_PENDING then
               begin
                    stsMessage.SimpleText:=stsMessage.SimpleText+('.');
                    Sleep(1000);
               end
               else
                   break;
          end;

          if ssStatus.dwCurrentState=SERVICE_STOPPED then
              stsMessage.SimpleText:='Service Stop Ok'
          else
              stsMessage.SimpleText:='Service Stop Fail';
     end
     else
         stsMessage.SimpleText:='Service Stop Fail';
end;

procedure TfrmMain.cmdStartClick(Sender: TObject);
var
   Argv:PChar;
begin
     if StartService(schService,0,Argv) then
     begin
          stsMessage.SimpleText:='Start Service Now ';
          Sleep(1000);
          while (QueryServiceStatus(schService,ssStatus)) do
          begin
               Application.ProcessMessages;
               if ssStatus.dwCurrentState=SERVICE_START_PENDING then
               begin
                    stsMessage.SimpleText:=stsMessage.SimpleText+('.');
                    Sleep(1000);
               end
               else
                   break;
          end;

          if ssStatus.dwCurrentState=SERVICE_RUNNING then
              stsMessage.SimpleText:='Service Start Ok'
          else
              stsMessage.SimpleText:='Service Start Fail';
     end
     else
          stsMessage.SimpleText:='Service Start Fail';
end;

end.

0
 
LVL 2

Accepted Solution

by:
greendot earned 100 total points
ID: 1360621
Geeeeeze, you're tough.

Actually, I went and played around with it and got something to work.
I verified this on my machine.  If you want a service in Delphi, this works.
Right now it is a console application, but you can change that easilly.

---------------------------------------
program DemoSrv;

// Windows NT Service Demo Program for Delphi 3
// The service will beep every 10 second .

uses SysUtils, Windows, WinSvc, Dialogs;

const
     ServiceName = 'DemoService';
     ServiceDisplayName = '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;

//---------------------------------------------------------------------------------------------
function GetLastErrorText: string;
// Get error message
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; {try/finally}
end;

//---------------------------------------------------------------------------------------------
procedure AddToMessageLog(sMsg:string);
// Write error message to Windows NT Event Log
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; {if}
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; {with}

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

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

//---------------------------------------------------------------------------------------------
procedure ServiceStart;
var
   dwWait: DWORD;
begin
   // Report Status
   if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 3000) then 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,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,lpszPath,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:=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.


0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now