Creating an Agent NT Service with VB

Diderick Oerlemans

Wouldn't it be nice to be able to create an agent that's running on your NT Server as an NT service? Well, it's not so hard to do, because it's possible to use VB!

Chris Duke, who runs an excellent site for advanced VB developers at vb.duke.net, got me started on this agent project when he posted some articles about creating an NT service using VB. One thing you need is NTSVC.OCX, an unsupported OCX that Microsoft has been distributing (as source code) on MSDN for some time now.

What I needed to build was an agent that could read e-mail, parse it, and perform some actions on a SQL Server. Once I'd done just that, I published my experiences on vb.duke.net, but because I received so many requests for source code, I thought it would be a good idea to send this document to Visual Basic Developer so more people can benefit from my findings.

Preparations

You'll need to prepare some things before doing the coding. Start by getting the newest active messaging library -- you'll need version 1.1 at a minimum. Next, make sure you install Outlook 8.01 (this is also the minimum version that will work) on the target server (nope, Exchange 5.0 client with the service pack doesn't work!). Also, you'll need to run regsrv32 to register the NTSVC.OCX on both your development PC and the target server.

Then, set up a domain user with a mailbox on Exchange server. The domain user should have enough rights on the target server so it can use the Outlook client. Next, log onto the target server and create the default Exchange profile. After creating your agent and installing it as a service, you should set the service to log onto NT using the domain user you just created.

Using the service OCX

Create a main form and drop the NTSVC.OCX on it. Fill in the name and display name properties. Initialization of the service should take place in the load event of the main form:
Private Sub Form_Load()
Dim strDisplayName As String  
   On Error GoTo Err_Load    
   strDisplayName = NTService.DisplayName    
   If Command = "-install" Then
      NTService.Interactive = True 
        If NTService.Install Then
      MsgBox strDisplayName &" installed successfully"
        Else
          MsgBox strDisplayName & " failed to install"
         End If
   End     
   ElseIf Command = "-uninstall" Then
      If NTService.Uninstall Then
         MsgBox strDisplayName & " uninstalled _
            successfully"      Else
         MsgBox strDisplayName &" failed to uninstall"
      End If
   End  
   ElseIf Command = "-debug" Then
      NTService.Debug = True    
   ElseIf Command <> "" Then
      MsgBox "Invalid command option"
   End
   End If   
   ' Enable Pause/Continue. Must be set before 
   ' StartService is called or in design mode
   NTService.ControlsAccepted = svcCtrlPauseContinue  
   ' connect service to Windows NT services controller
   NTService.StartService    
   Exit Sub   
Err_Load:
   ServiceLog ("[" & Err.Number & "] " & _
      Err.Description)
End Sub

As you can see, we start by parsing the command line option, to determine whether the service should be (un)installed. In other cases -- for example, when the service is started by the NT service control manager -- it will start the service with the NTService.StartService method.

The OCX also exposes a very handy function to log events to the NT application log. I wrote a little wrapper sub to use this function: 
Public Sub ServiceLog(strMessage As String)
   Call NTService.LogEvent(svcMessageError, _
      svcEventError, strMessage)
End Sub

Because you usually don't have a console for your service (except when (un)installing), you should log all errors and other useful stuff. For example, you could have the form load error handler log any errors using the ServiceLog subroutine. The service OCX will raise the following event when starting: 
Private Sub NTService_Start(Success As Boolean)
On Error GoTo Err_start    
   'Start SQL Server connection
   Success = StartSQL()
   If Success Then
      ServiceLog ("SQL connection established")
   Else
      ServiceLog ("SQL connection failed")
   End If       'Start Mail connection
   Success = (StartMail() = 0)   If Success Then
      ServiceLog ("Mail session established")
   Else
      ServiceLog ("Mail session failed")
   End If    
   'Enable timer
   Timer.Interval = 1000
   Timer.Enabled = True 
   Exit Sub
Err_start:
   ServiceLog ("[" & Err.Number & "] " & )
   Err.Description)End Sub

What I've done here is initialize the SQL Server connection and start a mail session (more about this later). The SQL Server connection should pose no difficulties. In my case, I used DB-Library and integrated security, but ADO or RDO should also work. I also initialized a timer control (for polling the mailbox) on the main form. If you set the Success Boolean to false, the OCX will notify the NT service control manager that the service couldn't be started -- Success to true does the opposite. Note that all relevant information is again logged to the application log using the ServiceLog wrapper sub.

When the service is stopped (using the NT service control manager, for example), the following event procedure is fired: 
Private Sub NTService_Stop()
On Error GoTo Err_stop
   Call StopSQL
   Call StopMail 
   Unload Me
   Exit Sub    
Err_stop:
   ServiceLog ("[" & Err.Number & "] " & _
   Err.Description)
End Sub

It does the obvious -- disconnects from SQL Server, closes the mail session, unloads the form, and thus ends the service. Using active messaging

This is where most people who mailed me got stuck. I again stress the fact that you need the newest versions of active messaging (or CDO, for Collaboration Data Objects, as it's called these days) and Outlook installed. Active messaging version 1.0 will not work, and Outlook 8.0 will not work.

I created a generic class to hold my active messaging session (this isn't required, of course). In the main form, the following function initializes the class (clsMail is a private var in the main form) and calls the logon method: 
Private Function StartMail() As Long
   StartMail = 0        
   Set clsMAIL = New clsMailService    
   If Not clsMAIL.Logon(True, XCHANGE_PROFILE, _
      XCHANGE_PASSWORD) Then
      StartMail = clsMAIL.LastError
   End If    
End Function

There are two constants used for the profile name and the password. This is the profile you created for the domain user, which your service uses to log on to NT. Here's the logon method: 
Public Function Logon(Optional strProfile As String, _
   Optional strPassword As String) As Boolean   Logon = True
   If IsMissing(strProfile) Then strProfile = ""
   If IsMissing(strPassword) Then strPassword = ""    
   If Not CheckSession() Then
      Logon = False
      Exit Function   End If    
   On Error GoTo Err_logon
   objSession.Logon strProfile, strPassword, False, _
      True, 0, True        
   Exit Function            
Err_logon:
   Logon = False
   'Set the class error props for later inspection
   lngError = Err.Number            
   strError = Err.Description   Exit Function
End Function

The catch is in the parameters for the logon method of the session object. Here's the description:

Profilename:The profilename you created on the target server
Password:The domain password of the user you created
Showdialog:False
NewSession:True (doesn't matter)>
Parentwindow:0 (doesn't matter)
NoMail:True (very important setting)

The NoMail setting is where it can all go wrong. It tells MAPI whether it should start the mailspooler. The default is to start it (NoMail = False). There's one big problem with the mailspooler -- it's not accessible within the security context of a service. (Actually, the mailspooler is started outside any security context. This is a somewhat complex story, but there's a document available through MSDN for the diehards.) Solution: Set NoMail to True. I use a little check function to check whether the session is already initialized. If not, a new session object is created: 
Private Function CheckSession() As Boolean
   CheckSession = True
   On Error GoTo Err_Fail        
   If objSession Is Nothing Then
      Set objSession = CreateObject("MAPI.Session")
   End If    
   Exit Function    Err_Fail:
   CheckSession = False
   'Set the class error props for later inspection
   lngError = Err.Number
   strError = Err.Description
   Exit Function
End Function
Building the rest

As mentioned previously, there's a timer control on the main form. I use it to call a method of the mail class (ProcessMessages): 
Private Sub TIMER_Timer()
Dim lngNumber As Long    
   On Error GoTo Err_Timer    
   'disable the timer while processing
   Timer.Interval = 0
   Timer.Enabled = False        
   lngNumber = clsMAIL.ProcessMessages()
   If lngNumber < 0 Then
      ServiceLog "MAIL ERROR: [" & clsMAIL.LastError _
         & "] " & clsMAIL.LastErrorMessage
   End If    
  'enable the timer
   Timer.Interval = 1000
   Timer.Enabled = True    
   Exit Sub
Err_Timer:
   Timer.Enabled = True
   ServiceLog ("[" & Err.Number & "] " & _
      Err.Description)
End Sub

This method parses new messages in an Exchange folder. For each new message, it performs types of actions on a SQL Server database -- for example, retrieving information -- and sends results back to the sender: 
Public Function ProcessMessages(Optional strType as _
   String) As Long
'Dims omitted in this listing
ProcessMessages = 0On Error GoTo Err_mapi     
'Get messages collection for selected inbox 
Set objInMessages = objSession.Inbox.Messages
'Initialize Filter for fast processing
Set objMessageFilter = objInMessages.Filter
objMessageFilter.Unread = True
If not IsMissing(strType) Then
    objMessageFilter.Subject = strType
End If    
'Traverse the message collection
For Each objInMsg In objInMessages                
'Go process the message, adding any results to the 
'strReturn variable
   lngCounter = lngCounter + 1
   strReturn = ParseOrder(objInMsg.Text)    
   'Prepare and send the return message
   Set objOutMsg = objSession.Outbox.Messages.Add
   objOutMsg.Subject = strType & " CONFIRMATION"
   objOutMsg.Text = strReturn
   Set objRecip = objOutMsg.Recipients.Add
   Set objRecip.AddressEntry = objInMsg.Sender
   objRecip.Resolve        
   objOutMsg.Update
   objOutMsg.Send False, False, 0        
   'Mark message as read
   objInMsg.Unread = False
   objInMsg.Update       
Next
'Return number processed
ProcessMessages = lngCounter
Set objInMessages = Nothing 
Exit Function   
Err_mapi:
   ProcessMessages = -1
   'Set the class error properties for later inspection
   lngError = Err.Number
   strError = Err.Description
   Exit Function
End Function

Well, as you can probably see already, the possibilities are endless. At my company, we just built one for guarding both our Web and Exchange servers. This agent polls our clients' servers and checks whether everything is still working. It will notify the correct people if there's trouble. In the new Exchange Server 5.5, it's possible to create agents using server-side scripting. This will probably end the use for mail-reading agents running on Exchange servers. But if you want your agents on a separate server, I can't think of a simpler way to create them. [Readers might also want to explore the Windows NT Resource Kit's SRVANY.EXE, which lets you run any NT application as a service. -- Ed.]

Diderick Oerlemans is an IT consultant and partner in I-Cube BV, a small IT service company located in Delft, The Netherlands. He has more than six years' experience in developing information systems using Microsoft products. He and his team develop all kinds of client/server systems for midsize and large companies in The Netherlands. www.i-cube.nl, Diderick.Oerlemans@I-Cube.NL.