Visit our Sponsor   Visit our Sponsor
delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
500 Users Online NOW
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback





Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi







Startblatt.de






Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (15)


Example of a Windows Service, with a threadGo to Kim Sandell's websiteFormat this article printer-friendly!Bookmark function is only available for registered users!
A Windows Service with a thread, for WinNT,Win2K,WinXP
Product:
Delphi 5.x (or higher)
Category:
System
Skill Level:
Scoring:
Last Update:
07/18/2008
Search Keys:
delphi delphi3000 article borland vcl code-snippet Windows System Service Thread Server Servers
Times Scored:
10
Visits:
11499
Uploader: Kim Sandell
Company: Celarius Oy
Reference: N/A
 
Question/Problem/Abstract:
Delphi 5 and up has a template project for services, but it is incomplete. This example builds on that template and completes the service. It also shows how to start a thread that beeps every 2 seconds. You can use this as a base when developing services.
Answer:



This example shows how to use the service template in delphi, taking it a step further and making a complete example. The source for this is included in the ntservice.zip file.

Coded under D6, but works for D5 if you copy the source parts after creating a template service.

Below are all the source files listed one by one. The same files and the whole project is in the NTService.zip file (as soon as it is uploaded)

To test the source, create a Service with Delphi, and pase these sources
on top of the automatically generated source.

------- CUT-CUT-CUT-CUT -------------------------------------------------
program NTService;

uses
  SvcMgr,
  NTServiceMain in 'Units\NTServiceMain.pas' {ExampleService: TService},
  NTServiceThread in 'Units\NTServiceThread.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TExampleService, ExampleService);
  Application.Run;
end.
------- CUT-CUT-CUT-CUT -------------------------------------------------
(*
  Windows Service Template
  ========================

  Author          Kim Sandell

  Email           kim.sandell@celarius.com  

  Disclaimer      Freeware. Use and abuse at your own risk.

  Description     A Windows NT Service skeleton with a thread.
                  Works in WinNT 4.0, Win 2K, and Win XP Pro

                  The NTServiceThread.pas contains the actual
                  thread that is started under the service.
                  When you want to code a service, put the code in
                  its Execute() method.

  Example         To test the service, install it into the SCM with
                  the InstallService.bat file. The go to the Service
                  Control Manager and start the service.

                  The Interval can be set to execute the Example
                  Beeping every x seconds. It depends on the
                  application if it needs a inerval or not.

  Notes           This example has the service startup options set to
                  MANUAL. If you want to make a service that starts
                  automatically with windows then you need to
                  change this.
                  BE CAREFULT ! If your application hangs when
                  running as a service THERE IS NO WAY to
                  terminate the application.

  History     Description
  ==========  =====================================================
  24.09.2002  Initial version

*)
unit NTServiceMain;

interface

uses
  Windows, Messages, SysUtils, Classes, SvcMgr,
  NTServiceThread;

type
  TExampleService = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    fServicePri            : Integer;
    fThreadPri             : Integer;

    { Internal Start & Stop methods }
    Function _StartThread( ThreadPri:Integer ): Boolean;
    Function _StopThread: Boolean;
  public
    { Public declarations }
    NTServiceThread       : TNTServiceThread;

    function GetServiceController: TServiceController; override;
  end;

var
  ExampleService: TExampleService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
     ExampleService.Controller(CtrlCode);
end;

function TExampleService.GetServiceController: TServiceController;
begin
     Result := ServiceController;
end;

procedure TExampleService.ServiceExecute(Sender: TService);
begin
     { Loop while service is active in SCM }
     While NOT Terminated do
     Begin
          { Process Service Requests }
          ServiceThread.ProcessRequests( False );
          { Allow system some time }
          Sleep(1);
     End;
end;

procedure TExampleService.ServiceStart(Sender: TService; var Started: Boolean);
begin
     { Default Values }
     Started     := False;
     fServicePri := NORMAL_PRIORITY_CLASS;
     fThreadPri  := Integer(tpLower);

     { Set the Service Priority }
     Case fServicePri of
      0 : SetPriorityClass( GetCurrentProcess, IDLE_PRIORITY_CLASS );
      1 : SetPriorityClass( GetCurrentProcess, NORMAL_PRIORITY_CLASS );
      2 : SetPriorityClass( GetCurrentProcess, HIGH_PRIORITY_CLASS );
      3 : SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );
     End;

     { Attempt to start the thread, if it fails free it }
     If _StartThread( fThreadPri ) then
     Begin
          { Signal success back }
          Started := True;
     End Else
     Begin
          { Signal Error back }
          Started := False;
          { Stop all activity }
          _StopThread;
     End;
end;

procedure TExampleService.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
     { Try to stop the thread - signal results back }
     Stopped := _StopThread;
end;

procedure TExampleService.ServicePause(Sender: TService; var Paused: Boolean);
begin
     { Attempt to PAUSE the thread }
     If Assigned(NTServiceThread) AND (NOT NTServiceThread.Suspended) then
     Begin
          { Suspend the thread }
          NTServiceThread.Suspend;
          { Return results }
          Paused := (NTServiceThread.Suspended = True);
     End Else Paused := False;
end;

procedure TExampleService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
     { Attempt to RESUME the thread }
     If Assigned(NTServiceThread) AND (NTServiceThread.Suspended) then
     BEGIN
          { Suspend the thread }
          If NTServiceThread.Suspended then NTServiceThread.Resume;
          { Return results }
          Continued := (NTServiceThread.Suspended = False);
     END Else Continued := False;
end;

procedure TExampleService.ServiceShutdown(Sender: TService);
begin
     { Attempt to STOP (Terminate) the thread }
     _StopThread;
end;

function TExampleService._StartThread( ThreadPri: Integer ): Boolean;
begin
     { Default result }
     Result := False;
     { Create Thread and Set Default Values }
     If NOT Assigned(NTServiceThread) then
     Try
        { Create the Thread object }
        NTServiceThread := TNTServiceThread.Create( True );
        { Set the Thread Priority }
        Case ThreadPri of
         0 : NTServiceThread.Priority := tpIdle;
         1 : NTServiceThread.Priority := tpLowest;
         2 : NTServiceThread.Priority := tpLower;
         3 : NTServiceThread.Priority := tpNormal;
         4 : NTServiceThread.Priority := tpHigher;
         5 : NTServiceThread.Priority := tpHighest;
        End;
        { Set the Execution Interval of the Thread }
        NTServiceThread.Interval := 2;
        
        { Start the Thread }
        NTServiceThread.Resume;
        { Return success }
        If NOT NTServiceThread.Suspended then Result := True;
     Except
        On E:Exception do ; // TODO: Exception Logging
     End;
end;

function TExampleService._StopThread: Boolean;
begin
     { Default result }
     Result := False;
     { Stop and Free Thread }
     If Assigned(NTServiceThread) then
     Try
        { Terminate thread }
        NTServiceThread.Terminate;
        { If it is suspended - Restart it }
        If NTServiceThread.Suspended then NTServiceThread.Resume;
        { Wait for it to finish }
        NTServiceThread.WaitFor;
        { Free & NIL it }
        NTServiceThread.Free;
        NTServiceThread := NIL;
        { Return results }
        Result := True;
     Except
        On E:Exception do ; // TODO: Exception Logging
     End Else
     Begin
          { Return success - Nothing was ever started ! }
          Result := True;
     End;
end;

end.
------- CUT-CUT-CUT-CUT -------------------------------------------------
(*
  A Windows NT Service Thread
  ===========================

  Author          Kim Sandell
*)
unit NTServiceThread;

interface

uses
  Windows, Messages, SysUtils, Classes;
  
type
  TNTServiceThread = Class(TThread)
  private
    { Private declarations }
  Public
    { Public declarations }
    Interval              : Integer;

    Procedure Execute; Override;
  Published
    { Published declarations }
  End;

implementation

{ TNTServiceThread }

procedure TNTServiceThread.Execute;
Var
   TimeOut      : Integer;
begin
     { Do NOT free on termination - The Serivce frees the Thread }
     FreeOnTerminate := False;

     { Set Interval }
     TimeOut := Interval * 4;

     { Main Loop }
     Try
        While Not Terminated do
        Begin
             { Decrement timeout }
             Dec( TimeOut );

             If (TimeOut=0) then
             Begin
                  { Reset timer }
                  TimeOut := Interval * 4;

                  { Beep once per x seconds }
                  Beep;
             End;
             { Wait 1/4th of a second }
             Sleep(250);
        End;
     Except
        On E:Exception do ; // TODO: Exception logging...
     End;
     { Terminate the Thread - This signals Terminated=True }
     Terminate;
end;

end.
------- CUT-CUT-CUT-CUT -------------------------------------------------






Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment
To all those that have not heard a Beep!
    Kim Sandell (Oct 20 2004 10:49PM)

Just compiling and running it in the IDE will NOT run the prograsm, it just exists.

Heres what you have to do:
1) Compile the file to the .exe
2) Run the .exe from the DOS prompt with the -install command line switch
3) From the SCM, select the service and Start it.

I hope this clears the situation a little ...
Respond

RE: To all those that have not heard a Beep!
bennyxl benny101 (Feb 4 2005 7:21AM)

Everything is ok in every routine,just change then Beep function like this:
Windows.Beep( DWORD dwFreq, DWORD dwDuration); If you write the Beep Statement as below,you'll hear  imagic sound just like ' World Tommorow':
windows.Beep(random(10000), 100);

ps:replace sleep(250) with sleep(1)


Respond

RE: RE: To all those that have not heard a Beep!
Kim Sandell (Feb 4 2005 9:07AM)

Thanx for the Windows.Beep() hint.

I recommend to keep the sleep value at 250. The reason is that the beep is then only produced every 250 milliseconds, and not as a constant beeping, that is very annoying...
Respond

No beeps either!
    Myles Wakeham (Jul 25 2004 5:25AM)

I tried this, and installed it as a service, and manually started it (showing that its running on my Win XP Pro machine), but no beeps or anything.  Damn this is hard to debug since its so 'invisible'...  Does anyone have an example of this working that is pre-built, I could try?

Thanks
Myles
myles@techsol.org
Respond

beep is not coming???
    KUMANAN T.NATARAJAN (May 22 2003 2:09PM)

I tired this program, every thing perfect but beep is not coming???
Respond

Register service
    Petr Reichl (Nov 21 2002 10:59AM)

I don’t known, how register my service to the system. I wrote service according to the example and I couldn’t register this service.
Respond

RE: Register service
Kim Sandell (Nov 21 2002 11:01AM)

To register the service in the SCM (Service Control Manager), go to the DOS Prompt and enter "NTService.exe -install".
To UnInstall the service, at the prompt write "NTService.exe -uninstall"

Hope this is what you were looking for.

Respond

Way cool!
    Shannon Wynter (Sep 25 2002 5:33PM)

Thank you! I've looked everywhere for this...

Finaly someone did something

Been able to make workable services.. but nothing *propper*
Respond

RE: Way cool!
Moisés López (May 19 2003 8:52PM)

thankx you soo much. I already had the service registered but needed info on creating the Exe, saved me a bunch of hours ;)
Respond

Missing?
    Thomas Mitchelle (Sep 24 2002 11:44AM)

I think you forgot to do / add something here..? Either that or its a very short and non descriptive tutorial.
Respond

RE: Missing?
Kim Sandell (Sep 24 2002 12:27PM)

The NTService.zip file is missing as of yet (hasn't been uploaded/attached), but the source is now visible in the article.
Respond

RE: RE: Missing?
Sandro Brigantini (Apr 28 2003 7:58PM)

How about NTService.exe and .bat file ?
Respond

beep is not coming???
Kums (May 22 2003 2:07PM)

I tired this program, every thing perfect but beep is not coming???
Respond

RE: beep is not coming???
Kim Sandell (May 22 2003 2:19PM)

I think you forgot to turn on the service or to install it.

To install it read the comments above, and to start it open the Service Control Manager (Control Panel) and find the service and start it

I hope this helps ..
Respond

RE: beep is not coming???
Alice Claussen (Oct 20 2004 8:06PM)

I did it! It's working. If you're still interested...
Respond














 
Sign up to consume product discounts for Bronze memberships !

read more


  Visit our Sponsor

 

  Community Ad of
A. B. Talal
 
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)