Long story short, I'm very far from a skilled programmer, in fact, my most complicated programs so far were either plain ASCII string manipulating, simple maths and array searching/sorting either in Free Pascal or later, Delphi 7 and Java. This was some years ago, when I learnt programming in high school faculty (that was plain Pascal). Later I went on to become a programmer (meeting with D7 and Java, and some C++), but I had quit my programming studies due to personal reasons, and since then, I didn't wrote a single line of code.
Erm, sorry for the long introduction, so... Recently I decided to revive programming as my hobby, mainly because I didn't found a suitable program for some tasks I would like to accomplish since long. In spite of my faint understanding of such fairly basic things as explicit parameters, pointers, objects, classes, constructors and threads, with the help of a programming book, Delphi help files and the internet, I managed to write a simple program in Delphi 7 that can load and display certain image file formats in a given directory using external libraries, make it possible to arbitrarily switch among them (using the GUI), and log some information (mainly for debug purposes) in text files.
However, I encountered a problem at the current version of the code when I tried to make the image loading and displaying function threaded. First, for better understanding, I'll explain the logic of my program.
First of all, in the main form's FormCreate event, the program looks for supported image files in the current directory (where the exe is). If there is no image files, the current directory is set at the one at the upper level (with the standard Windows file system symbol "..") and is checked for images. Supported image files are determined by file extensions. Anyway, this explorer function stores the found images' filename and a file type identifier (which is a byte) in a dynamic array. Then, using this array as a reference, the first supported image file is loaded by the correct library and displayed in the form. The GUI has buttons and a combobox to change between images, with each control's OnClick or OnSelect (combobox) event setting variables about the supposedly current image file and calling the image loader and displayer function which uses the reference array.
The problem is that some images are so huge that the loading takes noticeable time, so the GUI can't respond until the image is fully loaded and displayed. I tried to make this program threaded by initializing each image loader function as a thread. While the GUI is more responsive now, there are certainly two new bugs with the program.
The first is that the program sometimes randomly crashes when changing images, with appearing messages either referring to "JPEG Error #58" (supposedly meaning "invalid file structure" in Delphi's in-built jpeg library), "EAccessViolation" exception, "EOSError" exception (including "System Error, Code 5"), "unknown software exception", "Runtime error 216", and error messages about memory locations and failed read operations. Before using threads, none of these error messages appeared, but I certainly want to (and must) use threads in the program.
The other, minor bug is that when the interface buttons are clicked in a fast succession, it seems like all loading and displaying takes place, although in a laggy-then-quickly manner. I don't really have an idea on how to "kill" a thread and initiate it "again" to load the now-current file instead of the obsolete one it tried to load a few hundred milliseconds ago.
I start a thread in the following manner:
LoaderThread := CreateThread(nil, 0, Addr(LoadPicture), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
I use this two times in the main form's FormCreate event (although only one of them executes at any start), and in the GUI controls' OnClick or OnSelect event to faciliate the desired function of the control (for example skip to the last image).
Any suggestions? Thank you in advance! :)
UPDATE:
Here is some (well, almost all) of my source code:
procedure TMainForm.FormCreate(Sender: TObject);
begin
MainForm.DoubleBuffered := true;
MainJPEG := TJPEGImage.Create;
MainJPEG.ProgressiveDisplay := true;
MainJPEG.Smoothing := true;
MainJPEG.Performance := jpBestQuality;
MainPNG := TPNGObject.Create;
MainGIF := TGIFImage.Create;
AssignFile(Log, '_NyanLog.txt');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
if CurrentDirHasImages = false then
begin
SetCurrentDir('..');
CurrentDir := GetCurrentDir;
ExploreCurrentDir;
end;
if CurrentDirHasImages = true then
begin
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
if Length(ImagesOfCurrentDir) > 1 then
begin
MainForm.NextButton.Enabled := true;
MainForm.EndButton.Enabled := true;
MainForm.SlideshowButton.Enabled := true;
MainForm.SlideshowIntervalUpDown.Enabled := true;
end;
UpdateTitleBar;
end
else UpdateTitleBar;
end;
procedure ExploreCurrentDir;
var
Over: boolean;
begin
CurrentPos := 0;
Over := false;
ReWrite(Log);
Write(Log, 'blablabla');
if FindFirst(CurrentDir+'\*.*', faAnyFile-faDirectory, Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
while Over = false do
begin
if FindNext(Find) = 0 then
begin
CurrentFilename := Find.Name;
DetermineFiletype;
if CurrentFiletype <> UNSUPPORTED then
begin
SetLength(ImagesOfCurrentDir, CurrentPos+1);
ImagesOfCurrentDir[CurrentPos].Filename := CurrentFilename;
ImagesOfCurrentDir[CurrentPos].Filetype := CurrentFiletype;
MainForm.ImagelistComboBox.AddItem(CurrentFilename, nil);
Write(Log, 'blablabla');
CurrentPos := Succ(CurrentPos);
end;
end
else
begin
FindClose(Find);
Over := true;
end;
end;
CurrentDirImageCount := Length(ImagesOfCurrentDir);
CurrentDirHasImages := true;
Write(Log, 'blablabla');
end;
if CurrentDirHasImages = false then Write(Log, 'blablabla');
CloseFile(Log);
CurrentPos := 0;
end;
procedure LoadImage; //procedure #1 which should be used in a thread
begin
if CurrentFiletype = BMP then
begin
MainForm.MainImage.Picture := nil;
MainForm.MainImage.Picture.LoadFromFile(CurrentFilename)
end
else
if CurrentFiletype = JPEG then
begin
MainForm.MainImage.Picture := nil;
MainJPEG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainJPEG);
end
else
if CurrentFiletype = PNG then
begin
MainForm.MainImage.Picture := nil;
MainPNG.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainPNG);
end
else
if CurrentFiletype = GIF then
begin
MainForm.MainImage.Picture := nil;
MainGIF.LoadFromFile(CurrentFilename);
MainForm.MainImage.Picture.Assign(MainGIF);
end;
end;
procedure NextImage; //the "NextButton" button from the GUI calls this
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
while MainImageIsEmpty = true do
begin
if CurrentPos < Length(ImagesOfCurrentDir)-1 then
begin
CurrentPos := Succ(CurrentPos);
CurrentFilename := ImagesOfCurrentDir[CurrentPos].Filename;
CurrentFiletype := ImagesOfCurrentDir[CurrentPos].Filetype;
UpdateTitleBar;
LoaderThread := BeginThread(nil, 0, Addr(LoadImage), nil, 0, LoaderThreadID);
CloseHandle(LoaderThread);
end;
if CurrentPos = CurrentDirImageCount-1 then Break;
end;
end;
if CurrentPos = CurrentDirImageCount-1 then
begin
MainForm.NextButton.Enabled := false;
MainForm.EndButton.Enabled := false;
MainForm.SlideshowButton.Enabled := false;
MainForm.SlideshowIntervalUpDown.Enabled := false;
end;
MainForm.PrevButton.Enabled := true;
MainForm.StartButton.Enabled := true;
end;
procedure PrevImage; //called by "PrevButton"
begin
//some code, calls LoadImage
//almost the same logic as above for a backward step among the images
end;
procedure FirstImage; //called by "StartButton"
begin
//some code, calls LoadImage
end;
procedure LastImage; //called by "EndButton"
begin
//some code, calls LoadImage
end;
procedure Slideshow; //procedure #2 which should be used in a thread
begin
while SlideshowOn = true do
begin
SlideshowInterval := MainForm.SlideshowIntervalUpDown.Position*1000;
Sleep(SlideshowInterval);
NextImage; //NextImage calls LoadImage which should be a thread
if CurrentPos = CurrentDirImageCount-1 then SlideshowOn := false;
end;
end;
function MainImageIsEmpty;
begin
if MainForm.MainImage.Picture = nil then MainImageIsEmpty := true
else MainImageIsEmpty := false;
end;
procedure TMainForm.NextButtonClick(Sender: TObject);
begin
NextImage;
end;
procedure TMainForm.PrevButtonClick(Sender: TObject);
begin
PrevImage;
end;
procedure TMainForm.StartButtonClick(Sender: TObject);
begin
FirstImage;
end;
procedure TMainForm.EndButtonClick(Sender: TObject);
begin
LastImage;
end;
procedure TMainForm.SlideshowButtonClick(Sender: TObject);
begin;
if SlideshowOn = false then
begin
SlideshowOn := true;
SlideshowThread := BeginThread(nil, 0, Addr(Slideshow), nil, 0, SlideshowThreadID);
SlideshowButton.Caption := '||';
SlideshowButton.Hint := 'DIAVETÍTÉS LEÁLLÍTÁSA';
end
else
begin
SlideshowOn := false;
CloseHandle(SlideshowThread);
SlideshowButton.Caption := '|>';
SlideshowButton.Hint := 'DIAVETÍTÉS INDÍTÁSA';
end;
end;
There's a lot of text here, and not much code. Your question would probably be better with more code and less text.
Anyway, I can offer some hints.
Firstly, calling CreateThread directly is a rather laborious way to do threading in Delphi. It's easier to use TThread which wraps up some of the low-level Windows API issues in a manner more native to typical Delphi code style. Of course, you could go further and use a threading library like OmniThreadLibrary, but for now it may be better just to stick to TThread and work out how to do it that way.
Now, that won't be your problem here. Almost certainly your problem will be cause by one of two common issues with threading:
All VCL and GUI code should run in the main thread. Windows controls have affinity with the thread that creates them. Many parts of the VCL are not thread-safe. These issues strongly push you to putting all VCL/GUI code in the main thread.
It's quite possible that you have a race condition due to lack of synchronisation.
The most common way to deal with issue 1 is to call TThread.Synchronize or TThread.Queue from the worker threads in order to force all the VCL/GUI code to run on the main thread. Of course you need to be sure that none of the time-consuming code in your worker thread uses VCL/GUI objects since that is doomed to failure.
Issue 2 can be dealt with by synchronisation objects like critical sections or lock-free methods using the InterlockedXXX family of functions.
Exactly what your problem is I can't say. If you want more detailed help then please post more code, most probably cut down from what you are currently running.
You create a thread and kill it right away without waiting for it to finish loading
LoadImage is not VCL thread safe
Here simple seudo thread in VCL way. Codes is in simple form and you can study further and make enhancement
TYourThread.Create(image file name);
type
TYourThread = class(TThread)
protected
FBitmap: TBitmap;
FImageFileName: string;
procedure BitmapToVCL;
begin
MainForm.MainImage.Picture := FBitmap;
end;
procedure Execute; override;
begin
FBitmap := TBitmap.Create;
try
FBitmap.LoadFromFile(FImageFileName);
Synchronize(BitmapToVCL);
finally
FreeAndNil(FBitmap);
end;
end;
public
constructor Create(const AImageFileName: string);
begin
FImageFileName := AImageFileName;
inherited Create(False);
FreeOnTerminate := True;
end;
end;
Gook luck
Cheer
Related
I'm trying to find a multi-thread deadlock, that somehow seems to have to do with my file logging (if I comment that out, the code doesnt deadlock anymore).
When it is deadlocked, I get this screen from the Delphi debugger on "Pause":
Does this mean anything to anyone? Is this some "typical", "recognizable" code?
The file writing looks like this (and is called from many threads):
procedure TLogging.WriteLogEntry(EntryText:string);
begin
FFileLock.BeginWrite;
try
if not Assigned(FFilestream) then begin
if FileExist(LogName) then begin
FFilestream := TFileStream.Create(LogName, fmOpenReadWrite+fmShareDenyWrite);
end else begin
FFilestream := TFileStream.Create(LogName, fmCreate+fmShareDenyWrite);
end;
end;
if Assigned(FFilestream) and not Assigned(FExporter) then begin
FExporter := TStreamWriter.Create(FFilestream, TEncoding.UTF8);
FExporter.BaseStream.Seek(0, soFromEnd);
FExporter.NewLine := #$0A;
FExporter.AutoFlush := True;
end;
FExporter.Write('['+DateToStr(Now, FDateTimeFormat)+'] ['+TimeToStr(Now, FDateTimeFormat)+'] [#'+Lead0(GetCurrentThreadId, 5)+']: '+EntryText);
FExporter.WriteLine;
FreeAndNIL(FFilestream);
FreeAndNIL(FExporter);
finally
FFileLock.EndWrite;
end;
end;
FFileStream and FExporter started as global variables in this object, but I have moved them into this method because I need to close the log file each time. FFileLock is a TMultiReadExclusiveWriteSynchronizer inside TLogging, and my application has only one instance of TLogging.
We have run into this multi-threading problem in our backend services:
In a multi-threading Windows service app, with 30+ threads, problem in SysUtils.EventCache arise. The problem is that NewWaitObj function sometimes return NIL instead of Event object. This function is used in TMonitor sync methods Wait. TMonitor.Wait stops working when it get NIL for event object. That affects many VCL and RTL thread sync source code and it cause different side problems in multi-threading apps, for example TThreadedQueue.PopItem doesnt wait for new item to arrive in Queue and returns immediately with timeout result.
Problem occurs in NewWaitObj function:
function NewWaitObj: Pointer;
var
EventItem: PEventItemHolder;
begin
EventItem := Pop(EventCache);
if EventItem <> nil then
begin
Result := EventItem.Event;
EventItem.Event := nil;
Push(EventItemHolders, EventItem);
end else
Result := NewSyncWaitObj;
ResetSyncWaitObj(Result);
end;
Looks like Pop function is not well protected in heavy multi-threaded app and at some number of concurrent threads it starts to return one and the same EventItem instance to two (or more) threads. Then race conditions are happening in NewWaitObj:
One thread takes EventItem.Event and return it as Result and zero it with NIL, the racing parallel thread is getting the same EventItem.Event but it is already cleared by first thread.
That cause one of racing threads to return valid Event handle and the other(s) racing threads return NIL.
TMonitor.Wait function doesnt work, because it get NIL as Event handle.
TThreadedQueue.PopItem doesnt wait, other sync methods also doesnt work correctly.
For some reason thread sync in Pop method doesnt work when app have many concurrent threads:
function Pop(var Stack: PEventItemHolder): PEventItemHolder;
begin
repeat
Result := Stack;
if Result = nil then
Exit;
until AtomicCmpExchange(Pointer(Stack), Result.Next, Result) = Result;
end;
In test app on 60 test threads problem arise in about 10-20 secs, with 30 threads its much harder to happens, usually 5-10 mins are needed. Once problem occurs - it never stop until restart of App. In test app after thread sync get broken - about one of each 5 operations with EventCache return NIL. Looks like something get broken in AtomicCmpExchange, I've checked the generated code - it's just one CMPXCHG instruction and few more to setup registers. I am not quite sure what cause the problem - can one thread get intervention from other thread for example while it setups registers to call CMPXCHG or after the call while it process the results?
Trying to understand what cause the problem, so I can find best workaround. For now I am planning to replace original NewWaitObj with my own, which will just call the original version till it return valid object. This problem occurs constantly in our dev, test and prod environments, for real middle-ware services on production servers it's needed few hours (sometimes couple of days) for problem to arise, after that only restart fix the problem.
Test app can be downloaded from issue in Embarcadero JIRA: https://quality.embarcadero.com/browse/RSP-31154
EDIT: TestApp: https://quality.embarcadero.com/secure/attachment/31605/EventCacheBug.zip
Example Delphi source code:
unit FormMainEventCacheBugU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.StdCtrls;
const
MaxProducers = 60;
type
TFormEventCacheBug = class(TForm)
BtnMaxProducers: TButton;
BtnRemoveProducer: TButton;
BtnAddProducer: TButton;
procedure BtnMaxProducersClick(Sender: TObject);
procedure BtnRemoveProducerClick(Sender: TObject);
procedure BtnAddProducerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TEventEater = class(TThread)
private
SleepTime: Integer;
SMsg, EMsg, NMsg: PChar;
procedure EatEvent;
protected
procedure Execute; override;
public
constructor Create;
end;
var
FormEventCacheBug: TFormEventCacheBug;
Producers: array[1..MaxProducers] of TThread;
ProdCount: Integer;
implementation
{$R *.dfm}
procedure AddProducer;
begin
if ProdCount < MaxProducers then
begin
Inc(ProdCount);
Producers[ProdCount] := TEventEater.Create;
Producers[ProdCount].FreeOnTerminate := True;
end;
end;
procedure RemoveProducer;
begin
if ProdCount > 0 then
begin
Producers[ProdCount].Terminate;
Dec(ProdCount);
end;
end;
{ TEventEater }
constructor TEventEater.Create;
begin
inherited Create(False);
SleepTime := RandomRange(1, 3);
end;
procedure TEventEater.EatEvent;
var
EventHandle: Pointer;
begin
//OutputDebugString(SMsg);
EventHandle := System.MonitorSupport.NewWaitObject;
try
if EventHandle = nil then
OutputDebugString('NIL');
Sleep(SleepTime);
finally
if EventHandle <> nil then
System.MonitorSupport.FreeWaitObject(EventHandle);
// OutputDebugString(EMsg);
end;
end;
procedure TEventEater.Execute;
begin
SMsg := PChar('S:' + GetCurrentThreadId.ToString);
EMsg := PChar('E:' + GetCurrentThreadId.ToString);
NMsg := PChar('NIL:' + GetCurrentThreadId.ToString);
while not Terminated do
begin
EatEvent;
Sleep(SleepTime);
end;
end;
procedure TFormEventCacheBug.BtnAddProducerClick(Sender: TObject);
begin
AddProducer;
end;
procedure TFormEventCacheBug.BtnRemoveProducerClick(Sender: TObject);
begin
RemoveProducer;
end;
procedure TFormEventCacheBug.BtnMaxProducersClick(Sender: TObject);
var
i: Integer;
begin
for i := ProdCount + 1 to MaxProducers do
AddProducer;
end;
end.
Thanks for any ideas,
#MiroslavPenchev, thank you for the post!
Working in XE2 and had similar issue.
Delphi 10.4.1 got TMonitor ABA problem solved using the linked list head with a counter and 128-bit Compare Exchange.
Unfortunately this is not an easy option for XE2.
Again, thanks to your suggestion to override some of MonitorSupport methods calling original ones.
The following is the solution that I'm using. It is not 100% perfect as involves locking, but for less concurrent environment it at least makes system stable and free from 100% CPU issue.
var
MonitorSupportFix: TMonitorSupport;
OldMonitorSupport: PMonitorSupport;
NewWaitObjCS: TCriticalSection;
function NewWaitObjFix: Pointer;
begin
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Enter;
try
Result := OldMonitorSupport.NewWaitObject;
finally
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Leave;
end;
end;
procedure FreeWaitObjFix(WaitObject: Pointer);
begin
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Enter;
try
OldMonitorSupport.FreeWaitObject(WaitObject);
finally
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Leave;
end;
end;
procedure InitMonitorSupportFix;
begin
OldMonitorSupport := System.MonitorSupport;
MonitorSupportFix := OldMonitorSupport^;
MonitorSupportFix.NewWaitObject := NewWaitObjFix;
MonitorSupportFix.FreeWaitObject := FreeWaitObjFix;
System.MonitorSupport := #MonitorSupportFix;
end;
initialization
NewWaitObjCS := TCriticalSection.Create;
InitMonitorSupportFix;
finalization
FreeAndNil(NewWaitObjCS);
end.
My problem is: I have a VCL Forms Application, and a DLL that contains an implementation of TThread. Within this Thread, I have some methods that needs to work with some of the VCL components from the main form, but I now that TThread.Synchronize() doesn't work inside the DLL, because it's given another ThreadID to it, and to solve that, I've create a method inside the DLL that receives the MainThreadID from the VCL Application, and set the given it as its own DLL ID, however, it also doesn't work. Can someone point me what I'm doing wrong?
By the way, I tried using a time with interval=1 to CheckSynchronize() but it was a dead end whatsoever.
---> Here are relevant parts of the code:
VCL unit
procedure TfrmUpdater.FormCreate(Sender: TObject);
var
IniFile: TIniFile;
begin
DllHandle := LoadLibrary('libthread.dll');
tmrSync.Enabled := True;
if DllHandle <> 0 then
begin
#DllThreadProc := GetProcAddress(DllHandle, 'SetDllThread');
#ConfigProc := GetProcAddress(DllHandle, 'Config');
#VclProc := GetProcAddress(DllHandle, 'VCL');
#UpdateProc := GetProcAddress(DllHandle, 'Update');
end;
DllThreadProc(MainThreadID);
// Set the VCL Components to use as reference inside the DLL
VclProc(btnStartGame, pbCurrent, pbOverall, lblCurrent, lblPercent);
end;
DLL Code
// This, doesn't update the CLbl that has been set as lblCurrent
// Note: this method is called INSIDE the DLL, and has to be like this!
procedure TUpdateThread.UpdateStatusLabel;
begin
CLbl.Caption := STemp;
Application.ProcessMessages;
end;
// The code below are SOME of the functions that the DLL is exporting to my application
procedure SetDllThread(TID: Cardinal); export;
begin
MainThreadID := TID;
end;
procedure VCL(playBtn: TImage; currentPBar, totalPBar: TALProgressBar; CurrLbl, ProgressLbl: TLabel); export;
begin
Btn := playBtn;
CBar := currentPBar;
TBar := totalPBar;
CLbl := CurrLbl;
TLbl := ProgressLbl;
end;
I have a Delphi DLL, which needs to be called from my main UI application or worker threads.
I do not want to call LoadLibrary/FreeLibrary each time I call the DLL. But, I also don't want to load it in my application initialization section. because I might not use the DLL at all during the lifetime of the application.
So what I need is the first caller (thread or main UI) to initialize and load the DLL.
the DLL will be unloaded in the finalization section. I realize I need some synchronization. so I have used a critical section BUT I can't seem to make it work.
Only one thread should attempt and load the DLL. if it fails other threads should not attempt to load the DLL again and again.
The synchronization is not working as expected!
Can someone suggest why?
MCVE:
program Project1;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes;
const
MyDLL = 'MyDLL.dll';
type
TDLLProcessProc = function(A: Integer): Integer; stdcall;
var
DLLProc: TDLLProcessProc = nil;
DLLModule: HMODULE = 0;
DLLInitialized: Boolean = False;
DLLInitialized_OK: Boolean = False;
CS: TRTLCriticalSection;
procedure InitDLLByFirstCall;
begin
if DLLModule = 0 then
begin
if DLLInitialized then Exit;
EnterCriticalSection(CS);
try
if DLLInitialized then Exit;
DLLInitialized := True;
DLLModule := LoadLibrary(MyDLL);
if DLLModule = 0 then RaiseLastWin32Error;
DLLProc := GetProcAddress(DLLModule, 'Process');
if #DLLProc = nil then RaiseLastWin32Error;
DLLInitialized_OK := True;
finally
LeaveCriticalSection(CS);
end;
end;
end;
function DLLProcess(A: Integer): Integer;
begin
InitDLLByFirstCall;
if not DLLInitialized_OK then
raise Exception.Create('DLL was not initialized OK');
Result := DLLProc(A);
end;
type
TDLLThread = class(TThread)
private
FNum: Integer;
public
constructor Create(CreateSuspended: Boolean; ANum: Integer);
procedure Execute; override;
end;
constructor TDLLThread.Create(CreateSuspended: Boolean; ANum: Integer);
begin
FreeOnTerminate := True;
FNum := ANum;
inherited Create(CreateSuspended);
end;
procedure TDLLThread.Execute;
var
RetValue: Integer;
begin
try
RetValue := DLLProcess(FNum);
Sleep(0);
Writeln('TDLLThread Result=> ' + IntToStr(RetValue));
except
on E: Exception do
begin
Writeln('TDLLThread Error: ' + E.Message);
end;
end;
end;
var
I: Integer;
begin
InitializeCriticalSection(CS);
try
// First 10 thread always fail!
for I := 1 to 10 do
TDLLThread.Create(False, I);
Readln;
for I := 1 to 10 do
TDLLThread.Create(False, I);
Readln;
finally
DeleteCriticalSection(CS);
end;
end.
DLL:
library MyDLL;
uses
Windows;
{$R *.res}
function Process(A: Integer): Integer; stdcall;
begin
Result := A;
end;
exports
Process;
begin
IsMultiThread := True;
end.
You need to modify your code in a way that the condition variable that is checked at the start of InitDLLByFirstCall is set only after all initialization has been completed. The DLL handle is therefore a bad choice.
Second you need to use the same condition variable outside and inside of the critical section - if you use DLLInitialized for that, then there is not really a use for either DLLInitialized_OK nor DLLModule.
And to make things easier to reason about you should try to get away with the minimum number of variables. Something like the following should work:
var
DLLProc: TDLLProcessProc = nil;
DLLInitialized: Boolean = False;
CS: TRTLCriticalSection;
procedure InitDLLByFirstCall;
var
DLLModule: HMODULE;
begin
if DLLInitialized then
Exit;
EnterCriticalSection(CS);
try
if not DLLInitialized then
try
DLLModule := LoadLibrary(MyDLL);
Win32Check(DLLModule <> 0);
DLLProc := GetProcAddress(DLLModule, 'Process');
Win32Check(Assigned(DLLProc));
finally
DLLInitialized := True;
end;
finally
LeaveCriticalSection(CS);
end;
end;
function DLLProcess(A: Integer): Integer;
begin
InitDLLByFirstCall;
if #DLLProc = nil then
raise Exception.Create('DLL was not initialized OK');
Result := DLLProc(A);
end;
If you don't want to check for the function address inside of DLLProcess then you could also use an integer or enumeration for the DLLInitialized variable, with different values for not initialized, failed and success.
You've got your double checked locking implemented incorrectly. You assign to DLLModule before assigning to DLLProc. So DLLModule can be non-zero whilst DLLProc is still null.
The variable that you test outside the lock must be modified after all the initialization is complete.
The pattern is like this:
if not Initialised then begin
Lock.Enter;
if not Initialised then begin
// Do initialisation
Initialised := True; // after initialisation complete
end;
Lock.Leave;
end;
Remember that double checked locking, as implemented here, only works because of the strong x86 memory model. If you ever move this code onto hardware with a weak memory model, it won't work as implemented. You'd need to implement barriers. Possible to do, but not entirely trivial.
Double checked locking is pointless here though. Remove it and protect everything with a single critical section. You are spinning up a thread, a very expensive task. The potential contention on a critical section is negligible.
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.