Related
I am trying to handle a few thousand users through Indy TCP servers but i always saw very high memory consumption even with a few hundred users... i just wrote a bot to test out the performance of the server handling the data. I connected 300 bots to the test server and started sending packets through. The memory usage climbed to a few hundred MB in matter of minutes...
After going through codes i noticed that the main issue was with using sender queue for each thread so each thread can transmit its messages in its Execute function. If 300 users are sending packets to each other and writing data to each thread's queue then it cause the memory to overload... Here is what i am doing and can anyone suggest any better way to handle this?
When a client is sending message to another client this function is called and is supplied with the context of that thread/client/conneciton
Procedure TMainFrm.SendRoomBuffer(Packet: Pointer; Size: Integer; Context: TIdContext);
Var
LocalBuffer: Pointer;
Connected: Boolean;
Begin
If Size < 1 then
Exit;
Try
If Context <> Nil Then
Connected := TRoomContext(Context).Connection.Connected
Else
Connected := False;
Except
Connected := False;
End;
If Connected = True Then Begin
GetMem(LocalBuffer,Size);
CopyMemory(LocalBuffer,Packet,Size);
TRoomContext(Context).Queue.Add(LocalBuffer);
End;
End;
Iterates through all the users present in the room and send them the packet
Lst := Room.UsersList.LockList;
Try
For I := 0 To Lst.Count -1 Do Begin
Try
Username := TRoomUserInfo(Lst.Items[I]).UserName.Value;
If IncludingMe = False Then Begin
If LowerCase(Username) <> LowerCase(MyNick) Then
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[I]).Context)
End Else
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[I]).Context);
Finally
Username := '';
End;
End;
Finally
Room.UsersList.UnlockList;
Lst := Nil;
End;
This is where the actual sending is done, in the Execute of IdTCPServer
If Not TRoomContext(AContext).Queue.IsEmpty Then Begin
tmpQueue := TRoomContext(AContext).Queue.LockList;
Try
While tmpQueue.Count > 0 Do Begin
outBuffer := tmpQueue.items[0];
Try
outLen := PCommunicatorPacket(outBuffer).BufferSize;
SetLength(outBuf,outLen);
Try
CopyMemory(#outBuf[0],outBuffer,outLen);
Try
If Connected Then
AContext.Connection.IOHandler.Write(outBuf)
Finally
tmpQueue.Delete(0);
End;
Finally
SetLength(outBuf,0);
outBuf := Nil;
End;
Finally
If outBuffer <> Nil Then Begin
FreeMem(outBuffer);
outBuffer := Nil;
End;
End;
End;
Finally
TRoomContext(AContext).Queue.UnlockList;
tmpQueue := Nil;
End;
End;
Complete OnExecute Function
Procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
Var Buf: TIdBytes;
Len: Integer;
outBuffer: PIdBytes;
tmpQueue: TList;
Begin
AContext.Connection.IOHandler.CheckForDataOnSource(10);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
Len := AContext.Connection.IOHandler.InputBuffer.Size;
AContext.Connection.IOHandler.ReadBytes(Buf, Len, False);
TRoomContext(AContext).ProcessPacket(#Buf[0], Len, AContext);
SetLength(Buf, 0);
Buf := nil;
end;
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
while tmpQueue.Count > 0 do begin
outBuffer := PIdBytes(tmpQueue.Items[0]);
try
tmpQueue.Delete(0);
AContext.Connection.IOHandler.Write(outBuffer^);
finally
Dispose(outBuffer);
end;
end;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
End;
If a single client is sending to 300 clients present in the room then 300 copies of the packets are made and are freed only when the actual sending is done...
If i do the writing directly to each connection and not by using queues then the memory consumption is not as rogue as this method but server hangs after a few minutes
Sorry if i forgot to mention any more details.
P.S: I am using Delphi 7
EDIT: I just check, if i dont actually write to socket, and go with the whole process as is, then the issue doesn't happen... so it means the time it takes to write to the socket, there are over a few hundred more packets read...
EDIT 2 I copied your code for the OnExecute, if i don't prove a length to ReadBytes then it takes some time about 3-5 seconds to process each command, so i am providing it with the length to read... And i used madexcept it doesnt show any leaks, i am gonna try with FastMM too now... but if there was actually a leak and something was causing it then why would commenting out the actual Write command in OnExecute suppress the memory usage?
EDIT 3 To explain my question further, i am actually reading the bytes from the stream and then process them myself later to make distinct packets from them, here is the code of what happens further after the data is read from the socket.
...
FPacketBuffer: Pointer; // global memory upto 65kb for each client to store the incoming data
PacketBufferPtr: Integer; // the offset upto where the data is read from the global memory
...
procedure TRoomContext.ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: TIdContext);
begin
AddToPacketBuffer(Buffer,BufSize);
CheckAndProcessPacket(Context);
end;
procedure TRoomContext.AddToPacketBuffer(Buffer: Pointer; Size: Integer);
var
DestPtr: Pointer;
begin
if PacketBufferPtr + Size<65536 then
begin
DestPtr := Pointer(Cardinal(FPacketBuffer)+Cardinal(PacketBufferPtr));
Move(Buffer^,DestPtr^,Size);
PacketBufferPtr := PacketBufferPtr + Size;
end
else
begin
end;
end;
procedure TRoomContext.CheckAndProcessPacket(Context: TIdContext);
var DestPtr: Pointer;
NewPacketBufferLen: Integer;
SharedBuff: Pointer;
begin
if PCommunicatorPacket(FPacketBuffer).Signature = PACKET_SIGNATURE then
begin
while PCommunicatorPacket(FPacketBuffer).BufferSize <= PacketBufferPtr do
begin
GetMem(SharedBuff,PCommunicatorPacket(FPacketBuffer).BufferSize);
Try
CopyMemory(SharedBuff,FPacketBuffer,PCommunicatorPacket(FPacketBuffer).BufferSize);
MainFrm.ExecuteRoomPacket(SharedBuff, Context);
Finally
If SharedBuff <> Nil Then FreeMem(SharedBuff);
End;
NewPacketBufferLen := PacketBufferPtr - PCommunicatorPacket(FPacketBuffer).BufferSize;
DestPtr := Pointer(Cardinal(FPacketBuffer)+PCommunicatorPacket(FPacketBuffer).BufferSize);
Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
PacketBufferPtr := NewPacketBufferLen;
end;
end
else
begin
DropInvalidPacket;
Inc(InvalidPackets);
If InvalidPackets > 50 Then
Context.Connection.Disconnect;
Exit;
end;
end;
Apologies for thinking it was because of the writing, the writing actually just slowed deletion from queue which made me think so, if i even put a sleep of 10 milliseconds, the memory consumption go rogue. About the leaks... one other reason i think this is not a leak is because if i stop the bots from messaging further, then the used memory gets back to where it was, but if i leave it running for a few minutes then it goes to a point where the application hangs or i receive an out of memory message. I think the issue is with making copies, i tried using a global queue for the room to handle messages and so multiple copies aren't made of the data, but that cause the application to hang after sometime maybe too much thread contention or i am not playing it safe.
TCP does not support broadcasting, and directly writing to TIdTCPServer connections from outside the server's events is generally not thread-safe (although it can be done if you are careful). In your situation, using queues is a good idea.
However, don't call Connected() in SendRoomBuffer(). It performs a read operation, which can interfere with any reading the OnExecute event handler performs, and can corrupt the InputBuffer's content by reading socket data out of order. If Context is not nil then queue the data regardless of the socket state, and catch any errors.
Also, in the OnDisconnect event, make sure you are freeing any queued packets that were not sent, otherwise you will leak them.
Lastly, your OnExecute code is making another copy of the queued data and then sending that copy (I am assuming that outBuf is a TIdBytes). Try to avoid that. I would suggest you change your queue to store TMemoryStream or TIdBytes objects instead of raw memory blocks, then you can pass the queued items directly to IOHandler.Write() without having to make copies of them first.
Try something like this:
type
PIdBytes = ^TIdBytes;
procedure TMainFrm.SendRoomBuffer(Packet: Pointer; Size: Integer; Context: TIdContext);
var
LocalBuffer: PIdBytes;
begin
if (Packet = nil) or (Size < 1) or (Content = nil) then
Exit;
New(LocalBuffer);
try
LocalBuffer^ := RawToBytes(Packet^, Size);
TRoomContext(Context).Queue.Add(LocalBuffer);
except
Dispose(LocalBuffer);
end;
end;
Lst := Room.UsersList.LockList;
try
for i := 0 To Lst.Count -1 do begin
Username := TRoomUserInfo(Lst.Items[i]).UserName.Value;
if (not IncludingMe) and TextIsSame(Username, MyNick) then begin
Continue;
end;
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[i]).Context);
end;
finally
Room.UsersList.UnlockList;
end;
procedure TMainFrm.RoomSckDisconnect(AContext: TIdContext);
var
tmpQueue: TList;
i: Integer;
begin
...
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
for i := 0 to tmpQueue.Count-1 do begin
Dispose(PIdBytes(tmpQueue.Items[i]));
end;
tmpQueue.Clear;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
...
end;
procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
var
Buf: TIdBytes;
outBuffer: PIdBytes;
tmpQueue: TList;
begin
AContext.Connection.IOHandler.CheckForDataOnSource(10);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.ReadBytes(Buf, -1, False);
TRoomContext(AContext).ProcessPacket(#Buf[0], Len, AContext);
SetLength(Buf, 0);
Buf := nil;
end;
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
while tmpQueue.Count > 0 do begin
outBuffer := PIdBytes(tmpQueue.Items[0]);
try
tmpQueue.Delete(0);
AContext.Connection.IOHandler.Write(outBuffer^);
finally
Dispose(outBuffer);
end;
end;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
end;
In my Delphi project, I derive a thread class TMyThread, and follow the advice from forums to use AllocateHWnd to create a window handle. In TMyThread object, I call SendMessage to send message to the window handle.
When the messages sent are in small volume, then the application works well. However, when the messages are in large volume, the application will deadlock and lose responses. I think may be the message queue is full as in LogWndProc, there are only codes to process the message, but no codes to remove the messages from the queue, that may cause all the processed messages still exist in the queue and the queue becomes full. Is that correct?
The codes are attached below:
var
hLogWnd: HWND = 0;
procedure TForm1.FormCreate(Sender: TObject);
begin
hLogWnd := AllocateHWnd(LogWndProc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if hLogWnd <> 0 then
DeallocateHWnd(hLogWnd);
end;
procedure TForm1.LogWndProc(var Message: TMessage);
var
S: PString;
begin
if Message.Msg = WM_UPDATEDATA then
begin
S := PString(msg.LParam);
try
List1.Items.Add(S^);
finally
Dispose(S);
end;
end else
Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam,
Message.LParam);
end;
procedure TMyThread.SendLog(I: Integer);
var
Log: PString;
begin
New(Log);
Log^ := 'Log: current stag is ' + IntToStr(I);
SendMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(Log));
Dispose(Log);
end;
You are disposing your allocated string twice. At best, you will get an exception in your worker thread after SendMessage() has exited, terminating your thread if you do not catch that exception. At worse, you might not get an exception, but you will trash memory, leaving your app in a bad state so all sorts of random things can happen. You need to dispose the allocated string only once.
You are not responsible for removing sent messages from the queue because SendMessage() does not put the message into the queue. However, it does require the receiving thread to pump its queue for new messages, even if there are no new messages in the queue, in order to dispatch sent messages that are crossing thread boundaries, like your message is. If SendMessage() is blocking then your main thread is not pumping the queue correctly in code you have not shown, such as if you have other code that has blocked the main message loop from running.
As for the code you did show, I would suggest the following change:
procedure TForm1.LogWndProc(var Message: TMessage);
begin
if Message.Msg = WM_UPDATEDATA then
List1.Items.Add(PString(Message.LParam)^)
else
Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam, Message.LParam);
end;
procedure TMyThread.SendLog(I: Integer);
var
Log: String;
begin
Log := 'Log: current stag is ' + IntToStr(I);
SendMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(#Log));
end;
You do not need to dynamically allocate the string if you use SendMessage(), since it blocks the calling thread until the message is processed, ensuring the string remains valid. If you were using PostMessage() instead, then you would need to dynamically allocate (and fix your erroneous use of Dispose()):
procedure TForm1.LogWndProc(var Message: TMessage);
var
S: PString;
begin
if Message.Msg = WM_UPDATEDATA then
begin
S := PString(msg.LParam);
try
List1.Items.Add(S^);
finally
Dispose(S);
end;
end else
Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam, Message.LParam);
end;
procedure TMyThread.SendLog(I: Integer);
var
Log: PString;
begin
New(Log);
Log^ := 'Log: current stag is ' + IntToStr(I);
if not PostMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(Log)) then
Dispose(Log);
end;
In my Application when I write text files (logs, traces, etc), I use TFileStream class.
There are cases that I write the data in multithreaded environment, those are the steps:
1- Write Cache Data
2- For each 1000 lines I save to File.
3- Clear Data.
This process is repeated during all processing.
Problem Description:
With 16 threads, the system throws the following exception:
Access Violation - file already in use by another application.
I guess this is happening because that the handle used by one thread is not closed yet, when another thread needs to open.
I changed the architecture to the following: (bellow is the NEW implementation)
In the previous way, the TFileStream was created with FileName and Mode parameters, and destroyed closing the handle (I wasn't using TMyFileStream)
TMyFileStream = class(TFileStream)
public
destructor Destroy; override;
end;
TLog = class(TStringList)
private
FFileHandle: Integer;
FirstTime: Boolean;
FName: String;
protected
procedure Flush;
constructor Create;
destructor Destroy;
end;
destructor TMyFileStream.Destroy;
begin
//Do Not Close the Handle, yet!
FHandle := -1;
inherited Destroy;
end;
procedure TLog.Flush;
var
StrBuf: PChar; LogFile: string;
F: TFileStream;
InternalHandle: Cardinal;
begin
if (Text <> '') then
begin
LogFile:= GetDir() + FName + '.txt';
ForceDirectories(ExtractFilePath(LogFile));
if FFileHandle < 0 then
begin
if FirstTime then
FirstTime := False;
if FileExists(LogFile) then
if not SysUtils.DeleteFile(LogFile) then
RaiseLastOSError;
InternalHandle := CreateFile(PChar(LogFile), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_NEW, 0,0);
if InternalHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError
else if GetLastError = ERROR_ALREADY_EXISTS then
begin
InternalHandle := CreateFile(PChar(LogFile), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING, 0,0);
if InternalHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError
else
FFileHandle := InternalHandle;
end
else
FFileHandle := InternalHandle;
end;
F := TMyFileStream.Create(FFileHandle);
try
StrBuf := PChar(Text);
F.Position := F.Size;
F.Write(StrBuf^, StrLen(StrBuf));
finally
F.Free();
end;
Clear;
end;
end;
destructor TLog.Destroy;
begin
FUserList:= nil;
Flush;
if FFileHandle >= 0 then
CloseHandle(FFileHandle);
inherited;
end;
constructor TLog.Create;
begin
inherited;
FirstTime := True;
FFileHandle := -1;
end;
There is another better way?
Is this implementation correct?
May I improve this?
My guess about the Handle was right?
All theads use the same Log object.
There is no reentrance, i checked! there is something wrong with the TFileStream.
The Access to the Add is synchronized, I mean, I used critical session, and when it reaches 1000 lines, Flush procedure is called.
P.S: I do not want third-party component, i want to create my own.
Well, for a start, there's no point in TMyFileStream. What you are looking for is THandleStream. That class allows you to supply a file handle whose lifetime you control. And if you use THandleStream you'll be able to avoid the rather nasty hacks of your variant. That said, why are you even bothering with a stream? Replace the code that creates and uses the stream with a call to SetFilePointer to seek to the end of the file, and a call to WriteFile to write content.
However, even using that, your proposed solution requires further synchronization. A single windows file handle cannot be used concurrently from multiple threads without synchronisation. You hint in a comment (should be in the question) that you are serializing file writes. If so then you are just fine.
The threaded solution provided by Marko Paunovic quite nice, however while reviewing the code I noticed a small mistake, perhaps just an oversight in the example but I thought I'd mention it just the same in case someone actually tries to use it as-is.
There is a missing call to Flush in TLogger.Destroy, as a result any unflushed (buffered) data is disgarded when the TLogger object is destroyed.
destructor TLogger.Destroy;
begin
if FStrings.Count > 0 then
Flush;
FStrings.Free;
DeleteCriticalSection(FLock);
inherited;
end;
How about:
In each thread, add log lines to a TStringList instance until lines.count=1000. Then push the TStringList onto a blocking producer-consumer queue, immediately create a new TStringList and carry on logging to the new list.
Use one Logging thread that dequeues the TStringList instances, writes them to the file and then frees them.
This isolates the log writes from disk/network delays, removes any reliance on dodgy file-locking and will actually work reliably.
I figured MY MISTAKE.
In first place, I want to apologize for posting this stupid question without a proper way to reproduce the exception. In other words, without a SSCCE.
The problem was a control flag that my TLog class used internally.
This flag was created, when we started to evolve our product a parallel architecture.
As we needed to keep the previous form working (at least until everything was in the new architecture).
We created some flags to identify if the object was either the new or old version.
One of that flags was named CheckMaxSize.
If CheckMaxSize was enabled, at a certain moment, every data inside the instance of this object in each thread, would be thrown to the main instance, which was in the "main" thread (not the GUI one, because it was a background work). Furthermore, when CheckMaxSize is enabled, TLog should never ever call "flush".
Finally, as you can see, in TLog.Destroy there is no check to CheckMaxSize. Therefore, the problem would happen because the name of the file created by this class was always the same, since it was processing the same task, and when One object created the file and another one tried to create another file with the same name, inside the same folder, the OS (Windows) rose an Exception.
Solution:
Rewrite the destructor to:
destructor TLog.Destroy;
begin
if CheckMaxSize then
Flush;
if FFileHandle >= 0 then
CloseHandle(FFileHandle);
inherited;
end;
If you have multithreaded code that needs to write to single file, it's best to have as much control as you can in your hands. And that means, avoid classes which you are not 100% sure how they work.
I suggest that you use multiple threads > single logger architecture, where each thread will have reference to logger object, and add strings to it. Once 1000 lines are reached, logger would flush the collected data in file.
There is no need to use TFileStream to write data to file, you can
go with CreateFile()/SetFilePointer()/WriteFile(), as David already suggested
TStringList is not thread-safe, so you have to use locks on it
main.dpr:
{$APPTYPE CONSOLE}
uses
uLogger,
uWorker;
const
WORKER_COUNT = 16;
var
worker: array[0..WORKER_COUNT - 1] of TWorker;
logger: TLogger;
C1 : Integer;
begin
Write('Creating logger...');
logger := TLogger.Create('test.txt');
try
WriteLn(' OK');
Write('Creating threads...');
for C1 := Low(worker) to High(worker) do
begin
worker[C1] := TWorker.Create(logger);
worker[C1].Start;
end;
WriteLn(' OK');
Write('Press ENTER to terminate...');
ReadLn;
Write('Destroying threads...');
for C1 := Low(worker) to High(worker) do
begin
worker[C1].Terminate;
worker[C1].WaitFor;
worker[C1].Free;
end;
WriteLn(' OK');
finally
Write('Destroying logger...');
logger.Free;
WriteLn(' OK');
end;
end.
uWorker.pas:
unit uWorker;
interface
uses
System.Classes, uLogger;
type
TWorker = class(TThread)
private
FLogger: TLogger;
protected
procedure Execute; override;
public
constructor Create(const ALogger: TLogger);
destructor Destroy; override;
end;
implementation
function RandomStr: String;
var
C1: Integer;
begin
result := '';
for C1 := 10 to 20 + Random(50) do
result := result + Chr(Random(91) + 32);
end;
constructor TWorker.Create(const ALogger: TLogger);
begin
inherited Create(TRUE);
FLogger := ALogger;
end;
destructor TWorker.Destroy;
begin
inherited;
end;
procedure TWorker.Execute;
begin
while not Terminated do
FLogger.Add(RandomStr);
end;
end.
uLogger.pas:
unit uLogger;
interface
uses
Winapi.Windows, System.Classes;
type
TLogger = class
private
FStrings : TStringList;
FFileName : String;
FFlushThreshhold: Integer;
FLock : TRTLCriticalSection;
procedure LockList;
procedure UnlockList;
procedure Flush;
public
constructor Create(const AFile: String; const AFlushThreshhold: Integer = 1000);
destructor Destroy; override;
procedure Add(const AString: String);
property FlushThreshhold: Integer read FFlushThreshhold write FFlushThreshhold;
end;
implementation
uses
System.SysUtils;
constructor TLogger.Create(const AFile: String; const AFlushThreshhold: Integer = 1000);
begin
FFileName := AFile;
FFlushThreshhold := AFlushThreshhold;
FStrings := TStringList.Create;
InitializeCriticalSection(FLock);
end;
destructor TLogger.Destroy;
begin
FStrings.Free;
DeleteCriticalSection(FLock);
inherited;
end;
procedure TLogger.LockList;
begin
EnterCriticalSection(FLock);
end;
procedure TLogger.UnlockList;
begin
LeaveCriticalSection(FLock);
end;
procedure TLogger.Add(const AString: String);
begin
LockList;
try
FStrings.Add(AString);
if FStrings.Count >= FFlushThreshhold then
Flush;
finally
UnlockList;
end;
end;
procedure TLogger.Flush;
var
strbuf : PChar;
hFile : THandle;
bWritten: DWORD;
begin
hFile := CreateFile(PChar(FFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
try
strbuf := PChar(FStrings.Text);
SetFilePointer(hFile, 0, nil, FILE_END);
WriteFile(hFile, strbuf^, StrLen(strbuf), bWritten, nil);
FStrings.Clear;
finally
CloseHandle(hFile);
end;
end;
end.
I try to connect to (Uni)DDE server from an Indy TCP Server thread.
From normal application I can connect, and can get/set any PLC variables.
But when I use same command from Indy thread (from Execute(AThread: TIdPeerThread) event), the SetLink command failed.
procedure ReadDDE(AppPath, Service, Topic, Cmd: string; out Eredmeny : string; out HibaSzint : string);
var
DDE: TDDEClientConv;
pc : PChar;
begin
Eredmeny := '';
HibaSzint := '';
DDE := TDDEClientConv.Create(nil);
try
DDE.ConnectMode := ddeAutomatic;
DDE.ServiceApplication := AppPath;
DDE.FormatChars := False;
HibaSzint := 'SetLink';
if DDE.SetLink(Service, Topic) then begin
HibaSzint := '';
pc := DDE.RequestData(PChar(Cmd));
Eredmeny := StrPas(pc);
StrDispose(pc);
end;
finally
DDE.Free;
end;
end;
Maybe the DDE is using Windows messages, or other things are not threadsafe, or not catchable in the thread's level?
Thanks for any info about this:
dd
DDE is built on top of windows messages. You need to make sure that messages are dispatched on the thread that has the DDE connection.
I know it is too late but may be someone need this instruction. I have worked too many works on it. I have the same problem (but openlink method, not on Set Link method. I used connection mode ddeManual not automatic).At last I found something. Delphi ddeMgr is in the VCL Unit and it needs to be called in like Synchronize(yourProcedure). When I write another procedure (that procedure include my all dde interactions) and in the threads Execute method, I called my procedure with Synchronize.
My code look like this.
procedure TAskYTSThread.MakeDDEConv;
begin
with TDDEClientConv.Create(Form1) do
begin
ConnectMode:=ddeManual;
ServiceApplication:='explorer.exe';
SetLink('Folders', 'AppProperties') ;
Form1.Memo1.Lines.Add('Openlink çağrılacak Gönderilecek.');
if OpenLink then
begin
Form1.Memo1.Lines.Add('Link Open Edildi.');
ExecuteMacro('[FindFolder(, C:\)]', False) ;
CloseLink;
end
else
begin
Form1.Memo1.Lines.Add('OLMADIIIIIII');
end;
Free;
end;
end;
procedure TAskYTSThread.Execute;
var
blnRunning : boolean ;
FYtsTopicName, strMacro : string ;
begin
inherited;
FDDE_BUSY.Enter ;
try
blnRunning := IsYTSRunning;
Synchronize(MakeDDEConv); // this is key point
finally
FDDE_BUSY.Leave ;
end;
end;
I wish this information help other people :)
I just realized that my exceptions are not being shown to the user in my threads!
At first I used this in my thread for raising the exception, which does not work:
except on E:Exception do
begin
raise Exception.Create('Error: ' + E.Message);
end;
The IDE shows me the exceptions, but my app does not!
I have looked around for a solution, this is what I found:
Delphi thread exception mechanism
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_22039681.html
And neither of these worked for me.
Here's my Thread unit:
unit uCheckForUpdateThread;
interface
uses
Windows, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, GlobalFuncs, Classes, HtmlExtractor, SysUtils, Forms;
type
TUpdaterThread = class(TThread)
private
FileGrabber : THtmlExtractor;
HTTP : TIdHttp;
AppMajor,
AppMinor,
AppRelease : Integer;
UpdateText : string;
VersionStr : string;
ExceptionText : string;
FException: Exception;
procedure DoHandleException;
procedure SyncUpdateLbl;
procedure SyncFinalize;
public
constructor Create;
protected
procedure HandleException; virtual;
procedure Execute; override;
end;
implementation
uses
uMain;
{ TUpdaterThread }
constructor TUpdaterThread.Create;
begin
inherited Create(False);
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(nil);
try
try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
except on E: Exception do
begin
UpdateText := 'Error while updating xSky!';
ExceptionText := 'Error: Cannot find remote file! Please restart xSky and try again! Also, make sure you are connected to the Internet, and that your Firewall is not blocking xSky!';
HandleException;
end;
end;
try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
except on E:Exception do
begin
HandleException;
end;
end;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then
begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.SyncFinalize;
begin
DoTransition(frmMain.TransSearcher3, frmMain.gbLogin, True, 500);
end;
procedure TUpdaterThread.SyncUpdateLbl;
begin
frmMain.lblCheckingForUpdates.Caption := UpdateText;
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TUpdaterThread.DoHandleException;
begin
Application.ShowException(FException);
end;
end.
If you need more info just let me know.
Again: The IDE catches all the exceptions, but my program does not show them.
EDIT: It was Cosmin's solution that worked in the end - and the reason it didn't at first, was because I didn't add the ErrMsg variable, instead I just placed whatever the variable would contain into the Synchronize, which would NOT work, however I have NO idea why. I realized it when I had no other ideas, and I just messed around with the solutions.
As always, the joke's on me. =P
Something very important you need to understand about multi-theraded development:
Each thread has its own call-stack, almost as if they're separate programs. This includes the main-thread of your program.
Threads can only interact with each other in specific ways:
They can operate on shared data or objects. This can lead to concurrency issues 'race conditions', and therefore you need to be able to help them 'share data nicely'. Which brings us to the next point.
They can "signal each other" using a variety of OS support routines. These include things like:
Mutexes
Critical Sections
Events
And finally you can send messages to other threads. Provided the thread has in some way been written to be a message receiver.
NB: Note that threads cannot strictly speaking call other threads directly. If for example Thread A tried to call Thread B directly, that would be a step on Thread A's call-stack!
This brings us to the topic of the question: "exceptions are not being raised in my threads"
The reason for this is that all an exception does is:
Record the error
And unwind the call-stack. <-- NB: Your TThread instance can't unwind the main thread's call-stack, and cannot arbitrarily interrupt the main threads execution.
So TThread will not automatically report exceptions to your main application.
You have to make the explicit decision as to how you wish to handle errors in threads, and implement accordingly.
Solution
The first step is the same as within a single threaded application. You need to decide what the error means and how the thread should react.
Should the thread continue processing?
Should the thread abort?
Should the error be logged/reported?
Does the error need a user decision? <-- This is by far the most difficult to implement, so we'll skip it for now.
Once this has been decided, implement the appropriate excpetion handler.
TIP: Make sure the exception doesn't escape the thread. The OS won't like you if it does.
If you need the main program (thread) to report the error to the user, you have a few options.
If the thread was written to return a result object, then it's easy: Make a change so that it can return the error in that object if something went wrong.
Send a message to the main thread to report the error. Note, the main thread already implements a message loop, so your application will report the error as soon as it processes that message.
EDIT: Code Sample for indicated requirement.
If all you want to do is notify the user, then Cosmind Prund's answer
should work perfectly for Delphi 2010. Older versions of Delphi need a little more work. The following is conceptually similar to Jeff's own answer, but without the mistakes:
procedure TUpdaterThread.ShowException;
begin
MessageDlg(FExceptionMessage, mtError, [mbOk], 0);
end;
procedure TUpdaterThread.Execute;
begin
try
raise Exception.Create('Test Exception');
//The code for your thread goes here
//
//
except
//Based on your requirement, the except block should be the outer-most block of your code
on E: Exception do
begin
FExceptionMessage := 'Exception: '+E.ClassName+'. '+E.Message;
Synchronize(ShowException);
end;
end;
end;
Some important corrections on Jeff's own answer, including the implementation shown within his question:
The call to Terminate is only relevant if your thread is implemented within a while not Terminated do ... loop. Take a look at what the Terminate method actually does.
The call to Exit is an unnecessary waste, but you probably did this because of your next mistake.
In your question, you're wrapping each step in its own try...except to handle the exception. This is an absolute no-no! By doing this you pretend that even though an exception occurred, everything is ok. Your thread tries the next step, but is actually guaranteed to fail! This is not the way to handle exceptions!
Here's my very, very short "take" on the issue. It only works on Delphi 2010+ (because that version introduced Anonymous methods). Unlike the more sophisticated methods already posted mine only shows the error message, nothing more, nothing less.
procedure TErrThread.Execute;
var ErrMsg: string;
begin
try
raise Exception.Create('Demonstration purposes exception');
except on E:Exception do
begin
ErrMsg := E.ClassName + ' with message ' + E.Message;
// The following could be all written on a single line to be more copy-paste friendly
Synchronize(
procedure
begin
ShowMessage(ErrMsg);
end
);
end;
end;
end;
Threads don't automatically propagate exceptions into other threads. So you must deal with it yourself.
Rafael has outlined one approach, but there are alternatives. The solution Rafael points to deals with the exception synchronously by marshalling it into the main thread.
In one of my own uses of threading, a thread pool, the threads catch and take over the ownership of the exceptions. This allows the controlling thread to handle them as it pleases.
The code looks like this.
procedure TMyThread.Execute;
begin
Try
DoStuff;
Except
on Exception do begin
FExceptAddr := ExceptAddr;
FException := AcquireExceptionObject;
//FBugReport := GetBugReportCallStackEtcFromMadExceptOrSimilar.
end;
End;
end;
If the controlling thread elects to raise the exception it can do so like this:
raise Thread.FException at Thread.FExceptAddr;
Sometimes you may have code that cannot call Synchronize, e.g. some DLLs and this approach is useful.
Note that if you don't raise the exception that was captured, then it needs to be destroyed otherwise you have a memory leak.
Well,
It is gonna be hard without your source code, but i have tested this:
How to handle exceptions in TThread objects
And it works fine. Perhaps you should take a look at it.
EDIT:
You are not following what the links you point out tell us to do. Check my link and you will see how to do that.
EDIT 2:
Try that and tell me if it worked:
TUpdaterThread= class(TThread)
private
FException: Exception;
procedure DoHandleException;
protected
procedure Execute; override;
procedure HandleException; virtual;
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(Nil);
try
Try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
Except
HandleException;
End;
Try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
Except
HandleException;
End;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TMyThread.DoHandleException;
begin
Application.ShowException(FException);
end;
EDIT 3:
You said you are no able to catch EIdHTTPProtocolException. But it works for me. Try this sample and see it for yourself:
procedure TUpdaterThread.Execute;
begin
Try
raise EIdHTTPProtocolException.Create('test');
Except
HandleException;
End;
end;
I've previously used SendMessge for inter thread communication using the TWMCopyData, so I think the following should work:
Const MyAppThreadError = WM_APP + 1;
constructor TUpdaterThread.Create(ErrorRecieverHandle: THandle);
begin
Inherited Create(False);
FErrorRecieverHandle := Application.Handle;
end;
procedure TUpdaterThread.Execute;
var
cds: TWMCopyData;
begin
try
DoStuff;
except on E:Exception do
begin
cds.dwData := 0;
cds.cbData := Length(E.message) * SizeOf(Char);
cds.lpData := Pointer(#E.message[1]);
SendMessage(FErrorRecieverHandle, MyAppThreadError, LPARAM(#cds), 0);
end;
end;
end;
I've only used it for sending simple data types or strings, but I'm sure it could be adapted send more information through as necessary.
You'll need add Self.Handle to the constructor in form created the thread and Handle the messsage in the form which created it
procedure HandleUpdateError(var Message:TMessage); message MyAppThreadError;
var
StringValue: string;
CopyData : TWMCopyData;
begin
CopyData := TWMCopyData(Msg);
SetLength(StringValue, CopyData.CopyDataStruct.cbData div SizeOf(Char));
Move(CopyData.CopyDataStruct.lpData^, StringValue[1], CopyData.CopyDataStruct.cbData);
Message.Result := 0;
ShowMessage(StringValue);
end;
Strange that everyone answered this question but failed to spot the obvious problem: given that exceptions raised in a background thread are asynchronous, and can occur at any time, this means that showing exceptions from a background thread would pop-up a dialog box at random times to the user, quite possibly showing an exception that has nothing to do with what the user is doing at the moment. I doubt that doing this could possibly enhance the user experience.