My Windows service throws an EOleException exception when the code tries to access the 'Body' property of a MSMQ message. The error is intermittent and the service can run for a month without an issue. The message payload is an XML string. The service processes a small number of messages a day (~10) and the message payload is small <900 bytes. The messages are sent to the MSMQ Server by a BizTalk application and event sinked in the service. I've ported the code from D6 to XE8 (I imported the mqoa30.tlb Type Library into the XE8 RAD) and the problem occurs in both the D6 and XE8 build. The error occurs in the 'arrived' procedure, when the error occurs I haven't been able to access the 'Body' in any way. Any suggestions on how to resolve this problem (or debug it further)?
Error Log
error, TMyThread.Arrived (VarIsStr Test): ClassName: EOleException, Error: Not enough storage is available to complete this operation
error, TMyThread.Arrived (QueueMessage Assignment): ClassName: EOleException, Error: Not enough storage is available to complete this operation,Label: adf7cea1-7be8-4382-8687-f4ea0f8a5e50, Body Length: 871, Msg Class: 0, Cursor: 0, Encrypt Algorithm: 26625, Journal: 1, Sender Version: 16
Code
procedure TMyThread.Arrived(ASender: TObject; const Queue: IDispatch; Cursor: Integer);
var
strMSMQMessage, strMsg, strMessageFile, strMessageProperties: string;
blnMsgAssigned: boolean;
intBodyLength, intMessageClass: integer;
wstrLabel: WideString;
intEncryptAlgorithm, intJournal, intSenderVersion: longint;
QueueMessage: IMSMQMessage3;
varTransaction, varWantDestinationQueue, varWantBody, varReceiveTimeOut, varWantConnectorType: OLEVariant;
begin
QueueMessage:= nil;
strMSMQMessage:= '';
intBodyLength:= 0;
wstrLabel:= '';
strMessageProperties:= '';
blnMsgAssigned:= False;
try
varTransaction:= False;
varWantDestinationQueue:= False;
varWantBody:= True;
varReceiveTimeOut:= 30000;
varWantConnectorType:= False;
QueueMessage:= IUnknown(Variant(FQueue).Receive(varTransaction, varWantDestinationQueue, varWantBody, varReceiveTimeOut, varWantConnectorType)) as IMSMQMessage3;
if Assigned(QueueMessage) then
begin
intBodyLength:= QueueMessage.BodyLength;
intMessageClass:= QueueMessage.MsgClass;
wstrLabel:= QueueMessage.Label_;
intEncryptAlgorithm:= QueueMessage.EncryptAlgorithm;
intJournal:= QueueMessage.Journal;
intSenderVersion:= QueueMessage.SenderVersion;
strMessageProperties:= 'Label: '+wstrLabel+', Body Length: '+IntToStr(intBodyLength)+', Msg Class: '+IntToStr(intMessageClass)+', Cursor: '+IntToStr(Cursor);
strMessageProperties:= strMessageProperties+', Encrypt Algorithm: '+IntToStr(intEncryptAlgorithm)+', Journal: '+IntToStr(intJournal);
strMessageProperties:= strMessageProperties+', Sender Version: '+IntToStr(intSenderVersion);
// Can trigger a 'Not enough storage...' error.
// Body: OLEVariant
try
if not VarIsStr(QueueMessage.Body) then
if Assigned(FEventLog) then
FEventLog.AppendToFile('debug', 'TMyThread.Arrived: VarIsStr = False', TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
except
on E: Exception do
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.Arrived (VarIsStr Test): ClassName: '+E.ClassName+', Error: '+E.Message+strMsg;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
strMSMQMessage:= VarToStrDef(QueueMessage.Body, '');
blnMsgAssigned:= True;
end;
QueueMessage:= nil;
except
on E: Exception do
begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.Arrived (QueueMessage Assignment): ClassName: '+E.ClassName+', Error: '+E.Message+','+strMessageProperties;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
end;
if blnMsgAssigned then
begin
strMessageFile:= TTMSMQService.FArchiveFilePath+'PA.'+FormatDateTime('yyyymmdd.hhmmsszzz', Now)+'.'+IntToStr(intBodyLength)+'.xml';
if Assigned(FMessageLog) then
FMessageLog.WriteToFile(strMessageFile, strMSMQMessage);
// Debug.
if Assigned(FEventLog) then
FEventLog.AppendToFile('debug', 'TMyThread.Arrived: Message Properties: '+strMessageProperties, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
if blnMsgAssigned and (Length(strMSMQMessage) > 0) then
ParseIncomingMessage(strMSMQMessage);
end else begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.Arrived: Error: QueueMessage not assigned';
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
// Debug.
if Assigned(FEventLog) then
FEventLog.AppendToFile('debug', 'TMyThread.Arrived: Try EnableNotification', TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
try
FQueue.EnableNotification(FEvent.DefaultInterface, EmptyParam, FTimeOut);
except
on E: Exception do
begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.Arrived (EnableNotification): ClassName: '+E.ClassName+', Error: '+E.Message;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
end;
end;
procedure TMyThread.Execute;
var
strMsg: string;
begin
inherited;
FreeOnTerminate:= False;
Randomize;
try
try
FQueueInfo:= CreateCOMObject(CLASS_MSMQQueueInfo) as IMSMQQueueInfo3;
FQueueInfo.FormatName:= FFormatNameOut;
FTimeOut:= -1;
FEvent:= TMSMQEvent.Create(nil);
FEvent.OnArrived:= Arrived;
FEvent.OnArrivedError:= ArrivedError;
FConnected:= OpenListeningQueue;
while not Terminated do
begin
if not FConnected then
begin
CloseListeningQueue;
FConnected:= OpenListeningQueue;
end;
Sleep(Random(500) + 1000);
end; // while not Terminated
CloseListeningQueue;
except
on E: Exception do
begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.Execute: ClassName: '+E.ClassName+', Error: '+E.Message;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
end;
finally
if Assigned(FEvent) then
FEvent.Free;
FQueueInfo:= nil;
end;
end;
TMyThread = class(TThread)
private
FFormatNameOut: string;
FEventLog: TEventLog;
FQueueInfo: IMSMQQueueInfo3;
FQueue: IMSMQQueue3;
FEvent: TMSMQEvent;
FTimeOut: OLEVariant;
FConnected: boolean;
FMessageLog: TMessageLog;
protected
procedure Execute; override;
procedure ParseIncomingMessage(const strMessage: string);
function OpenListeningQueue: boolean;
procedure CloseListeningQueue;
public
procedure Arrived(ASender: TObject; const Queue: IDispatch; Cursor: Integer);
procedure ArrivedError(ASender: TObject; const Queue: IDispatch; ErrorCode: Integer; Cursor: Integer);
constructor Create(const FormatNameOut: string);
destructor Destroy; override;
end;
constructor TMyThread.Create(const FormatNameOut: string);
const
PA_EVENTFILE = 'msmqpatevents.txt';
begin
CoInitialize(nil);
inherited Create(False);
FConnected:= False;
FFormatNameOut:= FormatNameOut;
FEventLog:= TEventLog.Create(TTMSMQService.FLogFilePath+PA_EVENTFILE);
FMessageLog:= TMessageLog.Create;
end;
destructor TMyThread.Destroy;
begin
FreeAndNil(FEventLog);
FreeAndNil(FMessageLog);
inherited Destroy;
CoUninitialize;
end;
function TMyThread.OpenListeningQueue: boolean;
var
strMsg: string;
begin
// Debug.
if Assigned(FEventLog) then
FEventLog.AppendToFile('debug', 'TMyThread.OpenListeningQueue', TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
Result:= False;
try
FQueue:= FQueueInfo.Open(MQ_RECEIVE_ACCESS, MQ_DENY_NONE);
FQueue.EnableNotification(FEvent.DefaultInterface, EmptyParam, FTimeOut);
Result:= (FQueue.IsOpen = 1);
except
on E: Exception do
begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.OpenListeningQueue: ClassName: '+E.ClassName+', Error: '+E.Message;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
end;
end;
procedure TMyThread.CloseListeningQueue;
var
strMsg: string;
begin
// Debug.
if Assigned(FEventLog) then
FEventLog.AppendToFile('debug', 'TMyThread.CloseListeningQueue', TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
try
if Assigned(FQueue) then
if FQueue.IsOpen = 1 then
FQueue.Close;
except
on E: Exception do
begin
if Assigned(FEventLog) then
begin
strMsg:= 'TMyThread.CloseListeningQueue: ClassName: '+E.ClassName+', Error: '+E.Message;
FEventLog.AppendToFile('error', strMsg, TTMSMQService.FServiceVersion, TTMSMQService.FDatabaseVersion);
end;
end;
end;
end;
