Jump to content

Alberto Paganini

Members
  • Content Count

    45
  • Joined

  • Last visited

Posts posted by Alberto Paganini


  1. Hello,

     
    I am trying to update DSharp to the latest release. Before doing that I updated Spring4D successfully.
     
    When I tried to update DSharp and build DSharp.Core.DelphiXE2.bpl I had the error message "[DCC Error] DSharp.Collections.Iterators.pas(54): E2170 Cannot override a non-virtual method"
    Here below is the excerpt of the unit with line 54
     
      TCustomIterator<T> = class(TIterator<T>)
      private
        fProc: TIteratorProc<T>;
      public
        constructor Create(const proc: TIteratorProc<T>);
    
        function Clone: TIterator<T>; override;
        function MoveNext: Boolean; override; // line 54
      end;


     

    Any idea of what I am missing out on?
     
    Many thanks
    Alberto

  2. Quote

    Well, first you should check and ensure that date parsing is the reason of slowdown in your workflow. 

    One important part of the application I am working on is to retrieve data from a service provider as often as possible.

    The function JsonStringToDateTime is called tens of thousands of times from several processes in a few minutes in order to parse the data provided therefore, the faster the function the more times the application can retrieve data.

    This is one of the most "popular" functions but there are others similar and called as much as this one and I will look into these too.

     

    I understand this is just a quick fix, the next step would be to refactor the logic of the application in order to retrieve data and parse it in a better way (maybe parse only the necessary data) but that would require more time and I would like to see some results in the short run.


    However, for the records here the three versions with the usual quick test. 

    program SoapTest;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      madExcept,
      madLinkDisAsm,
      madListHardware,
      madListProcesses,
      madListModules,
      System.SysUtils,
      Soap.XSBuiltIns;
    
    const
      gOutOfScopelDate: TDateTime = 2 + 365;
    
    
    {*****************************************************************************************}
    function JsonStringToDateTime(S: widestring): TDateTime;
    {*****************************************************************************************}
    begin
      result := gOutOfScopelDate;
    
      with TXSDateTime.Create() do
      begin
        try
          XSToNative(S);
          result := AsDateTime;
        finally
          Free;
        end;
      end;
    end;
    {*****************************************************************************************}
    
    function JsonStringToDateTime2(S: widestring): TDateTime;
    {*****************************************************************************************}
    begin
      try
        Result := EncodeDate(StrToInt(Copy(S, 1, 4)), StrToInt(Copy(S, 6, 2)), StrToInt(Copy(S, 9, 2)));
        Result := Result + EncodeTime(StrToInt(Copy(S, 12, 2)), StrToInt(Copy(S, 15, 2)), StrToInt(Copy(S,
          18, 2)), 0);
      except
        result := gOutOfScopelDate;
      end;
    end;
    
    
    {*****************************************************************************************}
    function JsonStringToDateTime3(Src: widestring): TDateTime;
    {*****************************************************************************************}
    
      function CharToDigit(aChar: Char): Integer; inline;
      begin
        Result := Ord(aChar) - Ord('0');
      end;
    
    var
      S: string;
      pSrc, pDest: PChar;
    begin
      SetLength(S, 8);
      pSrc := Pointer(Src);
      pDest := Pointer(S);
    
      try
      //date
        pDest^ := pSrc^;
        (pDest + 1)^ := (pSrc + 1)^;
        (pDest + 2)^ := (pSrc + 2)^;
        (pDest + 3)^ := (pSrc + 3)^;
        (pDest + 4)^ := (pSrc + 5)^;
        (pDest + 5)^ := (pSrc + 6)^;
        (pDest + 6)^ := (pSrc + 8)^;
        (pDest + 7)^ := (pSrc + 9)^;
      {(*}
      Result := EncodeDate(      // year
        CharToDigit(S[1]) * 1000 + CharToDigit(S[2]) * 100 + CharToDigit(S[3]) * 10 +CharToDigit(S[4]),
        CharToDigit(S[5]) * 10 +CharToDigit(S[6]), //month
        CharToDigit(S[7]) * 10 +CharToDigit(S[8])); //date
      {*)}
      //time
        pDest^ := (pSrc + 11)^;
        (pDest + 1)^ := (pSrc + 12)^;
        (pDest + 2)^ := (pSrc + 14)^;
        (pDest + 3)^ := (pSrc + 15)^;
        (pDest + 4)^ := (pSrc + 17)^;
        (pDest + 5)^ := (pSrc + 18)^;
     {(*}
      Result:=Result+EncodeTime(
        CharToDigit(S[1]) * 10 +CharToDigit(S[2]),  //hh
        CharToDigit(S[3]) * 10 +CharToDigit(S[4]),  //mm
        CharToDigit(S[5]) * 10 +CharToDigit(S[6]), //ss
        0//ms
        );
     {*)}
      except
        result := gOutOfScopelDate;
      end;
    end;
    
    const
      aTimes = 5000;
    
    var
      TimeResult: TDateTime;
      a: TDateTime;
      b: TDateTime;
      I: Integer;
      hh, mm, ss, ms: Word;
    
    begin
      a := Now;
      for i := 0 to aTimes do
      begin
        TimeResult := JsonStringToDateTime('2021-02-11T02:25:00.000Z');
      end;
      b := Now - a;
      DecodeTime(b, Hh, mm, ss, ms);
      Writeln('JsonStringToDateTime sec:' + IntToStr(ss) + ' msec:' + IntToStr(ms));
    
      a := Now;
      for i := 0 to aTimes do
      begin
        TimeResult := JsonStringToDateTime2('2023-03-13T02:25:00.000Z');
      end;
      b := Now - a;
      DecodeTime(b, Hh, mm, ss, ms);
      Writeln('JsonStringToDateTime2 sec:' + IntToStr(ss) + ' msec:' + IntToStr(ms));
    
      a := Now;
      for i := 0 to aTimes do
      begin
        TimeResult := JsonStringToDateTime3('2023-03-13T02:25:00.000Z');
      end;
      b := Now - a;
      DecodeTime(b, Hh, mm, ss, ms);
      Writeln('JsonStringToDateTime3 sec:' + IntToStr(ss) + ' msec:' + IntToStr(ms));
    
      Readln;
    end.

    In all honesty, I didn't think that replacing Copy would make a big difference, obviously, I was wrong.

    I was under the impression that StrToInt could be replaced but I didn't know how to do.

    The improvement that the changes suggested by @Fr0sT.Brutal make is very big! Thank you.

     

    I hope I have understood all the suggestions.

     

    Many thanks

    Alberto

     


  3. 8 hours ago, Fr0sT.Brutal said:

    Sure. SIX Copy calls. Six IntToStr calls. Argument is not "const".

    I was not able to think of anything better in order to transform parts of a string into numbers and then put everything into a TDateTime.

    Is there an alternative to that, considering that performance is important here?


  4.  

    @emailx45

     

    Quote

     

    One doubt here:

    • What makes this a "null date"?

     

    That is technically correct, there is no "null date" in Delphi.

    The software I am working on should receive dates >01/01/1901 only. If something goes wrong the procedure assigns 01/01/1901 to Result. Somewhere else the application checks Result and if it is is 01/01/1901 treats this accordingly.

    I should have renamed it something like gOutOfScopeDate

     


  5. Quote

    Yes, remove "Dummy",

    Yes, sorry I forgot to remove it.

     

    Quote

    and maybe Result := Result + Encodetime()?

    Any particular reason for that? I am not trying to be funny here. I just want to understand why this is better.

     

    Quote

    Also, you are ignoring time zones, but it is not necessary a problem 

    Yes, not a problem in my case.

     

     


  6. I would like to replace JsonStringToDateTime with JsonStringToDateTime2 in my code because it is significantly faster.

    Here below a small example

    program MyTest;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      madExcept,
      madLinkDisAsm,
      madListHardware,
      madListProcesses,
      madListModules,
      System.SysUtils,
      Soap.XSBuiltIns;
    
    const
      gNullDate: TDateTime = 2 + 365;
    
    
    {*****************************************************************************************}
    function JsonStringToDateTime(S: widestring): TDateTime;
    {*****************************************************************************************}
    begin
      result := gNullDate;
    
      with TXSDateTime.Create() do
      begin
        try
          XSToNative(S);
          result := AsDateTime;
        finally
          Free;
        end;
      end;
    end;
    {*****************************************************************************************}
    
    function JsonStringToDateTime2(S: widestring): TDateTime;
    {*****************************************************************************************}
    var
      Dummy: string;
    begin
      try
        Result := EncodeDate(StrToInt(Copy(S, 1, 4)), StrToInt(Copy(S, 6, 2)), StrToInt(Copy(S, 9, 2)));
        Result := EncodeTime(StrToInt(Copy(S, 12, 2)), StrToInt(Copy(S, 15, 2)), StrToInt(Copy(S, 18, 2)),
          0);
      except
        result := gNullDate;
      end;
    end;
    
    var
      TimeResult: TDateTime;
      a: TDateTime;
      b: TDateTime;
      I: Integer;
      hh, mm, ss, ms: Word;
    
    begin
      a := Now;
      for i := 0 to 5000 do
      begin
        TimeResult := JsonStringToDateTime('2021-02-11T02:25:00.000Z');
      end;
      b := Now - a;
      DecodeTime(b, Hh, mm, ss, ms);
      Writeln('JsonStringToDateTime sec:' + IntToStr(ss) + ' msec:+' + IntToStr(ms));
    
      a := Now;
      for i := 0 to 5000 do
      begin
        TimeResult := JsonStringToDateTime2('2021-02-11T02:25:00.000Z');
      end;
      b := Now - a;
      DecodeTime(b, Hh, mm, ss, ms);
      Writeln('JsonStringToDateTime2 sec:' + IntToStr(ss) + ' msec:+' + IntToStr(ms));
    
      Readln;
    end.

     

    Can you see any drawbacks in JsonStringToDateTime2 ?

     

    Many thanks

    Alberto


  7. Ok, I have found out the final issues.

     

    It turned out that Windows 7 does not enable TLS 1.2 by default. You have to do it manually by following this process https://support.site24x7.com/portal/en/kb/articles/how-to-check-if-tls-1-2-is-enabled

    At this stage, the function above started working.

     

    Next, I had to add one extra line in a third party code every time TIdSSLIOHandlerSocketOpenSSL is created.

    The extra line is

    sslIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 

     

    After that, the application started working as before.

     

    @Remy LebeauThank you for your help

     

    Alberto

     


  8. It seems I am making progress with this.

     

    I have amended the class in a way the application loads the .DLLs residing in the application folder. This is achieved with IdSSLOpenSSLHeaders.IdOpenSSLSetLibPath(). (Thanks to Remi for this post https://stackoverflow.com/questions/13269169/how-to-use-a-dll-outside-of-the-system-path)

    IdSSLOpenSSL.OpenSSLVersion; confirms now "OpenSSL 1.0.2q  20 Nov 2018" is loaded and this collides with the .DLLs version in the application folder.

     

    As far as I can see from the https://www.openssl.org/news/openssl-1.0.2-notes.html the OpenSSL 1.0.2 supports TLS 1.2 for a long time (Jan 2015). Despite that my application still throws "tlsv1 alert protocol version"

    Is there anything else I should be aware of ?

     

    The amended source code is here above if anybody may be interested.

     

    Many thanks

    Alberto

    function TConnectionClass.GetToken: Boolean;
    var
      LJSONObject: TJSONObject;
      LJSONValue: TJSONValue;
      {$IFDEF VER230}
      LJSONPair: TJSONPair;
      {$ENDIF}
      LJSONToken: TJSONValue;
      IdHTTP: TIdHTTP;
      IdSSL: TIdSSLIOHandlerSocketOpenSSL;
      IdLogFile: TIdLogFile;
      sList: TStringList;
      Path:string;
      OpenSSLVersion:string;
    begin
    
    begin
      Result := False;
      FToken := '';
    
      Path:=ExtractFilePath(ParamStr(0));
      IdSSLOpenSSLHeaders.IdOpenSSLSetLibPath(Path);
      OpenSSLVersion:= IdSSLOpenSSL.OpenSSLVersion;
      IdHTTP := TIdHTTP.Create(nil);
      try
        IdHTTP.HTTPOptions := IdHTTP.HTTPOptions + [hoForceEncodeParams];
        IdHTTP.HandleRedirects := True;
    
        IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
        IdSSL.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
        IdHTTP.IOHandler := IdSSL;
    
        IdLogFile := TIdLogFile.Create(IdHTTP);
        IdLogFile.Filename := 'c:\' + ChangeFileExt(ExtractFileName(ParamStr(0)), '.log');
        IdLogFile.Active := True;
        IdHTTP.Intercept := IdLogFile;
    
        IdHTTP.Request.Accept := 'application/json';
        IdHTTP.Request.CustomHeaders.Values['X-Application'] := cBetfair_AppKey;
        IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
    
        sList := TStringList.Create;
        try
          sList.Add('username=' + FUserID);
          sList.Add('password=' + FPassword);
    
          LJSONValue := TJSONObject.ParseJSONValue(IdHTTP.Post(URL_LOGIN, sList));
          try
            if LJSONValue is TJSONObject then
            begin
              LJSONObject := TJSONObject(LJSONValue);
              {$IFDEF VER230}
              LJSONPair := LJSONObject.Get('token');
              if LJSONPair <> nil then
                LJSONToken := LJSONPair.JsonValue
              else
                LJSONToken := nil;
              {$ELSE}
              LJSONToken := LJSONObject.Values['token'];
              {$ENDIF}
              if LJSONToken <> nil then
                FToken := LJSONToken.Value;
            end;
          finally
            LJSONValue.Free;
          end;
        finally
          sList.Free;
        end;
      finally
        IdHTTP.Free;
      end;
    
      Result := (FToken <> '');
    end;

     


  9. @Remy Lebeau

    Quote

    Do you know what version of TLS the server requires?  Does it even support TLS v1.0..v1.2 nowadays?  

    Yes, this is the issue. I have just found out from the provider that "From 1st December only TLS 1.2 and above will be supported".

    I renamed libeay32.dll and ssleay32.dll in the system32 folder, downloaded the two .DLLs from Github, placed them in the application folder but the error is still the same.

     

    Quote

     

    I have double-checked and now the .dll have Version file 1.0.2.21 and Version 1.0.2u

    Are you SURE about that?  At runtime, what does Indy's OpenSSLVersion() function in the IdSSLOpenSSL unit report after OpenSSL has been loaded? 

     

    The version I have reported is the one found in the properties of the .DLL files. 

    However, the OpenSSLVersion function reports OpenSSL 1.0.0d 8 Feb 2011, and that explains why the .exe is not working any longer.

     

    Does it mean my application uses other SSL .DLLs on my hard disk? (yes, I have a few installed by other third-party software. Each of them resides in the relevant application folder)

    How can I tell my application that the correct .DLL resides in the same folder of the application itself? I don't want to delete the other .DLLs in order not to stop the other applications to work.

     

    Many thanks.

    Alberto


  10. Hello,

     

    I have a problem with a Win32 application using Indy. All of a sudden it throws me the following error message:
    "Error connecting with SSL. error 1409442E:SSL routine:ssl3_read_bytes:tlsv1 alert protocol version"

     

    In the beginning, I supposed it had something to do with an obsolete version I manage in my source. 
    The following is the only place in my source where I set the SSL version and it supports the version 1.2

     

    function TConnectionClass.GetToken: Boolean;
    var
      LJSONObject: TJSONObject;
      LJSONValue: TJSONValue;
      {$IFDEF VER230}
      LJSONPair: TJSONPair;
      {$ENDIF}
      LJSONToken: TJSONValue;
      IdHTTP: TIdHTTP;
      IdSSL: TIdSSLIOHandlerSocketOpenSSL;
      IdLogFile: TIdLogFile;
      sList: TStringList;
    begin
      Result := False;
      FToken := '';
    
      IdHTTP := TIdHTTP.Create(nil);
      try
        IdHTTP.HTTPOptions := IdHTTP.HTTPOptions + [hoForceEncodeParams];
        IdHTTP.HandleRedirects := True;
    
        IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
        IdSSL.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
        IdHTTP.IOHandler := IdSSL;
    
        IdLogFile := TIdLogFile.Create(IdHTTP);
        IdLogFile.Filename := 'c:\' + ChangeFileExt(ExtractFileName(ParamStr(0)), '.log');
        IdLogFile.Active := True;
        IdHTTP.Intercept := IdLogFile;
    
        IdHTTP.Request.Accept := 'application/json';
        IdHTTP.Request.CustomHeaders.Values['X-Application'] := cBetfair_AppKey;
        IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
    
        sList := TStringList.Create;
        try
          sList.Add('username=' + FUserID);
          sList.Add('password=' + FPassword);
    
          LJSONValue := TJSONObject.ParseJSONValue(IdHTTP.Post(URL_LOGIN, sList));
          try
            if LJSONValue is TJSONObject then
            begin
              LJSONObject := TJSONObject(LJSONValue);
              {$IFDEF VER230}
              LJSONPair := LJSONObject.Get('token');
              if LJSONPair <> nil then
                LJSONToken := LJSONPair.JsonValue
              else
                LJSONToken := nil;
              {$ELSE}
              LJSONToken := LJSONObject.Values['token'];
              {$ENDIF}
              if LJSONToken <> nil then
                FToken := LJSONToken.Value;
            end;
          finally
            LJSONValue.Free;
          end;
        finally
          sList.Free;
        end;
      finally
        IdHTTP.Free;
      end;
    
      Result := (FToken <> '');
    end;
    


    I also tried to amend the options into

    IdSSL.SSLOptions.SSLVersions := [sslvTLSv1_2]; 

    but the error is still the same

     

    Then I updated the SSL .dll files in my system32 folder by downloading the latest version of libeay32.dll and ssleay32.dll from here https://indy.fulgan.com/SSL/ and replace the old files with the new ones. 
    I have double-checked and now the .dll have Version file 1.0.2.21 and Version 1.0.2u

     

    Despite these attempts, the application still throws me the same exception.

    Is there anything else I should change?

     

    Many thanks

    Alberto


  11. 21 hours ago, David Hoyle said:

    This can be changed via the

    
    FastMM4Options.inc

    file if I remember correctly (sorry not a a development machine to be more precise) and possible with directives defined in the project.

    The settings is 

    
    {.$define ClearLogFileOnStartup}

    looked up the inc file on GitHub.

    Thank you David, this did the trick !


  12. Quote

    It's automatically deleted here. Try setting up a brand new app and check how it behaves there. 

     

    I did and created this test:

    program Project3;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      FastMM4,
      system.Classes,
      System.SysUtils;
    
      var t:tstringlist;
    begin
        t:=TStringList.Create;
    end.

    I ran it a number of times and the new reports are appended to the old ones. Obviously there must be something wrong in my FastMM4  settings. I will look into that.

     

     


  13. I use FastMM4 to check memory leaks and I noticed the report file " MyApplicatoin+MemoryManager_EventLog.txt" is not deleted automatically once I have amended the source and I run my application again. This way if there are still memory leaks they are added to the existing report and this confuses me.

    Is there an option in FastMM4 to achieve that I am not aware of or do I have to rely on DeleteFile(...) when I run the application ?

     

    Many thanks

    Alberto


  14. @Stefan Glienke

    I have amended the example according to your advice. 

     

    program Project3;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      FastMM4,
      system.Classes,
      System.SysUtils,
      Spring;
    
    type
      MyInterface2 = interface
        ['{8E7BC71F-55EE-4345-8A5B-42C433BE9EBA}']
        procedure print;
      end;
    
      MyInterface1 = interface
        ['{607A66A6-D68C-4980-9FB1-83B325EE9A91}']
        procedure SetInterface2(const aInterface: MyInterface2);
        procedure DoSomethingWithInterface2;
      end;
    
      TMyClass1 = class(TInterfacedObject, MyInterface1)
      private
        //RefToInterFace2: Pointer{MyInterface2};
        RefToInterFace2: Weak<MyInterface2>;
      public
        procedure SetInterface2(const aInterface: MyInterface2);
        procedure DoSomethingWithInterface2;
      end;
    
      TMyClass2 = class(TInterfacedObject, MyInterface2)
      private
    //    Ref: MyInterface1;
        ref: Weak<MyInterface1>;
      public
        constructor Create(int: MyInterface1); reintroduce;
        destructor Destroy; override; // this can be deleted
        procedure print;
      end;
    
    
    { TMyClass1 }
    
    procedure TMyClass2.print;
    begin
      Writeln('TMyClass2.print');
      Sleep(1500);
    end;
    
    { TMyClass2 }
    
    procedure TMyClass1.DoSomethingWithInterface2;
    begin
      if RefToInterFace2 <> nil then
      begin
    //    MyInterface2(RefToInterFace2).print;
        RefToInterFace2.Target.print;
      end;
    end;
    
    procedure TMyClass1.SetInterface2(const aInterface: MyInterface2);
    begin
    //  RefToInterFace2 := Pointer(aInterface);
      RefToInterFace2.Target := aInterface;
    end;
    
    constructor TMyClass2.Create(int: MyInterface1);
    begin
      inherited Create;
      if int <> nil then
      begin
        Ref.Create(int);
        Ref.Target.SetInterface2(Self);
      end;
    end;
    
    destructor TMyClass2.Destroy;
    begin
    //  if Ref <> nil then
    //    MyInterface1(Ref).SetInterface2(nil);
      inherited Destroy;
    end;
    
    var
      aMyClass1: MyInterface1;
      aMyClass2: MyInterface2;
    
    begin
      aMyClass1 := TMyClass1.Create;
      aMyClass2 := TMyClass2.Create(aMyClass1);
      aMyClass1.DoSomethingWithInterface2;
    end.

     

    Is that acceptable?

    In which case the pointer approach proposed by Remi may cause AV errors?

     

    Many thanks

     

    Alberto


  15. Hi Remi,

     

    I had to amend your code with the following one in order to make the example compile by DX2

    procedure TMyClass1.SetInterface2(const aInterface: MyInterface2);
    begin
      RefToInterFace2 := Pointer(aInterface);
    end;

    The rest is all spot on!

     

    I suppose that the advantage to use the second solution is you can call any method of MyInterface1 throughout TMyClass2 by using Ref while in the first one you can do it only in TMyClass2.Create as MyInterface1 is not stored in a variable.

     

    Thank you very much for taking the time.

     

    Alberto


  16. But If I store the interface in a local variable in TMyClass2, Ref in my example, I have a leak instead. It seems the RTL cannot have access to it. The only way to release the variable is to use a method and call this method from the main begin..end. Here below the minimum example.

    program Project3;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      FastMM4,
      system.Classes,
      System.SysUtils;
    
    type
      MyInterface2 = interface
        ['{8E7BC71F-55EE-4345-8A5B-42C433BE9EBA}']
        procedure print;
      end;
    
      MyInterface1 = interface
        ['{607A66A6-D68C-4980-9FB1-83B325EE9A91}']
        procedure SetInterface2(aInterface: MyInterface2);
        procedure DoSomethingWithInterface2;
      end;
    
      TMyClass1 = class(TInterfacedObject, MyInterface1)
      private
        RefToInterFace2: MyInterface2;
      public
        procedure SetInterface2(aInterface: MyInterface2);
        procedure DoSomethingWithInterface2;
        destructor Destroy;override;
      end;
    
      TMyClass2 = class(TInterfacedObject, MyInterface2)
      private
        Ref: MyInterface1;
      public
        constructor Create(int: MyInterface1); reintroduce;
        procedure print;
      end;
    
    
    { TMyClass1 }
    
    procedure TMyClass2.print;
    begin
      Writeln('TMyClass2.print');
      Sleep(1500);
    end;
    
    { TMyClass2 }
    
    destructor TMyClass1.Destroy;
    begin
      SetInterface2(nil);// this isn not executed
      inherited;
    end;
    
    procedure TMyClass1.DoSomethingWithInterface2;
    begin
      RefToInterFace2.print;
    end;
    
    procedure TMyClass1.SetInterface2(aInterface: MyInterface2);
    begin
      RefToInterFace2 := aInterface;
    end;
    
    constructor TMyClass2.Create(int: MyInterface1);
    begin
      inherited Create;
      Ref := int;
      Ref.SetInterface2(Self);
    end;
    
    var
      aMyClass1: MyInterface1;
      aMyClass2: MyInterface2;
    
    begin
      aMyClass1 := TMyClass1.Create;
      aMyClass2 := TMyClass2.Create(aMyClass1);
      aMyClass1.DoSomethingWithInterface2;
      aMyClass1.SetInterface2(nil);// this releases the variable
    end.

    Is this the only way to release the pointer in the variable or is there a better way? If I add a destructor that is not executed.

     

    Many thanks

    Alberto


  17. I am just investigating on how this works. Having the following code:

    program Project3;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      FastMM4,
      system.Classes,
      System.SysUtils;
    
    type
      MyInterface2 = interface
        ['{8E7BC71F-55EE-4345-8A5B-42C433BE9EBA}']
        procedure print;
      end;
    
      MyInterface1 = interface
        ['{607A66A6-D68C-4980-9FB1-83B325EE9A91}']
        procedure SetInterface2(aInterface: MyInterface2);
      end;
    
      TMyClass1 = class(TInterfacedObject, MyInterface1)
      private
        RefToInterFace2: MyInterface2;
      public
        procedure SetInterface2(aInterface: MyInterface2);
      end;
    
      TMyClass2 = class(TInterfacedObject, MyInterface2)
        constructor Create(int: MyInterface1); reintroduce;
        procedure print;
      end;
    
    
    { TMyClass1 }
    
    procedure TMyClass2.print;
    begin
      Writeln('TMyClass2.print');
      Sleep(1500);
    end;
    
    { TMyClass2 }
    
    procedure TMyClass1.SetInterface2(aInterface: MyInterface2);
    begin
      RefToInterFace2 := aInterface;
      RefToInterFace2.print;
    end;
    
    constructor TMyClass2.Create(int: MyInterface1);
    begin
      inherited Create;
      int.SetInterface2(Self);
    end;
    
    var
      aMyClass1: MyInterface1;
      aMyClass2: MyInterface2;
    
    begin
      aMyClass1 := TMyClass1.Create;
      aMyClass2 := TMyClass2.Create(aMyClass1);
    end.


    How does TMyClass1 know there is RefToInterFace2 to be set to nil in order to prevent an AV error? Where is RefToInterFace2:=nil invoked from?

    I mean, TMyClass1 ancestor does not know about RefToInterFace2 and RefToInterFace2 is not set to nil anywhere in TMyClass1 

     

    Many thanks

    Alberto


  18. Quote

    Yes I understood that. What I mean is that you need the other methods from TInterfacedObject to protect against early release. Notably: AfterConstruction and NewInstance.

    Ok, I have also implemented QueryInterface, AfterConstruction, BeforeDestruction and NewInstance in my DataModule
     

    Quote

    Next try to just register the interface/implementation in Spring (without any of the supporting code) and instantiate an instance of IMainDMTEST.

    In this case, there are no leaks in both cases, with our without .AsSingleton.

    At this stage, I started implementing the other classes, one by one and .AsSingleton in my datamodule started making a difference when I arrived at the class TBetFairAPINGHorseFunctionSimulationBL

      TBetFairAPINGHorseFunctionSimulationBL = class(TInterfacedObject, ILBS_BetfairAPINGFunctionsBL)
      private
        FDM: IMainDMTEST;
      public
        constructor Create(aDM: IMainDMTEST); reintroduce;
        destructor Destroy; override;
      end;
    
    
    constructor TBetFairAPINGHorseFunctionSimulationBL.Create(aDM: IMainDMTEST);
    begin
      inherited create;
      FDM := aDM;
    end;
    
    
    destructor TBetFairAPINGHorseFunctionSimulationBL.Destroy;
    begin
      FDM := nil;
      inherited;
    end;

     

    Quote

    Make sure you release the instance before termination (like the unnecessary nilling in my example). You want to make sure Spring isn't holding on to a reference.

    I have added TBetFairAPINGHorseFunctionSimulationBL.Destroy and set FDM=nil in there but this destructor is never executed, don't know why as this class inherits from TInterfacedObject?

    As the last attempt, I have added a line at the end of the program to try to release the IMainDMTest at the very end of the application but the leak is still there.

    var
      FScalpingBL: IScalpingBL;
      Test: IMainDMTEST;
    
    begin
      RegisterTypes(GlobalContainer);
      Test := GlobalContainer.Resolve<IMainDMTEST>;
      FScalpingBL := globalcontainer.Resolve<IScalpingBL>;
      Test := nil;
    end.

     

    Quote

    Try with and without AsSingleton.

    If I remove .AsSingleton when I resolve the interface then I have no more leaks but I have to keep .AsSingleton because this class holds/manages data and several classes have access to it.


  19. 28 minutes ago, Anders Melander said:

    No. You need those too. They have a purpose.

     

    I think you need to start with a much simpler test case. Does it leak if you  leave out all the Spring stuff and just do this:

    
    var
      Test: IMainDMTEST;
    begin
      Test:= TDMSimulation.Create(nil);
      Test := nil;
    end;

     

    Sorry I didn't explain properly.  _AddRef and _Release are implemented in my example. It was the other procedures from Jeroen's example that have been left out as you advised.

    If I create the object as per your example above then there is no leak. I suppose the issue is in the way I resolve the interface in the Spring container.


  20. Quote

    All you need to do reimplement _AddRef and _Release and stick to referencing the datamodule by the interface. Use TInterfacedObject as an example.

    I looked into TInterfacedObject again and implemented _AddRef and _Release in the same way, leaving out the remaining procedures, the example attached to this post is the updated minimum example. Unfortunately, I still have the same leaks.

     

    Quote

    There was a thread here earlier this week on that exact topic but apparently it was deleted or maybe got lost when the server went down.

    I started that thread. Now I know why I cannot have access to it any longer.

    Test2.zip


  21. On 6/25/2020 at 8:54 PM, David Heffernan said:

    All this speculation..... A minimal example and the answer would be simple. 

    I have managed to make a minimal example that leaks. I will attach it here.

     

    I have found this article on how to make a TDataModule reference counting written by Jeroen Pluimers https://wiert.me/2009/08/10/delphi-using-fastmm4-part-2-tdatamodule-descendants-exposing-interfaces-or-the-introduction-of-a-tinterfaceddatamodule/ and tried to implement it in MainDMSimulation in the example. Despite that, the example is still leaking.

     

    I think is I am still doing something wrong when it comes to making TDataModule reference counting or in the way I resolve the interface in the Spring4D container (or maybe both).

     

    Test.zip


  22.  
     
    ✌
    1
    Quote

    The stack trace you showed is complaining that the character data for the UnicodeString returned by TJSONString.Value is what is being leaked.  That UnicodeString is assigned to your private FToken variable.  Which means the TBetFairApi object that is holding that UnicodeString is not freeing that UnicodeString properly.  Either because itself is being leaked as well, or you have a bug elsewhere in your code that is overwriting the UnicodeString's internal pointer to the allocated character data.  Either way, this is happening after TBetFairApi.GetToken() has exited, so the problem is not in TBetFairApi.GetToken() itself.

    TBetFairApi.GetToken works perfectly now, thank you very much! Now I have to debug the rest because, you are right, there is another leak elsewhere. I will work on a minimal example.

     

    Thank you again, everybody. I have learnt a few new things !

×