Delphi Thread and TCriticalSection - multithreading

I encounter some strange behaviors with threads so I guess there is something I'm doing wrong or something I don't understand.
My application (Delphi Berlin) has two processes : a service and a console app. They communitcate via socket (Indy).
Each process has a thread dedicated to communication.
I use TCriticalSection when I need to read/write variables used by main thread and by communication Thread.
I also make intensive usage of log. The log can be written (one log file by process) by main thread and by communication thread.
So what I'm doing when I want to write a trace in log file is to use a variable TCriticalSection to prevent main thread and commmunication thread to write to the log file at the same time:
Procedure TApp.trace(logLevel : byte; procName , pi_str: string);
var F: textfile;
LogFileName: String;
vl_log : Boolean;
vc_LogHeader : String;
th, thcurrent : TTh;
begin
if GetLog() then begin // False if log is deactivated
for th := Low(TTh) to High(TTh) do begin
if TThread.CurrentThread.ClassName = ThreadsLog.Name[th] then begin
thcurrent := th;
break;
end;
end;
if ThreadsLog.LogLevel[thcurrent] < logLevel then exit;
LogFileName := gc_tmp + WinProc.Name[WHO_AM_I] + '.log';
vc_LogHeader := '[' + GetLogTime + ' ' + ThreadsLog.Name[thcurrent] + ' ' + procName + ' ' + IntToStr(logLevel) + ']';
if Length(vc_LogHeader) < 60 then vc_LogHeader := vc_LogHeader + StringOfChar (' ', 60 - Length(vc_LogHeader) );
LockTrace.Acquire;
try
try
{$IFDEF MACOS}
AssignFile(F, LogFileName, CP_UTF8);
{$ELSE}
AssignFile(F, LogFileName);
{$ENDIF}
if FileExists(LogFileName) then Append(F) else Rewrite(F);
{$IFDEF MACOS}
Writeln(F, UTF8String(vc_LogHeader + AnsiString(pi_str)));
{$ELSE}
Writeln(F, vc_LogHeader + pi_str);
{$ENDIF}
CloseFile(F);
except
on e : exception do begin
dbg(LogFileName + ' ' + e.Message);
end;
end;
finally
lockTrace.Release;
end;
end;
end;
function TApp.GetLog() : boolean;
begin
gl_logLock.Acquire;
try
result := gl_log;
finally
gl_logLock.Release;
end;
end;
However sometimes, some lines are not written to the file.
But dbg(LogFileName + ' ' + e.Message) does not execute cause it is supposed to write in another log file and this file stays empty. So no exception seems to be fired.
Is it possible to use TCriticalSection this way ?
What I understand about TCriticalSection, is that it puts a lock so others threads trying to put their own lock have to wait until it is released. Is that right ?
I guess I can use one variable or several variables TCriticalSection. If I use only one variable, there will be more cases where a lock exists so more time to wait. If I use one TCriticalSection per shared variable, there will be less locks so better performances. Is it right ?
Thanks for any correction or clarification.

There are many problems with your code, not all thread / critical section related.
function TApp.GetLog() : boolean;
begin
gl_logLock.Acquire;
try
result := gl_log;
finally
gl_logLock.Release;
end;
end;
The above lock code is useless it doesn't provide any protection whatsoever. Reading a boolean variable is already atomic. It's also symptomatic of a common misunderstanding of how to make code thread-safe.
Locks are intended to protect access to data.
The above pattern is often incorrectly used to protect access to an object.
But once the calling code is able to start using the object, you're already outside the lock.
I.e the underlying data of the object is no longer protected from concurrent thread access.
for th := Low(TTh) to High(TTh) do begin
if TThread.CurrentThread.ClassName = ThreadsLog.Name[th] then begin
thcurrent := th;
break;
end;
end;
if ThreadsLog.LogLevel[thcurrent] < logLevel then exit;
In the above, if the loop ever ends without the if condition evaluating to True, thcurrent will be uninitialised leading to undefined behaviour. Anything from AV exceptions to things just not behaving as you'd expect.
Quite possibly ThreadsLog.LogLevel[thcurrent] < logLevel could evaluate to True (and Exit) without triggering an AV for some undefined values of thcurrent.
Also note that looping through your threads and doing string comparisons is a pretty inefficient way to check your current thread. It's not clear what you're trying to achieve, but you should be able to figure certain things out simply from the current thread id.
You say dbg(LogFileName + ' ' + e.Message); is not called. Well there are many reasons it might not be called. You'll have to figure out which (1 or multiple) apply.
You could Exit early.
GetLog() might return False.
Any exception before the try..except block won't get there.
If you've disabled IO errors, an exception won't be raised by old-style file operations. You would have to manually check them using IOResult.
And of course dbg might be called, but could itself also fail in some way.

Related

How to make multiple threads do work on a single TStringList

I want to be able to make multiple threads do work on a single TStringList. This is my current Thread code for using a single thread to do the work;
type
TFilterThread = class(TThread)
protected
procedure Execute; override;
public
lCombos : TStringList;
//Public Vars
end;
procedure TFilterThread.Execute;
var
I: integer;
HTML: String;
frm1 : TForm1;
splitLogin: TStringList;
validCount: Integer;
begin
validCount := 0;
for I := 0 to lCombos.Count - 1 do
begin
if Terminated then Exit();
Unit1.Form1.ListBox1.ItemIndex := i;
try
HTML := Unit1.Form1.IdHTTP1.Get(EmailCheckURL + lCombos[i]);
if AnsiPos('You indicated you', HTML) > 0 then
begin
//Do stuff
end;
except
Continue;
end;
end;
Showmessage('Finished!');
Unit1.Form1.Button1.Caption := 'Start';
end;
To Start the thread I use;
lComboLsit := TStringList.Create;
for I := 0 to listBox1.Items.Count -1 do
lComboLsit.Add(listBox1.Items[i]);`
iTFilterThread := TFilterThread.Create(True);
iTFilterThread.FreeOnTerminate := True;
iTFilterThread.lCombos := lComboLsit;
iTFilterThread.Start;
How would I introduce another thread to also do work on the lCombos list so that the operation would complete quicker?
The answer is that it depends. If the string list is not modified, then there's nothing to do. If the string list is modified then what is best depends critically on your specific usage.
Looking at your code, your program may not be CPU bound and so adding more threads may not help. Your program's bottleneck will the HTTP communication. However, despite not being CPU bound it is plausible that running multiple threads will reduce the impact HTTP latency. You can benchmark to find out. You don't appear to be modifying the string list so there's no race problems to be concerned with there.
However, here's a problem:
Unit1.Form1.IdHTTP1.Get(EmailCheckURL + lCombos[i]);
That will work, and is thread safe so long as TIdHTTP is thread safe. But it's pretty ugly to allow a thread to access a component on a form like that. And I don't see any real sense or need to share the TIdHTTP instance between threads. It would be far cleaner to let each thread instantiate and use their own TIdHTTP component.
Of course, you will need to decide on a policy for dividing the work between all your threads. You could have a shared index that keeps track of the next item to process. Have each thread increment it atomically each time they take an item. A parallel for loop would be a good fit here. That's available in the latest version of Delphi, or in any decent third party parallel library.
You do have some problems with your code. In the thread procedure you do this:
Unit1.Form1.ListBox1.ItemIndex := i;
....
Unit1.Form1.Button1.Caption := 'Start';
You cannot access VCL components from a thread.
And then you do this
ShowMessage('Finished!');
Don't show UI from a thread.
A point of idiom. Instead of looping over the items in your list box you can simply do this:
lComboLsit.Assign(listBox1.Items);

Multithreaded file upload synchronization

Currently I am working on a Delphi XE3 client/server application to transfer files (with the Indy FTP components). The client part monitors a folder, gets a list of the files inside, uploads them to the server and deletes the originals. The uploading is done by a separate thread, which processes files one by one. The files can range from 0 to a few thousand and their sizes also vary a lot.
It is a Firemonkey app compiled for both OSX and Windows, so I had to use TThread instead of OmniThreadLibrary, which I preferred. My customer reports that the application randomly freezes. I could not duplicate it, but since I don't have so much experience with TThread, I might have put deadlock condition somewhere. I read quite a lot of examples, but I'm still not sure about some of the multithread specifics.
The app structure is simple:
A timer in the main thread checks the folder and gets information about each file into a record, which goes into a generic TList. This list keeps information about the names of the files, size, the progress, whether the file is completely uploaded or has to be retried. All that is displayed in a grid with progress bars, etc. This list is accessed only by the main thread.
After that the items from the list are sent to the thread by calling the AddFile method (code below). The thread stores all files in a thread-safe queue like this one http://delphihaven.wordpress.com/2011/05/06/using-tmonitor-2/
When the file is uploaded the uploader thread notifies the main thread with a call to Synchronize.
The main thread periodically calls the Uploader.GetProgress method to check the current file progress and display it. This function is not actually thread-safe, but could it cause a deadlock, or only wrong data returned?
What would be a safe and efficient way to do the progress check?
So is this approach OK or I have missed something? How would you do this?
For example I though of making a new thread just to read the folder contents. This means that the TList I use has to be made thread-safe, but it has to be accessed all the time to refresh the displayed info in the GUI grid. Wouldn't all the synchronization just slow down the GUI?
I have posted the simplified code below in case someone wants to look at it. If not, I would be happy to hear some opinions on what I should use in general. The main goals are to work on both OSX and Windows; to be able to display information about all the files and the progress of the current one; and to be responsive regardless of the number and size of the files.
That's the code of the uploader thread. I have removed some of it for easier reading:
type
TFileStatus = (fsToBeQueued, fsUploaded, fsQueued);
TFileInfo = record
ID: Integer;
Path: String;
Size: Int64;
UploadedSize: Int64;
Status: TFileStatus;
end;
TUploader = class(TThread)
private
FTP: TIdFTP;
fQueue: TThreadedQueue<TFileInfo>;
fCurrentFile: TFileInfo;
FUploading: Boolean;
procedure ConnectFTP;
function UploadFile(aFileInfo: TFileInfo): String;
procedure OnFTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
procedure SignalComplete;
procedure SignalError(aError: String);
protected
procedure Execute; override;
public
property Uploading: Boolean read FUploading;
constructor Create;
destructor Destroy; override;
procedure Terminate;
procedure AddFile(const aFileInfo: TFileInfo);
function GetProgress: TFileInfo;
end;
procedure TUploader.AddFile(const aFileInfo: TFileInfo);
begin
fQueue.Enqueue(aFileInfo);
end;
procedure TUploader.ConnectFTP;
begin
...
FTP.Connect;
end;
constructor TUploader.Create;
begin
inherited Create(false);
FreeOnTerminate := false;
fQueue := TThreadedQueue<TFileInfo>.Create;
// Create the TIdFTP and set ports and other params
...
end;
destructor TUploader.Destroy;
begin
fQueue.Close;
fQueue.Free;
FTP.Free;
inherited;
end;
// Process the whole queue and inform the main thread of the progress
procedure TUploader.Execute;
var
Temp: TFileInfo;
begin
try
ConnectFTP;
except
on E: Exception do
SignalError(E.Message);
end;
// Use Peek instead of Dequeue, because the item should not be removed from the queue if it fails
while fQueue.Peek(fCurrentFile) = wrSignaled do
try
if UploadFile(fCurrentFile) = '' then
begin
fQueue.Dequeue(Temp); // Delete the item from the queue if succesful
SignalComplete;
end;
except
on E: Exception do
SignalError(E.Message);
end;
end;
// Return the current file's info to the main thread. Used to update the progress indicators
function TUploader.GetProgress: TFileInfo;
begin
Result := fCurrentFile;
end;
// Update the uploaded size for the current file. This information is retrieved by a timer from the main thread to update the progress bar
procedure TUploader.OnFTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
fCurrentFile.UploadedSize := AWorkCount;
end;
procedure TUploader.SignalComplete;
begin
Synchronize(
procedure
begin
frmClientMain.OnCompleteFile(fCurrentFile);
end);
end;
procedure TUploader.SignalError(aError: String);
begin
try
FTP.Disconnect;
except
end;
if fQueue.Closed then
Exit;
Synchronize(
procedure
begin
frmClientMain.OnUploadError(aError);
end);
end;
// Clear the queue and terminate the thread
procedure TUploader.Terminate;
begin
fQueue.Close;
inherited;
end;
function TUploader.UploadFile(aFileInfo: TFileInfo): String;
begin
Result := 'Error';
try
if not FTP.Connected then
ConnectFTP;
FUploading := true;
FTP.Put(aFileInfo.Path, ExtractFileName(aFileInfo.Path));
Result := '';
finally
FUploading := false;
end;
end;
And parts of the main thread that interact with the uploader:
......
// Main form
fUniqueID: Integer; // This is a unique number given to each file, because there might be several with the same names(after one is uploaded and deleted)
fUploader: TUploader; // The uploader thread
fFiles: TList<TFileInfo>;
fCurrentFileName: String; // Used to display the progress
function IndexOfFile(aID: Integer): Integer; //Return the index of the record inside the fFiles given the file ID
public
procedure OnCompleteFile(aFileInfo: TFileInfo);
procedure OnUploadError(aError: String);
end;
// This is called by the uploader with Synchronize
procedure TfrmClientMain.OnUploadError(aError: String);
begin
// show and log the error
end;
// This is called by the uploader with Synchronize
procedure TfrmClientMain.OnCompleteFile(aFileInfo: TFileInfo);
var
I: Integer;
begin
I := IndexOfFile(aFileInfo.ID);
if (I >= 0) and (I < fFiles.Count) then
begin
aFileInfo.Status := fsUploaded;
aFileInfo.UploadedSize := aFileInfo.Size;
FFiles.Items[I] := aFileInfo;
Inc(FFilesUploaded);
TFile.Delete(aFileInfo.Path);
colProgressImg.UpdateCell(I);
end;
end;
procedure TfrmClientMain.ProcessFolder;
var
NewFiles: TStringDynArray;
I, J: Integer;
FileInfo: TFileInfo;
begin
// Remove completed files from the list if it contains more than XX files
while FFiles.Count > 1000 do
if FFiles[0].Status = fsUploaded then
begin
Dec(FFilesUploaded);
FFiles.Delete(0);
end else
Break;
NewFiles := TDirectory.GetFiles(WatchFolder, '*.*',TSearchOption.soAllDirectories);
for I := 0 to Length(NewFiles) - 1 do
begin
FileInfo.ID := FUniqueID;
Inc(FUniqueID);
FileInfo.Path := NewFiles[I];
FileInfo.Size := GetFileSizeByName(NewFiles[I]);
FileInfo.UploadedSize := 0;
FileInfo.Status := fsToBeQueued;
FFiles.Add(FileInfo);
if (I mod 100) = 0 then
begin
UpdateStatusLabel;
grFiles.RowCount := FFiles.Count;
Application.ProcessMessages;
if fUploader = nil then
break;
end;
end;
// Send the new files and resend failed to the uploader thread
for I := 0 to FFiles.Count - 1 do
if (FFiles[I].Status = fsToBeQueued) then
begin
if fUploader = nil then
Break;
FileInfo := FFiles[I];
FileInfo.Status := fsQueued;
FFiles[I] := FileInfo;
SaveDebug(1, 'Add: ' + ExtractFileName(FFiles[I].Path));
FUploader.AddFile(FFiles[I]);
end;
end;
procedure TfrmClientMain.tmrGUITimer(Sender: TObject);
var
FileInfo: TFileInfo;
I: Integer;
begin
if (fUploader = nil) or not fUploader.Uploading then
Exit;
FileInfo := fUploader.GetProgress;
I := IndexOfFile(FileInfo.ID);
if (I >= 0) and (I < fFiles.Count) then
begin
fFiles.Items[I] := FileInfo;
fCurrentFileName := ExtractFileName(FileInfo.Path);
colProgressImg.UpdateCell(I);
end;
end;
function TfrmClientMain.IndexOfFile(aID: Integer): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to FFiles.Count - 1 do
if FFiles[I].ID = aID then
Exit(I);
end;
This may not be the problem, but TFileInfo is a record.
This means that when passed as a (non const/var) parameter, it gets copied. This can result in issues with things like strings in the record which don't get reference counts updated when the record is copied.
One thing to try would be to make it a class and pass an instance as the parameter (i.e. a Pointer to the data on the heap).
Something else to watch out for is shared Int64's (e.g. your size values) on threaded 32bit systems.
Updating/reading these is not done atomically & you don't have any specific protections, so it is possible for a read of the value to get mismatched upper and lower 32-bits due to threading. (e.g. Read Upper 32 bits, Write Upper 32bits, Write lower 32bits, Read Lower 32bits, with reads & write in different threads). This is probably not causing the problems you are seeing and unless you are working with files transfers of > 4GB, unlikely to ever cause you any issues.
Deadlocks are definitely hard to spot, but this may be the problem.
In your code, I didn't see that you added any timeout to the enqueue, peek or dequeue - which means it will take the default of Infinite.
The enqueue has this line in it - meaning, like any synchronization object, it will block until either the Enter completes (it locks the monitor) or the Timeout occurs (since you don't have a timeout, it will wait forever)
TSimpleThreadedQueue.Enqueue(const Item: T; Timeout: LongWord): TWaitResult;
...
if not TMonitor.Enter(FQueue, Timeout)
I'm also going to make the assumption that you implemented PEEK yourself based on the Dequeue - only you don't actually remove the item.
That appears to implement its own timeout - however, you still have the following:
function TSimpleThreadedQueue.Peek/Dequeue(var Item: T; Timeout: LongWord): TWaitResult;
...
if not TMonitor.Enter(FQueue, Timeout)
Where timeout is Infinite - so, if you are in the peek method waiting for it to be signaled with an infinite timeout, then you can't Enqueue something from a second thread without blocking that thread waiting for the peek method to become complete on an infinite timeout.
Here is a snippet of the comment from TMonitor
Enter locks the monitor object with an optional timeout (in ms) value.
Enter without a timeout will wait until the lock is obtained.
If the procedure returns it can be assumed that the lock was acquired.
Enter with a timeout will return a boolean status indicating whether or
not the lock was obtained (True) or the attempt timed out prior to
acquire the lock (False). Calling Enter with an INFINITE timeout
is the same as calling Enter without a timeout.
Since the implementation uses Infinite by default, and a TMonitor.Spinlock value is not provided, that will block the thread until it can acquire the FQueue object.
My suggestion would be to change your code as follows:
// Use Peek instead of Dequeue, because the item should not be removed from the queue if it fails
while true do
case fQueue.Peek(fCurrentFile,10)
wrSignaled:
try
if UploadFile(fCurrentFile) = '' then
begin
fQueue.Dequeue(Temp); // Delete the item from the queue if succesful
SignalComplete;
end;
except
on E: Exception do
SignalError(E.Message);
end;
wrTimeout: sleep(10);
wrIOCompletion,
wrAbandoned,
wrError: break;
end; //case
This way, peek won't hold the lock on FQueue indefinitely, leaving a window for the Enqueue to acquire it and add the file from the main (UI) thread.
This might be a long shot, but here is another possibility [the former answer may be more likely] (something I just ran across, but had known before): The use of Synchronize may be causing the deadlock. Here is a blog about why this happens:
Delphi-Workaround-for-TThread-SynchronizeWaitFor-.aspx
The pertinent point from the article:
Thread A calls Synchronize(MethodA)
Thread B calls Synchronize(MethodB)
Then, inside the context of the Main Thread:
Main thread calls CheckSynchronize() while processing messages
CheckSynchronize is implemented to batch-process all waiting calls(*). So it picks up the
queue of waiting calls (containing MethodA and MethodB) and loops
through them one by one.
MethodA executes in the main thread's
context. Assume MethodA calls ThreadB.WaitFor
WaitFor calls
CheckSynchronize to process any waiting calls to Synchronize
In theory, this should then process ThreadB's Synchronize(MethodB),
allowing Thread B to complete. However, MethodB is already a
possession of the first CheckSynchronize call, so it never gets
called.
DEADLOCK!
Embarcadero QC article describing the problem in more detail.
While I don't see any ProcessMessages calls in the above code, or for that matter, a WaitFor that would be called during a Synchronize, it could still be a problem that at the point a synchronize is called, another thread calls the synchronize as well - but the main thread has already synchronized and is blocking.
This didn't click with me at first, because I tend to avoid Synchronize calls like the plague and usually design UI updates from threads using other methods like message passing and thread safe lists with message notification instead of synchronize calls.

Update TWebBrowser in a separate thread?

I use a TWebBrowser to show a Google map. The problem is that it blocks the main ui thread while it loads the map. Is it possible to update the map in a separate thread?
Edit:
RRUZ you are right TWebBrowser have async loading for the URL.
But I found the problem why it blocks
The call:
if WaitWhileProcessing and (MapQueryResult.Count > 0) then
Result := MapQueryResult[0] as TMapQuery;
and the method:
function TMapItemCollection.WaitWhileProcessing: Boolean;
var
vMaxSleepCnt: Integer;
begin
Result := True;
vMaxSleepCnt := 0;
while Processing or Loading do
begin
inc(vMaxSleepCnt);
Application.ProcessMessages;
Sleep(100);
if vMaxSleepCnt = 100 then
begin
Result := False;
Break;
end;
end;
end;
So it seems to fix this the code should be refactored. But this is not the scope for this question.
When the if statement is executed and calls WaitWhileProcessing to evaluate the condition, it loops a 100 times with a 10th of a second sleep. But what messages are waiting when calling ProcessMessages? Could the method be called again recursively? It will never get to the sleep but keeps invoking this method. By the way, be aware that ProcessMessages is really bad practice, but for now... try this:
var
isWaitWhileProcessingBusy :boolean = false;
function TMapItemCollection.WaitWhileProcessing: Boolean;
var
vSleepCnt: Integer;
begin
if not isWaitWhileProcessingBusy then
begin
isWaitWhileProcessingBusy = true;
vSleepCnt := 0;
while Processing or Loading or vSleepCnt < 100 do
begin
inc(vSleepCnt);
Application.ProcessMessages;
Sleep(100);
end;
isWaitWhileProcessingBusy := false;
end;
Result = Processing or Loading;
end;
As you can see I also changed some other minor things. The break is not in the while condition and the result is simply the result of Processing or Loading (because that expression gives the actual result). The extra isWaitWhileProcessingBusy outside of the function keeps the message loop from re-entering. Hopefully that will prevent locking up the user interface. This also isn't best practice but for now it just might help to resolve and with it pinpoint the problem.
Is there a reason why you poll Loading/Processing? Wouldn't it be much easier to use the OnDocumentComplete event of TWebBrowser?
... and another thought crossed my mind... Have you checked the task manager? google maps is using flash, an activex component also using the main UI Thread. This could also be the resource hog causing starvation.
Good luck!

Is it safe to access VT data from the other thread?

Is it safe to change VirtualTreeView data from the secondary thread ?
And if yes, should I use critical sections (or even Synchronize method) ?
I'm afraid that when I'll be writing to the VT's data record from the other thread, main thread invokes its repaint meanwhile and this refresh will cause reading of the same record at one time. I would supplement I'm using only 2 threads in the application.
Something like ...
type
PSomeRecord = ^TSomeRecord;
TSomeRecord = record
SomeString: string;
SomeInteger: integer;
SomeBoolean: boolean;
end;
...
var FCriticalSection: TRTLCriticalSection; // global for both classes
...
procedure TMyCreatedThread.WriteTheTreeData;
var CurrentData: PSomeRecord;
begin
EnterCriticalSection(FCriticalSection); // I want to protect only the record
CurrentData := MainForm.VST.GetNodeData(MainForm.VST.TopNode);
with CurrentData^ do // I know, the ^ is not necessary but I like it :)
begin
SomeString := 'Is this safe ? What if VT will want this data too ?';
SomeInteger := 777;
SomeBoolean := True;
end;
LeaveCriticalSection(FCriticalSection);
MainForm.VST.Invalidate;
end;
// at the same time in the main thread VT needs to get text from the same data
// is it safe to do it this way ?
procedure TMainForm.VST_GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var CurrentData: PSomeRecord;
begin
EnterCriticalSection(FCriticalSection); // I want to protect only the record
CurrentData := VST.GetNodeData(VST.TopNode);
with CurrentData^ do
begin
case Column of
0: CellText := SomeString;
1: CellText := IntToStr(SomeInteger);
2: CellText := BoolToStr(SomeBoolean);
end;
end;
LeaveCriticalSection(FCriticalSection);
end;
// I'm afraid the concurrent field reading may happen only here with the private VT fields
// FNodeDataSize, FRoot and FTotalInternalDataSize, since I have Node.Data locked by the
// critical sections in the VT events, some of those may be accessed when VT is refreshed
// somehow
function TBaseVirtualTree.GetNodeData(Node: PVirtualNode): Pointer;
begin
Assert(FNodeDataSize > 0, 'NodeDataSize not initialized.');
if (FNodeDataSize <= 0) or (Node = nil) or (Node = FRoot) then
Result := nil
else
Result := PByte(#Node.Data) + FTotalInternalDataSize;
end;
Update
I've added the critical sections to the code, is it really unsafe to call GetNodeData from TMyCreatedThread class, even if this function only returns a pointer to the record ?
Thanks a lot
Regards
No, especially the way you're doing it.
VST is a visual control. So is MainForm, which you're referring to directly from your thread. GUI controls are not thread-safe, and shouldn't be accessed directly from a thread. In addition, you're referring to the global variable 'MainForm' from the thread. This is absolutely NOT thread-safe.
If you need to access the data for the VST from both your main form and a separate thread, don't store it directly in VST.Node.Data. Keep it in an external list that you can surround with a critical section or some other thread-safe method, and access that external list in the thread (locking it first) or your main form in the VST events. See TLockList in the Delphi RTL for an example of a lockable list, and TMultipleReadExclusiveWrite for a sample synchronization class.

BeginThread Structure - Delphi

I've got a almost completed app now and the next feature I want to implement is threading. I chose to go with BeginThread(), although am aware of TThread in delphi. The problem I'm coming across is the structure of BeginThread() call. Normally the line in the program that would call the function I want to be threaded is
CompareFiles(form1.Edit3.Text,Form1.Edit4.Text,Form1.StringGrid2,op);
op is a integer.
The line I've switched it out for to create a thread from it is
BeginThread(nil,0,CompareFiles,Addr('form1.Edit3.Text,Form1.Edit4.Text,Form1.StringGrid2,op'),0,x);
From the little amount of infromation I can find on how to actually use BeginThread() this should be a fine call, however on compling all I get is complier errors regarding the structure of my BeginThread() statement paramenters.
EDIT FOR INFORMATION.
The current procedure that calls CompareFiles is
procedure TForm1.Panel29Click(Sender: TObject);
var
op,x : integer;
begin
if (Form1.Edit3.Text <> '') AND (Form1.Edit4.Text <> '') then
begin
op := 3;
if RadioButton7.Checked = True then op := 0;
if RadioButton3.Checked = True then op := 1;
if RadioButton4.Checked = True then op := 2;
if RadioButton5.Checked = True then op := 3;
if RadioButton6.Checked = True then op := 4;
CompareFiles(form1.Edit3.Text,Form1.Edit4.Text,Form1.StringGrid2,op);
end;
end;
If I was to use TThread as suggested by a couple of people, and as displayed by Rob below, I'm confused at how a) I would pass op,Edit3/4.Text and StringGrid2 to the CompareFiles. Guessing from the example of TThread I've seen I thought I would replace the code above with TCompareFilesThread.Executeand the put the current code from Panel29Click into TCompareFilesThread.Create and then add
FEdit3Text := Edit3Text;
FEdit4Text := Edit4Text;
FGrid := Grid;
to this
FEdit3Text := Form1.Edit3.Text;
FEdit4Text := Form1.Edit4.Text;
FGrid := Form1.StringGrid2;
But I've got this nagging feeling that is totally off the mark.
That's not at all the way to use BeginThread. That function expects a pointer to a function that takes one parameter, but the function you're trying to call wants four. The one parameter you're giving to BeginThread for it to forward to the thread procedure is a string, but you evidently hope that some sort of magic will turn that string of characters into the values that those variables contain.
That's not how Delphi works, and even for the languages that can do something like that, it's generally discouraged to actually do it.
To pass multiple parameters to BeginThread, define a record with all the values you'll need, and also define a record pointer:
type
PCompareFilesParams = ^TCompareFilesParams;
TCompareFilesParams = record
Edit3Text,
Edit4Text: string;
Grid: TStringGrid;
Op: Integer;
end;
Change CompareFiles to accept a pointer to that record:
function CompareFiles(Params: PCompareFilesParams): Integer;
To start the thread, you'll need to allocate an instance of that record and populate its fields:
var
Params: PCompareFilesParams;
begin
New(Params);
Params.Edit3Text := Edit3.Text;
Params.Edit4Text := Edit4.Text;
Params.Grid := StringGrid2;
Params.Op := op;
BeginThread(nil, 0, #CompareFiles, Params, 0, x);
Implement CompareFiles like this so that the record will get freed before the thread terminates:
function CompareFiles(Params: PCompareFilesParams): Integer;
begin
try
// <Normal implementation goes here.>
finally
Dispose(Params);
end;
end;
You can make it all a lot easier if you just use TThread, though. You can make your descendant class have as many parameters as you want in its constructor, so you don't have to mess around with dynamically allocating and freeing a special record.
type
TCompareFilesThread = class(TThread)
private
FEdit3Text,
FEdit4Text: string;
FGrid: TStringGrid;
FOp: Integer;
procedure Execute; override;
public
constructor Create(const Edit3Text, Edit4Text: string; Grid: TStringGrid; Op: Integer);
property ReturnValue;
end;
constructor TCompareFilesThread.Create;
begin
inherited Create(False);
FEdit3Text := Edit3Text;
FEdit4Text := Edit4Text;
FGrid := Grid;
FOp := Op;
end;
procedure TCompareFilesThread.Execute;
begin
ReturnValue := CompareFiles(FEdit3Text, FEdit4Text, FGrid, FOp);
end;
Instead of calling BeginThread, you just instantiate the class and let it run:
var
ThreadRef: TThread;
ThreadRef := TCompareFilesThread.Create(Edit3.Text, Edit4.Text, StringGrid2, Op);
There's more to using threads, such as knowing when the thread has finished running, but I think you have enough to get started. One last thing to beware of, though, is that TStringGrid is a VCL control. You mustn't do anything with it from this new thread you create (regardless of how you end up creating it). Eveything you do with the grid control need to be done from the main thread. Use TThread.Synchronize and TThread.Queue to shift any VCL operations onto the main thread. Your file-comparing thread will wait for the synchronized operation to complete, but it will keep running without waiting for a queued operation to complete.

Resources