当代码尝试访问MSMQ消息的“Body”属性时，我的Windows服务会抛出EOleException异常。 错误是间歇性的，服务可以运行一个月而不会出现问题。 消息有效负载是XML字符串。 该服务每天处理少量消息（~10）并且消息有效载荷小<900字节。 消息通过BizTalk应用程序发送到MSMQ服务器，并在服务中隐藏事件。 我已将代码从D6移植到XE8（我将mqoa30.tlb类型库导入XE8 RAD）并且D6和XE8构建中都出现问题。 错误发生在“到达”过程中，当错误发生时，我无法以任何方式访问“正文”。 有关如何解决此问题（或进一步调试）的任何建议？
错误记录
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
代码
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;