IPC + Delphi IDE debugging causes Hang Up
IPC + Delphi IDE debugging causes Hang Up
Hi,
I have made a DLL to intercept file operations such as CopyFile, RenameFile, MoveFile, etc. It works perfectly and it seems to be completely stable.
The problem occurs when I stop the execution in the delphi IDE for debugging: it works for a while and then the Delphi IDE freezes, as well as those applications which call intercepted API funcions.
Once terminated the Delphi IDE and debugged application from the task manager, everything responds again, even the hanged applications that use hooked API functions.
Some additional issues:
- XP sp2
- I'm not using message responses in the IPC callback function.
- Tried to enlarge MaxQueueLen in CreateIpcQueueEx with no success.
By the way, congratulations Madshi. MadCodeHook is amazing... For me, it is just magic!
I have made a DLL to intercept file operations such as CopyFile, RenameFile, MoveFile, etc. It works perfectly and it seems to be completely stable.
The problem occurs when I stop the execution in the delphi IDE for debugging: it works for a while and then the Delphi IDE freezes, as well as those applications which call intercepted API funcions.
Once terminated the Delphi IDE and debugged application from the task manager, everything responds again, even the hanged applications that use hooked API functions.
Some additional issues:
- XP sp2
- I'm not using message responses in the IPC callback function.
- Tried to enlarge MaxQueueLen in CreateIpcQueueEx with no success.
By the way, congratulations Madshi. MadCodeHook is amazing... For me, it is just magic!
Last edited by DAC on Wed Nov 24, 2004 8:41 am, edited 2 times in total.
The problem is that all the other applications which call hooked APIs are trying to contact your application. When your application is paused by the debugger, the other applications don't get a reply from your main application, anymore, and so freeze. I'm not sure why the Delphi IDE freezes, though. Anyway, probably debugging an application which gets IPC callbacks all the time is probably not a good idea. At least right now I don't know how to improve the situation.
It seems that when the inyected DLL calls SendIpcMessage the function does not return in some cases if the application with the IPC queue is stopped for debugging.
I guess the reason why SendIpcMessage does not return must be related to the fact that SendIpcMessage writes in the memory of the target proccess and something can happen if this process is being debugged. Or maybe it is related to the message response mechanism.
In any case I can solve this by making an interface application which redirects ipc messages to windows messages.
However, thinking about this I deduct that a call to SendIpcMessage must require waiting until the ipc queue application handles the message in order to know whether there is a message response or not.
I don't know how you are handling the ipc messages, I guess that maybe creating a thread when the queue is created which would wait for an event object to be triggered. A second event in the opposite direction would tell the calling thread that the response is ready. This would explain why the function does not return if that thread is stopped.
In any case don't you think that waiting for the message to be handled results in a performance penalty? Would it not be better to leave the message in a buffer and return immediately if a response is not required?
I guess the reason why SendIpcMessage does not return must be related to the fact that SendIpcMessage writes in the memory of the target proccess and something can happen if this process is being debugged. Or maybe it is related to the message response mechanism.
In any case I can solve this by making an interface application which redirects ipc messages to windows messages.
However, thinking about this I deduct that a call to SendIpcMessage must require waiting until the ipc queue application handles the message in order to know whether there is a message response or not.
I don't know how you are handling the ipc messages, I guess that maybe creating a thread when the queue is created which would wait for an event object to be triggered. A second event in the opposite direction would tell the calling thread that the response is ready. This would explain why the function does not return if that thread is stopped.
In any case don't you think that waiting for the message to be handled results in a performance penalty? Would it not be better to leave the message in a buffer and return immediately if a response is not required?
SendIpcMessage writes into a pipe. When the buffer of the pipe is full, the writing hangs until the application clears the buffer by reading the content of the pipe. As long as the pipe is regularly read, SendIpcMessage does not wait for a response from your application - except if you tell it to. The problem only exists because when debugging the pipe is not read and so gets "full".
A possible alternative of SendIPCMessage
As I need to debug the application that receives messages sent from a hooking DLL I have written a possible alternative to SendIPCMessage.
This interprocess messaging code is based on FileMappings, Mutexes and Events. The queue buffer is "circular" in case there is not enough space and after a timeout period the older messages are overwritten. This grants always the access to the message queue even if no one read the messages.
It seems to be quite quick and it is easy to use:
## To create the queue from the monitor application:
CimaMessageQueue := TCimaMessageQueue.Create('QueueName',Handle,MsgId);
Handle refers to the window who receives a notification when a new message is send to the queue. MsgId is the message identifier for that Windows message.
## To send a message from a hook DLL
SendCimaMessage('QueueName',Msg,MsgSize);
It returns True if done.
## To get a message
CimaMessageQueue.GetMessage (Buffer, BufferSize);
It returns the message size or 0 if no messages are available.
There is also optional parameters to control the buffersize and timeouts. You can get the source code and example project from http:\\david.cimadevilla.com\CimaMessages.zip
However I have found some trouble using FileMappings:
If you use OpenFileMapping with write access then MapViewOfFile fails (at least in my XP sp2). So I have used CreateFileMapping instead, that returns the already existing handle if any.
Additionally you get an access violation error if you try to access the mapped memory beyond $1000 bytes (4kb).
I would appreciate ideas or suggestions about these issues or any other. It would be nice if someone test this code in other Windows versions (Win98, Win2K, WinME...).
This interprocess messaging code is based on FileMappings, Mutexes and Events. The queue buffer is "circular" in case there is not enough space and after a timeout period the older messages are overwritten. This grants always the access to the message queue even if no one read the messages.
It seems to be quite quick and it is easy to use:
## To create the queue from the monitor application:
CimaMessageQueue := TCimaMessageQueue.Create('QueueName',Handle,MsgId);
Handle refers to the window who receives a notification when a new message is send to the queue. MsgId is the message identifier for that Windows message.
## To send a message from a hook DLL
SendCimaMessage('QueueName',Msg,MsgSize);
It returns True if done.
## To get a message
CimaMessageQueue.GetMessage (Buffer, BufferSize);
It returns the message size or 0 if no messages are available.
There is also optional parameters to control the buffersize and timeouts. You can get the source code and example project from http:\\david.cimadevilla.com\CimaMessages.zip
However I have found some trouble using FileMappings:
If you use OpenFileMapping with write access then MapViewOfFile fails (at least in my XP sp2). So I have used CreateFileMapping instead, that returns the already existing handle if any.
Additionally you get an access violation error if you try to access the mapped memory beyond $1000 bytes (4kb).
I would appreciate ideas or suggestions about these issues or any other. It would be nice if someone test this code in other Windows versions (Win98, Win2K, WinME...).
Code: Select all
{
CimaMessages 0.1
Interprocess Messages using FileMappings.
By David Cimadevilla (http://david.cimadevilla.com)
}
unit CimaMessages;
interface
uses Classes;
type
TQueueHeader = record
BufSize: Integer;
BeginOffset, DataLen: Integer;
end;
PQueueHeader = ^TQueueHeader;
const
KDefTimeOutSend = 200;
kDefTimeOutSendBufferFull = 1000;
kTimeOutSendBufferFullMinTime = 10;
kDefTimeOutGet = 1000;
kNotifyLoopTime = 1000;
kDefBufferSize = $1000 - sizeof(TQueueHeader);
type
TMsgEventThread = class(TThread)
protected
FEvent: THandle;
FHWND: THandle;
FMsg: Cardinal;
public
constructor Create( stEventName: string; hHWND: THandle= 0; uMsg: cardinal = 0 );
destructor Destroy; override;
procedure Execute;override;
end;
TCimaMessageQueue = class
protected
FTimeOutGet: integer;
FThread: TMsgEventThread;
FMapping: THandle;
FMutex: THandle;
FQueueBuffer: PQueueHeader;
public
property TimeOutGet: integer read FTimeOutGet write FTimeOutGet;
constructor Create ( stQueueName: string; HWND: THandle= 0
; uMsg: cardinal = 0; iBufferSize: Integer = kDefBufferSize);
destructor Destroy; override;
function GetMessage(var Buffer;
iBufferSize: Integer): Integer;
end;
function SendCimaMessage ( stQueueName: string; var MsgBuf
; MsgSize: Integer; iTimeOut: integer = kDefTimeoutSend
; iTimeOutBufferFull: integer = kDefTimeOutSendBufferFull): boolean;
var
CimaMessageQueue: TCimaMessageQueue;
implementation
uses Windows, SysUtils;
procedure ReadFromBuffer( Buffer: PQueueHeader; iOffset: Integer; var Data; iDataSize: Integer);
var
pSrc, pDst: pointer;
iBytes: Integer;
begin
with Buffer^ do
begin
//Before the circular border
if iOffset + iDataSize > BufSize then
iBytes := BufSize - iOffset
else
iBytes := iDataSize;
//From and To addresses
pSrc := pointer(integer(Buffer) + sizeof(TQueueHeader) + iOffset);
pDst := @Data;
//Read
move(pSrc^,pDst^,iBytes);
//Crossing the circular border
if iBytes < iDataSize then
begin
//Continue from the beginning
pSrc := pointer(integer(Buffer) + sizeof(TQueueHeader));
inc (pbyte(pDst), iBytes);
iBytes := iDataSize - iBytes;
//Read
move(pSrc^,pDst^,iBytes);
end;
end;
end;
procedure WriteToBuffer( Buffer: PQueueHeader; var Data; iDataSize: Integer);
var
iOffset: integer;
pSrc, pDst: pointer;
iBytes: Integer;
begin
with Buffer^ do
begin
//Offset
iOffset := BeginOffset + DataLen;
iOffset := iOffset mod BufSize;
//Before the circular border
if iOffset + iDataSize > BufSize then
iBytes := BufSize - iOffset
else
iBytes := iDataSize;
//Data addresses
pSrc := @Data;
pDst := pointer(integer(Buffer) + sizeof(TQueueHeader) + iOffset);
//Write
move(pSrc^,pDst^,iBytes);
//Crossing the circular border
if iBytes < iDataSize then
begin
//Continue from the beginning
inc (pbyte(pSrc), iBytes);
pDst := pointer(integer(Buffer) + sizeof(TQueueHeader));
iBytes := iDataSize - iBytes;
//Write
move(pSrc^,pDst^,iBytes);
end;
//New data len
inc(DataLen,iDataSize);
end;
end;
function SendCimaMessage ( stQueueName: string; var MsgBuf; MsgSize: Integer
; iTimeOut: integer; iTimeOutBufferFull: integer): boolean;
var
QueueBuffer: PQueueHeader;
hMapping: THandle;
iMsgBufSize, iPending: Integer;
hMutex: THandle;
uErrorBackup: Cardinal;
hEvent: THandle;
procedure FreeSpace ( iFreeWanted: integer );
var
pBufAddr: cardinal;
iMsgSize: integer;
begin
with QueueBuffer^ do
begin
pBufAddr := integer(QueueBuffer) + SizeOf(TQueueHeader);
while BufSize - DataLen < iFreeWanted do
begin
iMsgSize := PInteger(pBufAddr + BeginOffset)^ + sizeOf(Integer);
inc( BeginOffset, iMsgSize );
BeginOffset := BeginOffset mod BufSize;
dec( DataLen, iMsgSize );
end;
end;
end;
begin
//Preserve last error
uErrorBackUp := GetLastError;
try
//Failed by default
Result := False;
try
//Open mutex
hMutex := OpenMutex(MUTEX_ALL_ACCESS,False,pchar(stQueueName + 'Mutex'));
if hMutex = 0 then
Exit;
try
//Wait for Mutex
if WaitForSingleObject(hMutex,iTimeOut) <> WAIT_OBJECT_0 then
Exit;
//Open mapping (I cannot use OpenFileMapping because it fails with MapViewOfFile + FILE_MAP_WRITE at least on my XP SP2)
hMapping := CreateFileMapping(INVALID_HANDLE_VALUE,
nil,
PAGE_READWRITE,
0,
1,
PChar(stQueueName));
if hMapping = 0 then
exit;
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
CloseHandle(hMapping);
Exit;
end;
try
//Map memory
QueueBuffer := MapViewOfFile(hMapping,
FILE_MAP_ALL_ACCESS,
0,
0,
sizeof(TQueueHeader));
if not Assigned(QueueBuffer) then
Exit;
//Write message to the buffer
try
with QueueBuffer^ do
begin
//Message header (size)
iMsgBufSize := sizeof(Integer) + MsgSize;
//Enough space?
if iMsgBufSize > BufSize then
Exit;
//If buffer full wait a bit
iPending := iTimeOutBufferFull;
while (iPending>0) and (BufSize - DataLen < iMsgBufSize) do
begin
//Allows reading buffer
ReleaseMutex(hMutex);
//Wait
Sleep ( kTimeOutSendBufferFullMinTime );
//Wait for Mutex
if WaitForSingleObject(hMutex,iTimeOut) <> WAIT_OBJECT_0 then
Exit;
//Next
dec(iPending,kTimeOutSendBufferFullMinTime);
end;
//Frees required buffer memory
FreeSpace ( iMsgBufSize );
//Write Msg
WriteToBuffer (QueueBuffer, MsgSize, sizeof(MsgSize));
WriteToBuffer (QueueBuffer, MsgBuf, MsgSize);
//Message sent
Result := True;
end;
finally
UnMapViewOfFile(QueueBuffer);
end;
finally
CloseHandle(hMapping);
end;
finally
ReleaseMutex(hMutex);
CloseHandle(hMutex);
end;
//Open event
hEvent := OpenEvent(EVENT_MODIFY_STATE,False,pchar(stQueueName + 'Event'));
if hEvent = 0 then
Exit;
try
//Launch event
SetEvent(hEvent);
finally
CloseHandle(hEvent);
end;
except
//We don't want exceptions when sending messages
end;
finally
SetLastError (uErrorBackUp);
end;
end;
{ TCimaMessageQueue }
constructor TCimaMessageQueue.Create(stQueueName: string;
HWND: THandle; uMsg: cardinal; iBufferSize: Integer);
begin
FTimeOutGet := kDefTimeOutGet;
//Create Event Thread
if uMsg <> 0 then
FThread := TMsgEventThread.Create(stQueueName + 'Event', HWND, uMsg);
//Create mutex
FMutex := CreateMutex(nil,True,pchar(stQueueName + 'Mutex'));
if FMutex = 0 then
RaiseLastOSError;
if GetLastError = ERROR_ALREADY_EXISTS then
Raise exception.Create('Queue already exist');
try
//Create file mapping
FMapping := CreateFileMapping(INVALID_HANDLE_VALUE,
nil,
PAGE_READWRITE,
0,
SizeOf(TQueueHeader) + iBufferSize,
PChar(stQueueName));
if FMapping = 0 then
RaiseLastOSError;
if GetLastError = ERROR_ALREADY_EXISTS then
Raise exception.Create('Queue already exist');
//Map memory
FQueueBuffer := MapViewOfFile(FMapping,
FILE_MAP_ALL_ACCESS,
0,
0,
0);
//Initialize
with FQueueBuffer^ do
begin
BeginOffset := 0;
DataLen := 0;
BufSize := iBufferSize;
end;
finally
//Allow access
ReleaseMutex(FMutex);
end;
end;
destructor TCimaMessageQueue.Destroy;
begin
UnmapViewOfFile(@FQueueBuffer);
CloseHandle(FMapping);
CloseHandle(FMutex);
if Assigned(FThread) then
FreeAndNil(FThread);
inherited;
end;
function TCimaMessageQueue.GetMessage(var Buffer;
iBufferSize: Integer): Integer;
var
dwResult: Cardinal;
begin
//Wait for Mutex
dwResult := WaitForSingleObject(FMutex,FTimeOutGet);
if dwResult = WAIT_FAILED then
RaiseLastOSError
else if dwResult <> WAIT_OBJECT_0 then
Raise Exception.Create('TCimaMessageQueue.GetMessage: Timeout or abandoned mutex');
//Read message
try
with FQueueBuffer^ do
begin
//Queue is empty
if DataLen = 0 then
begin
Result := 0;
Exit;
end;
//Read msg size
ReadFromBuffer( FQueueBuffer, BeginOffset, Result, sizeof(Result) );
if Result > iBufferSize then
Raise exception.Create('TCimaMessageQueue.GetMessage: buffer is not enough large');
//Next offset
inc(BeginOffset, sizeOf(Result));
BeginOffset := BeginOffset mod BufSize;
//Read msg
ReadFromBuffer( FQueueBuffer, BeginOffset, Buffer, Result );
//Next offset
inc(BeginOffset, Result);
BeginOffset := BeginOffset mod BufSize;
//Discount data len
dec(DataLen, Result + sizeof(integer));
end;
finally
ReleaseMutex(FMutex);
end;
end;
{ TMsgEventThread }
constructor TMsgEventThread.Create(stEventName: string;
hHWND: THandle= 0; uMsg: cardinal = 0);
begin
//Create event
FEvent := CreateEvent(nil,False,False,pchar(stEventName));
if FEvent = 0 then
Raise exception.Create('Queue already exist');
//Notified window
FHWND := hHWND;
FMsg := uMsg;
//Launch!
inherited Create(False);
end;
destructor TMsgEventThread.Destroy;
begin
PulseEvent(FEvent);
Terminate;
WaitFor;
CloseHandle(FEvent);
inherited;
end;
procedure TMsgEventThread.Execute;
var
dwResult: Cardinal;
begin
repeat
dwResult := WaitForSingleObject(FEvent,kNotifyLoopTime);
if Terminated then
Exit;
if dwResult = WAIT_OBJECT_0 then
PostMessage(FHWND,FMsg,0,0);
until False;
end;
end.
Ops!... I left a wrong test parameter while I was trying to understand why OpenFileMapping does not work... Fixed!
I have updated the source at http:\\david.cimadevilla.com\CimaMessages.zip.
Now it is working perfectly. I hope this functions can help others who need a replacement for SendIPCMessage until you release an update.
I have updated the source at http:\\david.cimadevilla.com\CimaMessages.zip.
Now it is working perfectly. I hope this functions can help others who need a replacement for SendIPCMessage until you release an update.