Solved

Delphi 3 and NT services

Posted on 1998-04-20
4
327 Views
Last Modified: 2010-04-06
I need to write an application that runs as an nt service in delphi 3, the application needs to wake up once and hour and execute a database read.

I have never tackled an nt service, and there are not many resources I have found that can tackle this problem.

Thanks

Roy
0
Comment
Question by:valhala
  • 2
4 Comments
 
LVL 1

Expert Comment

by:Greedy
ID: 1335638
opalis robot can prbably do it.
http://www.opalis.com
but it cost alot.  To start a service don't you just tell NT that the application is a system application.  I mean what your discribing as your service dosn't sound like a service to me...I think of service as somthing that serves data and gets it...like a mail server it runs on a port like a deamon in unix.  But maby I'm wrong...probably am as I have never done either one.  I mean are you looking at security...and you don't want this to interact with the desktop right.  so wouldn't that just be a system application?  or do you need it to like respond to packets and things.


0
 
LVL 2

Expert Comment

by:freter
ID: 1335639
Have you taken a look at the Delphi Super Page (http://sunsite.icm.edu.pl/delphi) ? You can find an archive named ntservc.zip that implements a so-called "beep" service that beeps every one second. If you adjust this interval, you'd just have what you want to have.
BTW: If you are low on memory, it's probably better do implement a service using any non-OOP langauge, since services written in Delphi or VC++ tend to produce an overhead of roundabout 1MB in memory!
0
 
LVL 1

Expert Comment

by:Greedy
ID: 1335640
take a look at
http://ourworld.compuserve.com/homepages/African_Chief/
he has something on the page called Chief's Utilities ??? some kind of application processor.
0
 

Accepted Solution

by:
phillipf earned 100 total points
ID: 1335641
Try this.

program DemoSrv;

uses
  Forms,
  SysUtils,
  Windows,
  WinSvc,
  Dialogs,
  main in 'main.pas' {formmain},
  echo in 'echo.pas' {Form1};

Const
  ServiceName='DemoService';
  ServiceDisplayName='Demo Service';
  SERVICE_WIN32_OWN_PROCESS = $00000010;
  SERVICE_DEMAND_START = $00000003;
  SERVICE_ERROR_NORMAL = $00000001;
  EVENTLOG_ERROR_TYPE = $0001;

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

{$R *.RES}

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;

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('SetServiceStatus');
End;

Procedure ServiceStop;
Begin
  if (hServerStopEvent > 0) then
    SetEvent(hServerStopEvent);
End;

Procedure ServiceStart;
Var
  dwWait : DWORD;
begin
  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;

  While True do
  begin
    //** Your code would go here.  In this example I running **//
    //** an pplication the I previously created as a non     **//
    //** service.  If you do this make sure you trap all     **//
    //** exceptions since this would cause a dialog box to   **//
    //** be displayed but not seen since it is running as a  **//
    //** service.  I know this code works since I have used  **//
    //** it in numerous programs.  Good luck.                **//

    //** I can not take credit for this code.Unfortunately   **//
    //** I can not remeber where I got it from               **//

    //** Also note that this sample needs to be compiled as  **//
    //** a console application but that can be changed.      **//

    Application.Initialize;
    Application.CreateForm(Tformmain, formmain);
    Application.Run;

   //*********************************************************//
    dwWait := WaitForSingleObject(hServerStopEvent,1);
    if dwWait=WAIT_OBJECT_0 then
    begin
      CloseHandle(hServerStopEvent);
      exit;
    end;
  end;
end;

procedure Handler(dwCtrlCode:DWORD);stdcall;
begin
  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;

    else
  end;

  ReportStatusToSCMgr(ssStatus.dwCurrentState, NO_ERROR, 0);
end;

procedure ServiceMain;
begin
  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;

  if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 3000) then
  begin
    ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0);
    exit;
  end;

  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+',OpenSCManger 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
      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;

      if (DeleteService(schService)) then
        Writeln('Service Uninstall OK.')
      else
        Writeln('Delete Service Fail ('+GetLastErrorText+').');

      CloseServiceHandle(schService);
    end
    else
      Writeln('Open Service Fail ('+GetLastErrorText+').');

    CloseServiceHandle(schSCManager);
  end
  else
    Writeln('Open SCManager Fail ('+GetLastErrorText+').');
end;

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

  With ServiceTableEntry[0] Do
  Begin
    lpServiceName := ServiceName;
    lpServiceProc := TServiceMainFunction(@ServiceMain);
  end;

  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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

708 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

16 Experts available now in Live!

Get 1:1 Help Now