Thread safe values, version 1.2
A while back (a year perhaps?) I posted an article about protected values. In short: anyone who has ever worked with multi-threading should know that sharing values between your application and thread(s) is not always as straight forward as we like to believe.
The latest versions of Delphi have made threading a lot simpler, especially async coding. But even though Delphi has gotten better on the subject, there is no denying that archetypical languages like object pascal and c++ are intrinsically low-level. It’s not like Java and C# where they put training-wheels on everything and you can just ignore the laws of physics (because your application is the digital version of a padded cell).
Note: While we are on the subject you may want to check out my delayed callback unit, which implents TW3Dispatch from Smart Mobile Studio.
Protected values version 1.2
So what are protected values? Well, in short it’s a series of classes that automatically protects a piece of data (intrinsic datatypes like “string”, “integer”, “boolean” but also class instances) and will lock and unlock when you read or change the value.

Multithreading can be a total bitch if you dont do it right
What is new in version 1.2 is that I have extended the model with an exclusive locking mechanism, an anonymous procedure, which gives you exclusive access to the data for the duration of your callback. You also have read/write access properties and a few other improvements.
It is, like many of my units, simple yet powerful. Some may argue that they don’t need it, that it’s not atomic – but that was never really the point. For atomic values you can dig into WinAPI but I personally like to keep my code as platform independent as possible.
The purpose of this library is, simply put, to have a uniform way of creating thread safe variables and fields. Values that can be safely changed from a thread without any extra padding or care, and likewise – values that a thread can expose without read/write synchronizing, instance checking and thread callbacks.
Examples
Creating a protected container is very simple. The unit uses generics, so you can take your pick of datatype:
var LData: TProtectedValue<string>; begin LData := TProtectedValue<string>.create; RegisterWithThreads(LData); LData.Value := 'This is a test'; end;
In the code above the object is locked while the assignment lasts, so it will never collide with another thread accessing it. If you want exclusive access for the duration of a process or task, use the synchronize call:
var LData: TProtectedValue<string>; begin LData := TProtectedValue<string>.create; RegisterWithThreads(LData); LData.Synchronize( procedure (var Data: string) begin //Access is blocked for the duration of this proc for item in GlobalList do Data := Data + item.ToString(); end); end;
The next feature I added was better support for object lists. In the previous version you had to create the list-instance yourself and then wrap that in a container. Now the container is the objectlist and we use generic to denote the type. The same locked access mechanisms are available there.
var LData: TProtectedObjectList<TMyItem>; begin LData := TProtectedObjectList<TMyItem>.create; LData.ForEach( procedure (Item: TObject; var Cancel: boolean) begin // Set Cancel to True to abort the loop // ForEach() will iterate through the items stored in // the objectlist. Sadly you must typecast here due to scope end); end;
And of course, the normal locking mechanisms for lists:
type TMyListType = TObjectList<TMyItem>; var LData: TProtectedObjectList<TMyItem>; begin LData := TProtectedObjectList<TMyItem>.create; LList := TMyListType( LData.Lock ); try //Process list here finally LData.Unlock(); end; end;
While all of this is cool, the core value of the library (at least for me) is that I can safely move values between the main process and threads without the typical insulation involved. I can use protected values as fields in my class and publish them as read only properties, killing two birds with one stone (both protecting the value and conforming to the multiple read, singular write law of memory.
The unit is tried and tested. It is presently used in 3 commercial products, so you can put a little faith in it. But as always, if you don’t need it then leave it alone.
If you like it, enjoy 🙂
The code
unit hex.log.locktypes; interface uses System.SysUtils, System.SyncObjs, System.Classes, System.Generics.Collections; type {$DEFINE USE_SYNCHRO} TProtectedValueAccessRights = set of (lvRead, lvWrite); EProtectedValue = class(exception); EProtectedObject = class(exception); (* Thread safe intrinsic datatype container. When sharing values between processes, use this class to make read/write access safe and protected. *) {$IFDEF USE_SYNCHRO} TProtectedValue = class(TCriticalSection) {$ELSE} TProtectedValue = class(TObject) {$ENDIF} strict private {$IFNDEF USE_SYNCHRO} FLock: TCriticalSection; {$ENDIF} FData: T; FOptions: TProtectedValueAccessRights; strict protected function GetValue: T;virtual; procedure SetValue(Value: T);virtual; function GetAccessRights: TProtectedValueAccessRights; procedure SetAccessRights(Rights: TProtectedValueAccessRights); public type TProtectedValueEntry = reference to procedure (var Data: T); public constructor Create(Value: T); overload; virtual; constructor Create(Value: T; const Access: TProtectedValueAccessRights= [lvRead, lvWrite]); overload; virtual; constructor Create(const Access: TProtectedValueAccessRights = [lvRead, lvWrite]); overload; virtual; destructor Destroy;override; {$IFNDEF USE_SYNCHRO} procedure Acquire; procedure Release; {$ENDIF} procedure Synchronize(const Entry: TProtectedValueEntry); property AccessRights: TProtectedValueAccessRights read GetAccessRights; property Value: T read GetValue write SetValue; end; (* Thread safe object container. NOTE #1: This object container **CREATES** the instance and maintains it! Use Edit() to execute a protected block of code with access to the object. Note #2: SetValue() does not overwrite the object reference, but attempts to perform TPersistent.Assign(). If the instance does not inherit from TPersistent an exception is thrown. *) TProtectedObject = class(TObject) strict private FData: T; FLock: TCriticalSection; FOptions: TProtectedValueAccessRights; strict protected function GetValue: T;virtual; procedure SetValue(Value: T);virtual; function GetAccessRights: TProtectedValueAccessRights; procedure SetAccessRights(Rights: TProtectedValueAccessRights); public type TProtectedObjectEntry = reference to procedure (const Data: T); public Property Value: T read GetValue write SetValue; Property AccessRights: TProtectedValueAccessRights read GetAccessRights; Function Lock: T; procedure Unlock; procedure Synchronize(const Entry: TProtectedObjectEntry); Constructor Create(const AOptions:TProtectedValueAccessRights = [lvRead,lvWrite]);virtual; Destructor Destroy;override; end; (* TProtectedObjectList: This is a thread-safe object list implementation. It works more or less like TThreadList, except it deals with objects *) TProtectedObjectList = Class(TInterfacedPersistent) strict private FObjects: TObjectList; FLock: TCriticalSection; strict protected function GetEmpty: Boolean;virtual; function GetCount: Integer;virtual; (* QueryObject Proxy: TInterfacedPersistent allows us to act as a proxy for QueryInterface/GetInterface. Override and provide another child instance here to expose interfaces from that instread *) function GetOwner: TPersistent;override; public type TProtectedObjectListProc = reference to procedure (item:TObject;var Cancel:Boolean); public constructor Create(OwnsObjects: Boolean = True);virtual; destructor Destroy;Override; function Contains(Instance: TObject): boolean;virtual; function Lock: TObjectList;virtual; Procedure UnLock; Procedure Clear; procedure ForEach(Callback: TProtectedObjectListProc); Property Count:Integer read GetCount; Property Empty:Boolean read GetEmpty; end; implementation //############################################################################ // TProtectedObjectList //############################################################################ constructor TProtectedObjectList.Create(OwnsObjects: Boolean = True); begin inherited Create; FObjects := TObjectList.Create(OwnsObjects); FLock := TCriticalSection.Create; end; destructor TProtectedObjectList.Destroy; begin FLock.Enter; FObjects.Free; FLock.Free; inherited; end; procedure TProtectedObjectList.Clear; begin FLock.Enter; try FObjects.Clear; finally FLock.Leave; end; end; function TProtectedObjectList.GetOwner: TPersistent; begin result := NIL; end; procedure TProtectedObjectList.ForEach(Callback: TProtectedObjectListProc); var mItem: TObject; mCancel: Boolean; begin if assigned(Callback) then begin FLock.Enter; try mCancel:=False; for mItem in FObjects do begin CallBack(mItem,mCancel); if mCancel then break; end; finally FLock.Leave; end; end; end; function TProtectedObjectList.Contains(Instance: TObject): Boolean; begin result := false; if assigned(Instance) then begin FLock.Enter; try result := FObjects.Contains(Instance); finally FLock.Leave; end; end; end; function TProtectedObjectList.GetCount: Integer; begin FLock.Enter; try result :=FObjects.Count; finally FLock.Leave; end; end; function TProtectedObjectList.GetEmpty: Boolean; begin FLock.Enter; try result := FObjects.Count<1; finally FLock.Leave; end; end; function TProtectedObjectList.Lock: TObjectList; begin FLock.Enter; result:=FObjects; end; procedure TProtectedObjectList.UnLock; begin FLock.Leave; end; //############################################################################ // TProtectedObject //############################################################################ constructor TProtectedObject.Create(const AOptions: TProtectedValueAccessRights = [lvRead, lvWrite]); begin inherited Create; FLock:=TCriticalSection.Create; FOptions:=AOptions; FData := T.create; end; destructor TProtectedObject.Destroy; begin FData.free; FLock.Free; inherited; end; function TProtectedObject.GetAccessRights: TProtectedValueAccessRights; begin FLock.Enter; try result := FOptions; finally FLock.Leave; end; end; procedure TProtectedObject.SetAccessRights(Rights: TProtectedValueAccessRights); begin FLock.Enter; try FOptions := Rights; finally FLock.Leave; end; end; function TProtectedObject.Lock: T; begin FLock.Enter; result := FData; end; procedure TProtectedObject.Unlock; begin FLock.Leave; end; procedure TProtectedObject.Synchronize(const Entry: TProtectedObjectEntry); begin if assigned(Entry) then begin FLock.Enter; try Entry(FData); finally FLock.Leave; end; end; end; function TProtectedObject.GetValue: T; begin FLock.Enter; try if (lvRead in FOptions) then result := FData else raise EProtectedObject.CreateFmt('%s:Read not allowed error',[classname]); finally FLock.Leave; end; end; procedure TProtectedObject.SetValue(Value: T); begin FLock.Enter; try if (lvWrite in FOptions) then begin if (TObject(FData) is TPersistent) or (TObject(FData).InheritsFrom(TPersistent)) then TPersistent(FData).Assign(TPersistent(Value)) else raise EProtectedObject.CreateFmt ('Locked object assign failed, %s does not inherit from %s', [TObject(FData).ClassName,'TPersistent']); end else raise EProtectedObject.CreateFmt('%s:Write not allowed error',[classname]); finally FLock.Leave; end; end; //############################################################################ // TProtectedValue //############################################################################ constructor TProtectedValue.Create(Value: T); begin Create([lvRead, lvWrite]); end; constructor TProtectedValue.Create(Value: T; const Access: TProtectedValueAccessRights = [lvRead, lvWrite]); begin Create([lvRead, lvWrite]); Synchronize( procedure (var Data: T) begin Data := Value; end); end; Constructor TProtectedValue.Create(const Access: TProtectedValueAccessRights = [lvRead,lvWrite]); begin inherited Create; {$IFNDEF USE_SYNCHRO} FLock := TCriticalSection.Create; {$ENDIF} FOptions:=Access; end; Destructor TProtectedValue.Destroy; begin {$IFNDEF USE_SYNCHRO} FLock.Free; {$ENDIF} inherited; end; function TProtectedValue.GetAccessRights: TProtectedValueAccessRights; begin Acquire; try result := FOptions; finally Release; end; end; procedure TProtectedValue.SetAccessRights(Rights: TProtectedValueAccessRights); begin Acquire; try FOptions := Rights; finally Release; end; end; {$IFNDEF USE_SYNCHRO} procedure TProtectedValue.Acquire; begin FLock.Acquire; end; procedure TProtectedValue.Release; begin FLock.Release; end; {$ENDIF} procedure TProtectedValue.Synchronize(const Entry: TProtectedValueEntry); begin if assigned(Entry) then Begin Acquire; try Entry(FData); finally Release; end; end; end; function TProtectedValue.GetValue: T; begin Acquire; try if (lvRead in FOptions) then result := FData else Raise EProtectedValue.CreateFmt('%s: Read not allowed error',[classname]); finally Release; end; end; procedure TProtectedValue.SetValue(Value: T); begin Acquire; try if (lvWrite in FOptions) then FData:=Value else Raise EProtectedValue.CreateFmt('%s: Write not allowed error',[classname]); finally Release; end; end; end.
Is it possible to use it with UI controls? So I could write to UI controls from parallel threads?
Not sure why, but they integrate thread safety so i dont see why not