Lars Fosdal

2 minutes ago, David Heffernan said:

Attributes are fragile by design. The compiler cannot verify that you supplied the appropriate attributes to make your program work correctly.

 

For example, at the outset of this thread you are faced with an attempt to pass a typed constant to an attribute constructor and the compiler objects.  Well, remove the entire attribute declaration and now your program will compile.

They are fragile in the respect that you may omit an attribute or enter a valid attribute that is not used by the class, i.e. not valid to use in the specific scope.

A valid and appropriate attribute is not really fragile as such.
 

38 minutes ago, Stefan Glienke said:

If all the data being passed to attributes gets so complex that you feel the need to make compound types from them then I would rather consider writing an Init method where I do all this - compiled code, no attribute/rtti overhead, easily testable, done.

I already have init code where stuff like decorators, formatters, secondary sorting etc. is set up, so I guess I have to move this here as well - or add another set of constructor overloads to the attribute 😕 or add an extra attribute or two.

It would have been so nice being able to inline declare a record as a constant.  That goes outside the use with attributes as well.

type
  coordinate = record
    x,y: Double;
  end

const
  cp = coordinate(x: 10; y:10);  // an actual immutable constant

Explicit
  var p: coordinate := (x: 10; y:10);

Inferred:
  var p := coordinate(x: 10; y:10);

  p := (x:10; y:10);

  p := cp;

A notion of a change to the control design interface between D7 and modern Delphi rustles in the back of my head, but I have not done component work in ages....

41 minutes ago, Stefan Glienke said:

Anyway feel free to ignore the obvious and already proven to work fine solution and look for an impossible one 🙂

@Stefan Glienke The snippet below is one more complex of a few hundred GridSets that I have, and I'd like to change the parameterization of every InitField attribute to a structure.

How well suited is "the obvious and already proven to work fine solution" in this context?

  TDeliverySet = class(TGridSet)
  const
    DateFmt = 'dd.mm.yyyy';
  type
    TOnHasExternal = reference to function(const aDeliveryId:Integer):Boolean;
    TFieldSortPosition = class(TFieldEnum<TPSDPositionInGroup>);
    TFieldPickMethod = class(TFieldEnum<TPSDCustomerOrderPickingMethod>);
    TFieldTPackPickMethod = class(TFieldEnum<TPSDCustomerOrderTPackPickingMethod>);
    TRouteKey = record
      Id: Integer;
      Count: Integer;
    end;

  private
    function GetRouteKey(const aIndex: Integer; var RouteEntry: TRouteEntry): Integer;
    function GetShowPickRoutes: Boolean;
  protected
    OnHasExternal: TOnHasExternal;
    PickTPacks: Boolean;
    Environment: TPSDEnviroment;
    RouteDictionary: TRouteDictionary;

  public

    [GridAutoSize, GridMultiSelect //, GridShowFilters
    ]

    [InitField(' ', 20), CustomField]
    Grouping: TFieldGrouping;

    [HiddenField, CustomField] SortPositionInRoute: TFieldSortPosition;
    [HiddenField, CustomField] SortPositionInPickGroup: TFieldSortPosition;

    [InitField(sfrmPSDExpeditionDGridHeadindRoute, 100), CustomField, DefaultSortField]
    DisplayRoute: TFieldString;
    [HiddenField] RouteNo: TFieldString;
    [HiddenField] RouteDepartureTime: TFieldDateTime;


    [InitField(sfrmPSDExpeditionDGridHeadindCustomer, 180), CustomField]
    DisplayCustName: TFieldString;
    [HiddenField] CustomerNo: TFieldString;
    [HiddenField] CustomerName: TFieldString;
    [HiddenField] RefCustomerNo: TFieldString;
    [HiddenField] RefOrderCustomerName: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindDelivery, 110)]
    DeliveryNo: TFieldString;
    [HiddenField] PickingFinishedTime: TFieldDateTime;
    [HiddenField] HasOnlyAutoPickedLaterLines: TFieldBoolean;
    [HiddenField] CompleteTPackCount: TFieldInteger;
    [HiddenField] LineCountWithSmallPick: TFieldInteger;
    [HiddenField] PickMethod: TFieldPickMethod;
    [HiddenField] TPackPickMethod: TFieldTPackPickMethod;
    [HiddenField] PartlyPickedLineCount: TFieldInteger;
    [HiddenField] PickedLineCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindPickRoute, 60), HiddenField, ToggleField]
    PickRoutes: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindRouteSequenceNo, 60)]
    RouteSequenceNo: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindOrderNo, 80)]
    OrderNo: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindLines, 60), CustomField]
    DisplayLineCount: TFieldString;
    [HiddenField] LineCount: TFieldInteger;
    [HiddenField] MissingDPackCount: TFieldInteger;
    [HiddenField] MissingLineCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindGroupe, 60), CustomField, HiddenField(True)]
    GP: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindColliPickTo, 80), HiddenField(True)]
    ColliPickTo: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindPickDeviationEmpty, 60), HiddenField(True),ToggleField]
    PickDeviationEmptyCount: TFieldInteger;
    [HiddenField] PrioritizedArticleDeviation: TFieldBoolean;

    [InitField(sfrmPSDExpeditionDGridHeadindPickDeviationPickLater, 80), HiddenField(True)]
    PickDeviationWillBePickedLaterCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindReportingErrors, 50), HiddenField(True)]
    ReportingStatusFailedCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindConfirmedCollicount, 70), CustomField, HiddenField,ToggleField]
    U: TFieldInteger;
    [HiddenField]
    ConfirmedColliCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindComments, 80), CustomField, HiddenField(True)]
    K: TFieldInteger;
    [HiddenField, CustomField] Comment: TFieldString;
    [HiddenField] PreComment: TFieldString;
    [HiddenField] PostComment: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindKPackCount, 40)]
    KPackCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindPrePick, 60), CustomField,  HiddenField(True)]
    Prepick: TFieldString;

    [HiddenField] IsExport: TFieldBoolean;
    [HiddenField] RefOrder: TFieldString;
    [HiddenField] RefOrderRouteNo: TFieldString;
    [HiddenField] RefOrderRouteSequence: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindPickers, 60), HiddenField(True)]
    PickerUserName: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindEstimatedColliCount, 60), HiddenField(True)]
    EstimatedColliCount: TFieldDouble;

    [InitField(sfrmPSDExpeditionDGridHeadindUsedColliSummary, 60), HiddenField(True)]
    UsedColliSummary: TFieldString;

    [HiddenField, ToggleField]
    PickGroupId: TFieldInteger;

    [HiddenField, ToggleField]
    HasConsumers: TFieldBoolean;

    [HiddenField, ToggleField]
    CustomerOrderId: TFieldInteger;

    [HiddenField, CustomField]
    RouteKey: TFieldInteger;

    [UniqueField, HiddenField, ToggleField]
    DeliveryId: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindDeliverySummaryId, 'Id', 60), HiddenField, ToggleField]
    DeliverySummaryId: TFieldInteger;

    constructor Create; override;
    destructor Destroy; override;
    function GetEmptyImageIndex(const aIndex: Integer): Integer;
    function GetDeliveryNoImageIndex(const aIndex: Integer): Integer;
    function GetPickedLaterImageIndex(const aIndex: Integer): Integer;
    function RouteNoImageIndex(const aIndex: Integer): Integer;
    function GetReportingStatusImageIndex(const aIndex: Integer): Integer;
    function GetCommentImageIndex(const aIndex: Integer): Integer;
    function GetCommentHint(const aIndex: Integer):String;
    function GetDockImageIndex(const aIndex: Integer): Integer;
    function GetConsumerPickImageIndex(const aIndex:Integer): Integer;

    function DeliveryRowStyler(const aIndex, aCol: Integer; var Style: TCellStyle):Boolean;

    procedure DoAfterConvert(const rx: Integer); override;

    procedure FillRouteSet(const aRouteSet: TRouteSet);

    procedure UpdateFromDeliverySet(FullSet:TDeliverySet; SelectedRouteKeys: TArrayInteger);

    /// <summary> Assumes ReleasedTPack and ReleasedPick have been initialized </summary>
    procedure GetReleaseStates(const aIndex: Integer; out ReleasedTPack, ReleasedPick: TThreeChoices);

    property ShowPickRoutes:Boolean read GetShowPickRoutes;

  end;

So many apps today no longer follows the Windows Theme color settings.  That annoys me.

6 hours ago, Attila Kovacs said:

@Lars Fosdal use json for your attribs, syncommons.pas can convert them to records

That is a good idea, but also somewhat fragile as the Json can't be validated at compile time - or can it... Perhaps a preprocessor would do the trick. Thanks, that is worth looking at. 

TForm.QualifiedClassName would be an option, @Mike Torrettinni

 

 

2

 Advanced issues found

▲

 

 

 

1 hour ago, David Heffernan said:

Also, it's fine that you don't want to disturb your code. But if you are going to offer up code as an example, it should be exemplary. 

IME, code doesn't need to be exemplary, as long as it does the job within its operating parameters.

Besides, I can always trust you to point out the weaknesses.

BDS doc has degenerated badly over the years, and it is often incomplete, inaccurate, or outdated. 
 

Logically, at least in my head, a type const declared with {$WRITEABLECONST OFF} is immutable and hence should be possible to use as any other const.

If that is impossible - I should at least be able to follow the pattern of the following

const
  _000000FF = Integer(255)
  s = String('C');

and declare

const
  r = rec(a:'Foo'; b:'Bar');

but alas...

Your workaround works, but presents two problems:

- String constants as a reference are fragile.  Renaming through the refactoring methods may very well break the link.

- I use attributes to parameterize a large number of properties per class, and that would mean a lot of extra code.

To me, it is the attribute Create that is the problem.  It doesn't behave the same as other class Create ctors. 
There are probably compiler tech reasons - but valid or not - the behavior is frustrating.

program Test;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  rec = record
    a: string;
    b: string;
    class function Create(const aa,ab: string): rec; static;
  end;

const
  crec: rec = (a:'X'; b:'Y');

type
  TTestClass = class
  private
    r: rec;
  public
    constructor Create(const arec: rec);
    procedure Test(const arec: rec);
  end;

{ TTestClass }

constructor TTestClass.Create(const arec: rec);
begin
  r:= aRec;
end;

procedure TTestClass.Test(const arec: rec);
begin
  r := aRec;
end;

{ rec }

class function rec.Create(const aa, ab: string): rec;
begin
  Result.a := aa;
  Result.b := ab;
end;

begin
  var TC := TTestClass.Create(crec);
  try
    try
      TC.Test(crec); // typed constant allowed
      TC.Test(rec.Create('X','Y'));
      TC.Test((a:'X'; b:'Y'));   // BARF - IMO this needs to be supported
      TC.Test(rec:(a:'X'; b:'Y'));   // BARF
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
  finally
    TC.Free;
    Write('Press Enter');
    Readln;
  end;
end.

Academically you may be correct, but empirically it simply works.

I have several hundred installations that have worked for many years and keep on working, and zero complaints that it ever failed.

The apps/services check the file version against a repository and if it finds a change,

- deletes any *.old.* copies that it finds

- copies the new file to a .new temp file,

- renames itself to *.old.<handle>

- renames the new temp file to the ordinary name

- Calls Restart...OnExit and exits.

Voila: App / Service is running the new version.

 

@David Heffernan

I found restarting a service from itself to be troublesome since you still are in the context of the running service.  Issuing a net start just at the time that you exit the service works well.

The exception handling is probably a cargo cult remnant.

I'd rewrite for CreateProcess for the application, but it works, so I won't fix it.

I had a similar problem where a lot of code was referring to the class name of forms to do navigation, and hence including the various form classes all over the place to get the class name.

I ended up making a unit, something like this:

unit NavigationHelp;
interface
type
  TNavLink = record
     MainForm: string;
     ReportForm: string;
     QueryForm: string;
  end;

const
  NameNotSet = 'Name not set';
{$WRITEABLECONST ON}
const
  NavLink: TNavLink = (
    MainForm: NameNotSet;
    ReportForm: NameNotSet;
    QueryForm: NameNotSet
  );

implementation
end.

and in the init section of my various form units, I updated the constant to the actual class name

unit MainFormU;
interface
uses
  NavigatorHelp;
type
  // ...
implementation
  // ...
initialization
  NavLink.MainForm := TMainForm.ClassName;
end.

You could apply the same pattern to form and control handles and set the handles in the respective OnFormShow routines.

type
  THandleRef = record
    MainForm: THandle;
    CustomButton: THandle;
  end;

const
  HandleRef: THandleRef = (
    MainForm: 0;
    CustomButton: 0
  );

...

TMainForm.FormShow(Sender: TObject);
begin
  HandleRef.MainForm := Self.Handle;
  HandleRef.CustomButton := CustomButton.Handle;
end;

That is a fairly simple "brute force" method to eliminate circular refs.

Some old code of mine. Awaiting ridicule for the use of ShellExecute 😛

FDCRelauncher
https://pastebin.com/YCiqiNAq

CustomDebugOut
https://pastebin.com/GM7DE18L

I prefer to defer the actual sending to a regular mail client.  Then it gets sent whenever mail is actually working.

I have a feeling I've asked this question before, but here I go again?

Is there a way to declare a constant of type rec that actually is constant?
 

{$WRITEABLECONST OFF}
type
  rec = record
    a: string;
    b: string;
  end;

type
  TestAttribute = class(TCustomAttribute)
  public
    r: rec;
    constructor Create(const ar: rec);
  end;

const
  rconst:rec = (a:'foo'; b:'bar');

type
  TTestClass = class
  private
    FProp: string;
  public
    [Test(rconst)]  // [dcc32 Error] E2026 Constant expression expected
    property Prop: string read FProp write FProp;
  end;

The last 8-9 years I've had the luxury of pretty much staying current with the Delphi versions. We usually skip the first releases like 10.2 or 10,3 and migrate when the 10.2.1 or 10.3.1 arrive. This has become a little harder as the so-called minor upgrades now also have a lot of changes and even new stuff., but we tend to wait for the first "fix pack". That allows the new versions mature for a while so that TMS, EurekaLog, FastReports, and others can work out any new quirks, and the bleeding edge crowd can draw first blood, but as I said, we do aspire to move on to the latest version as soon as it seems tried and tested. Back in the day, skipping several versions often raised headaches when finally deciding to migrate as you had to deal with multiple incompatibilities or breaking changes, so I much prefer the current approach. 

To be honest, in some cases I actually wish that EMBT would be bolder and more often introduce breaking changes to tidy up old sins.

On the topic of unit dependency cycles, I tend to view them as a design weakness.  It is a quick workaround for properly designing with DI and other tools that eliminate unit inter-dependencies. Yet, working with code that has evolved over a long time, they can be hard to eliminate as they are so deeply ingrained.  We have one particular unit that causes a compiler internal error whenever we change something in its interface section and do a compile in the IDE.  At that point only a Build All resolves the problem.

We ended up setting up the connections in code, rather than using connection definitions.

procedure TPSDDatabase_FD.CreateFireDACConnections;
const
  OSAuthent = 'No';
begin
  if not Assigned(FConnection)
  then begin
    OnConnectionCreate;
    FConnection := TFDConnection.Create(nil);
    FConnection.DriverName := FireDriverLink.BaseDriverId;

    FConnection.Params.Values[MSSQLParam.Server] := Trim(FHost);
    FConnection.Params.Values[MSSQLParam.Database] := Trim(FDatabaseName);
    FConnection.Params.Values[MSSQLParam.OSAuthent] := OSAuthent;
    FConnection.Params.Values[MSSQLParam.User_Name] := Trim(FUserName);
    FConnection.Params.Values[MSSQLParam.Password] := Trim(FPassword);

    FConnection.Params.MonitorBy := Self.MonitorBy;

    if DisableMARS
     then FConnection.Params.Values[MSSQLParam.MARS] := 'No';

    FConnection.Params.Values[MSSQLParam.ApplicationName] := AppInfo.Summary+';tid=' + IntToStr(GetCurrentThreadId);

    FConnection.LoginPrompt := False;

    FConnection.FormatOptions.OwnMapRules := True;
    with FConnection.FormatOptions.MapRules.Add
    do begin
      SourceDataType := dtDateTimeStamp;
      TargetDataType := dtDateTime;
    end;

    with FConnection.FormatOptions.MapRules.Add
    do begin
      SourceDataType := dtDate;
      TargetDataType := dtDateTime;
    end;

   FConnection.OnLogin := FDConnectionLoginEvent;
   FConnection.OnError := FDConnectionErrorEvent;
   FConnection.OnLost := FDConnectionLostEvent;
   FConnection.OnRestored := FDConnectionRestoredEvent;
   FConnection.OnRecover := FDConnectionRecoverEvent;
  end;
end;

Mileage or Distance traveled.  And, IMO, although the origin of mileage is miles traveled, today it is fine to use a mileage measured in km - if that is the local distance unit.

In Norwegian, the word "kilometerstand" is used, meaning the current standing of the kilometer counter in the odometer.

https://restcountries.eu offers various free REST APIs for retrieving lists of country-specific info. Pretty nice.

AFAIK, there are no cross-platform libs to get country-specific info.

Ugly workaround for your apps: Let your user specify the locale.
Alternatively, implement for each platform.

Windows https://docs.microsoft.com/en-us/windows/desktop/api/winnls/nf-winnls-getlocaleinfoa
Android https://developer.android.com/reference/java/util/Locale

iOS https://developer.apple.com/documentation/foundation/nslocale/1643060-countrycode

Linux No std way as far as I know.

Depends on the dictionary, I guess.

Race conditions rarely flag as errors, but cause inconsistent or erratic data, possibly leading to wrongful processing later on.

In this case, at least one of the four parties would be denied access (due to exclusive write lock and - depending on the programmmer - exclusive read) to the file and hence should have/raise awareness of a problem. 

But, whatever.

On 6/14/2019 at 5:09 PM, dummzeuch said:

I used a similar hack in an earlier version of my program: Wiggling the mouse pointer. While that worked fine under Windows XP, it doesn't under Windows 10 (no idea about Windows 7 and 8). That was the reason I researched how to do it "right".

 

Toggling numlock all the time would drive me crazy.

It turns NumLock off/on/off (or on/off/on) within less than 30 ms every 60 seconds, so I don't think it will bother you much. 

Our laptops are under company governance, so we can't prevent the session from locking as it is dictated by the policies.  In addition, the idle time is really short.

So - we wrote LockBlock which basically simulates toggling the numlock every 60 seconds.  That prevented the auto locking, but it also prevented the screensaver from kicking in when the dektkop was locked, so I added handling of lock/unlock to disable the fake keystrokes when it was locked.

Super simple UI: 60 second interval, starting at 8 in the morning, lasting for 8 hours - with an add an extra hour button for off work hours lock blocking.

Project source attached.  

LockBlock.zip

 

 

 

19 hours ago, dummzeuch said:

If there are multiple instances of program1 and it always uses the same file name when it starts its own instance of program2. These multiple instances would then all write to the same file.

That's a race condition in my opinion.

I'd call that a concurrency issue, rather than a race condition?

SharedFileName := '%temp%\MyFileName.ext.' + GetCurrentProcessId.ToString;

10 hours ago, Dmitry Arefiev said:

We have two problems:

1) REST, DBX, System.JSON duplicating JSON serialization classes.

2) Non complete docu for (1) classes.

 

We want to keep only System.JSON with options for backward compatibility with REST, DBX. And only to develop System.JSON. When this will happen, then all demos, tests (internal), docu, must be updated to reflect the current RTL state. Now it is not the time for docu work ...

If you don't document it - how do you expect to maintain backward compatibility?

My code relies on REST.Json 

- ObjectInstance := TJson.JsonToObject<T>(aJsonString) ;

- aJsonString := TJson.ObjectToJsonString(ObjectInstance,  [joIgnoreEmptyStrings, joIgnoreEmptyArrays, joDateIsUTC, joDateFormatISO8601]);

- TJSONInterceptor / JsonReflectAttribute for instructing the converter to drop TDateTime properties that have 0 as value.

What are the equivalents in System.Json ?

I wish the various Json classes were better documented.  http://docwiki.embarcadero.com/Libraries/Rio/en/REST.JsonReflect is particularly poorly documented with regards to marshalling, interceptors and converters.

I have long been wondering if the TJson.JsonToObject<T>(aJsonString) can be made to handle mixed type arrays {"list": [5, "text", {"prop": "value"}]} by injecting converters, but it seems impossible - but then again - the above mentioned tools are undocumented.