Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Delphi 3 and NT services

Posted on 1998-04-20
4
Medium Priority
?
355 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 400 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

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses
Course of the Month13 days, 18 hours left to enroll

580 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