Some years ago I posted a question here about COM servers in services without using the SvCom library for Delphi XE2. Back then, I went ahead and used SvCom to save time. Now I'm back trying to make this layout work without SvCom in 10.2.3 Tokyo.
I've created a minimal service app, and added to it a minimal COM automation object with a SendText method that calls a client event. The service installs, starts and runs fine. I then created a small client app, imported the type library and added the event handler. But when the test app attempts to connect to the server, I get a Server Execution Failed error. I'm assuming I've missed something in the registration, but the mass of documentation from MS and elsewhere that I've found is ambiguous to say the least. I'd hoped there would be some concise doc that listed the specific registry entries, etc. to set up, but I haven't found it.
This is my registration and related code in the service. Can someone tell me what I'm missing here?
procedure TTestServiceObj.ServiceAfterInstall(Sender: TService);
var
Key: String;
begin
DbgLog('Processing AfterInstall');
//have ComServer add all its entries
ComServer.UpdateRegistry(True);
with TRegistry.Create do try
//in the HKCR hive...
RootKey := HKEY_CLASSES_ROOT;
//add our LocalService entry
Key := '\APPID\'+GUIDToString(CLASS_BWSvcTest);
if OpenKey(Key, True) then begin
WriteString('', Self.DisplayName);
WriteString('LocalService', Self.Name);
WriteString('ServiceParameters', '');
CloseKey;
end;
//in the HKLM hive...
RootKey := HKEY_LOCAL_MACHINE;
//add the Description value
Key := '\SYSTEM\CurrentControlSet\Services\' + Self.Name;
if OpenKey(Key, False) then try
WriteString('Description', 'Test service for COM server');
finally
CloseKey;
end;
//add the values for the Windows Application EventLog handling
Key := '\SYSTEM\CurrentControlSet\Services\EventLog\Application\' + Self.Name;
if OpenKey(Key, True) then try
WriteString('EventMessageFile', ParamStr(0));
WriteInteger('TypesSupported', 7);
finally
CloseKey;
end;
finally
Free;
end;
end;
procedure TTestServiceObj.ServiceBeforeUninstall(Sender: TService);
var
Key: String;
begin
DbgLog('Processing BeforeUninstall');
with TRegistry.Create do try
//in the HKCR hive...
RootKey := HKEY_CLASSES_ROOT;
//delete the localservice-related stuff
Key := '\APPID\'+GUIDToString(CLASS_BWSvcTest);
if KeyExists(Key) then
DeleteKey(Key);
//in the HKLM hive...
RootKey := HKEY_LOCAL_MACHINE;
//remove the Description
Key := '\SYSTEM\CurrentControlSet\Services\' + Self.Name;
if KeyExists(Key) then
DeleteKey(Key);
//delete the key for the Application EventLog handling
Key := '\SYSTEM\CurrentControlSet\Services\EventLog\Application\' + Self.Name;
if KeyExists(Key) then
DeleteKey(Key);
finally
Free;
end;
//have ComServer remove the other entries
ComServer.UpdateRegistry(False);
end;
procedure TTestServiceObj.ServiceCreate(Sender: TObject);
begin
CoInitialize(nil);
end;
procedure TTestServiceObj.ServiceDestroy(Sender: TObject);
begin
Svr := nil;
CoUninitialize;
end;
procedure TTestServiceObj.ServiceStart(Sender: TService; var Started: Boolean);
begin
try
DbgLog('Getting server instance');
Svr := CreateComObject(CLASS_BWSvcTest) as IBWSvcTest;
DbgLog(IFF(Assigned(Svr), 'Server connected', 'Server NOT connected'));
except
on E:Exception do begin
Svr := nil;
DbgLogFmt('%s initializing COM service: %s', [E.ClassName, E.Message]);
end;
end;
end;
procedure TTestServiceObj.ServiceExecute(Sender: TService);
var
LastS,H,M,S,mS: Word;
begin
DbgLog('Processing ServiceExecute');
//init COM
CoInitialize(nil);
try
try
//get our starting time values
DecodeTime(Now, H,M,LastS,mS);
//loop until stopped
while not Terminated do begin
Sleep(50);
Self.ServiceThread.ProcessRequests(False);
if (not Terminated) then begin
//once a second, have the server send the time to the client
DecodeTime(Now, H,M,S,mS);
if S <> LastS then begin
LastS := S;
if Assigned(Svr) then try
Svr.SendText(FormatDateTime('hh:nn:ss', Now));
except
on E:Exception do
DbgLogExcept(E, 'Sending text to client');
end;
end;
end;
end;
except
end;
finally
CoUninitialize;
end;
end;