Hafedh TRIMECHE

Hello, Having a c module exporting a structured variable as: typedef struct params{ int p1; int p2; } PARAMS; and is exported as: extern PARAMS params; Please, how a function be called from Delphi to retrieve params? Best regards.

AutoSize has not effect on a TPanel component. When set to True, the width is kept unchanged.

When a Panel is empty (no controls) it would adjust its size to the text width as it is done when using a TLabel.

object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 441 ClientWidth = 624 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -12 Font.Name = 'Segoe UI' Font.Style = [] PixelsPerInch = 96 TextHeight = 15 object Panel1: TPanel Left = 96 Top = 32 Width = 185 Height = 41 AutoSize = True Caption = 'Panel1' TabOrder = 0 end end

Is there a way to disable control resizing at design time? I tried this but Message.Result is always set to 1 (HTCLIENT) procedure TUFrame.WMNCHitTest(var Message:TWMNCHitTest); begin inherited; if Message.Result in [HTLEFT,HTRIGHT,HTBOTTOM,HTBOTTOMRIGHT,HTBOTTOMLEFT,HTTOP,HTTOPRIGHT,HTTOPLEFT] then Message.Result := Windows.HTNOWHERE; end; Thanks.

This overridden procedure wont prevent multiple clicks procedure TUButton.Click; var CanGo : Boolean; begin FLock.Lock; CanGo := (not FBusy); if CanGo then FBusy := True; Flock.Unlock; if (not CanGo) then Exit; inherited; FLock.Lock; FBusy := False; Flock.Unlock; end; Any possible solution? Thanks.

Please note that TUButton is a customized component derived from TButton.

It's already done: procedure TUButton.Click; begin FlushInput; if MilliSecondsBetween(Now,FLastClicked)<600 then Exit; FLastClicked := Now; inherited; end; No need to set a timer. Any click invoked within 600 milliseconds interval will be discarded. Thanks.

The Event handler must resume execution.

I guess that more than one message events are already queued before TUbutton.Click starts executing. So, This approach is applicable only if previous messages are removed from the Queue ; otherwise, OnClick events will continue processing. Removing messages is done using FlushInput defined into my reply above.

Thanks for your reply. Tried this solution but not solved the issue. Disabling and Enabling the button itself is only valid for OnClick handler which takes a time larger than the one elapsed between 2 clicks. I modified the code: procedure EmptyKeyQueue; var Msg : TMsg; begin while PeekMessage(Msg,0,WM_KEYFIRST,WM_KEYLAST,PM_REMOVE or PM_NOYIELD) do; end; procedure EmptyMouseQueue; var Msg : TMsg; begin while PeekMessage(Msg,0,WM_MOUSEFIRST, WM_MOUSELAST,PM_REMOVE or PM_NOYIELD) do; end; procedure FlushInput; begin EmptyKeyQueue; EmptyMouseQueue; end; procedure TUButton.Click; begin FlushInput; if MilliSecondsBetween(Now,FLastClicked)<600 then Exit; FLastClicked := Now; inherited; end;

This code raised an EIdNotASocket exception. function PortInUse(const APort:Integer;const Address:string='localhost'):Boolean; var LTcpClient : TIdTCPClient; begin LTcpClient := TIdTCPClient.Create(nil); try try LTcpClient.Host := Address; LTcpClient.Port := APort; LTcpClient.ConnectTimeout := 200; LTcpClient.Connect; Result := True; except Result := False; end; finally freeAndNil(LTcpClient); end; end; =============================================================================== Application Name : DSFInterface.exe Memory manager : FastMM Compiler Version : Delphi: 34 Indy Version : 10.6.2.0 Zeos Version : 7.2.14-release Report Unique ID : {9E064C95-AA3D-4658-BF59-FFE405865C5C} Start Time : 2021-08-05 11:45:18.843 Exception Time : 2021-08-05 11:46:20.381 Application up time : 1 minute 1 second 538 milliseconds =============================================================================== Processor : LENOVO, LNVNB161216, AMD64 Family 21 Model 112 Stepping 0, AMD A4-9125 RADEON R3, 4 COMPUTE CORES 2C+2G , 2.3 GHz System : Windows 10 (Version 10.0, Build 19043, 64-bit Edition) Display : 1680x1050 pixels, 96 bpp Total Physical Memory : 6.608 GB Free Physical Memory : 2.137 GB Max used Memory : 201.594 MB =============================================================================== Exception class : EIdNotASocket Socket Error # 10038 Socket operation on non-socket. Exception address : 000000000095CAD1 Exception trigger : ExceptionAcquired ------------------------------------------------------------------------------- Module : JclDebug Command Line : D:\Applications-Folder\DSFInterface\DSFInterface.exe Procedure : JclDebug.TJclStackInfoList.Create Unit : JclDebug.pas Line : 5509 ------------------------------------------------------------------------------- [00000000009075B1] JclDebug.TJclStackInfoList.Create (Line 5509, "JclDebug.pas" + 34) + $0 [00000000009070D2] JclDebug.JclCreateStackList (Line 5351, "JclDebug.pas" + 1) + $3E [0000000000906FB4] JclDebug.DoExceptionStackTrace (Line 5292, "JclDebug.pas" + 20) + $1F [0000000000909E0C] JclDebug.DoExceptNotify (Line 6741, "JclDebug.pas" + 7) + $0 [00000000008F54C2] JclHookExcept.TNotifierItem.DoNotify (Line 272, "JclHookExcept.pas" + 5) + $1D [00000000008F5793] JclHookExcept.DoExceptNotify (Line 347, "JclHookExcept.pas" + 21) + $2B [00000000008F5890] JclHookExcept.HookedRaiseException (Line 381, "JclHookExcept.pas" + 14) + $0 [0000000000410EE3] System.@RaiseAtExcept (Line 22019, "System.pas" + 32) + $0 [0000000000410F01] System.@RaiseExcept (Line 22108, "System.pas" + 2) + $0 [000000000095CAD1] IdStack.TIdStack.RaiseSocketError (Line 976, "IdStack.pas" + 54) + $0 [000000000095CA61] IdStack.TIdStack.RaiseLastSocketError (Line 900, "IdStack.pas" + 2) + $0 [000000000095C98E] IdStack.TIdStack.CheckForSocketError (Line 875, "IdStack.pas" + 4) + $0 [00000000009568E2] IdStackWindows.TIdStackWindows.Connect (Line 2072, "IdStackWindows.pas" + 21) + $0 [000000000099BE3B] IdSocketHandle.TIdSocketHandle.Connect (Line 296, "IdSocketHandle.pas" + 2) + $0 [00000000009A1763] IdIOHandlerStack.TIdConnectThread.Execute (Line 488, "IdIOHandlerStack.pas" + 2) + $11 [000000000054E4A3] System.Classes.ThreadProc (Line 15573, "System.Classes.pas" + 18) + $E [0000000000411A1D] System.ThreadWrapper (Line 25380, "System.pas" + 9) + $7 [00007FFC6CC67034] BaseThreadInitThunk + $14 [00007FFC6CE02651] RtlUserThreadStart + $21

Delphi: 10.3 Version 26.0.36039.7899 This code generates a memory at the first call to SetLength: A memory block has been leaked. The size is: 519 This block was allocated by thread 0x2010, and the stack trace (return addresses) at the time was: 00420A36 [FastMM5.pas][FastMM5][FastMM_DebugGetMem][7718] 006E43A7 [uMemory.pas][uMemory][NewAllocMem][88] 00407441 [System.pas][System][@ReallocMem][5022] 0040DB51 [System.pas][System][DynArraySetLength][36046] 0040B09C [System.pas][System][@LStrFromPWCharLen][26213] 0040DC92 [System.pas][System][@DynArraySetLength][36150] 00811B23 [uCommon.pas][uCommon][Mime64Decode][3729] 00928D49 [uXMLSec.pas][uXMLSec][NodeGetBase64Value][311] 0092B828 [uXMLSec.pas][uXMLSec][VerifyNode][893] 0092C0D4 [uXMLSec.pas][uXMLSec][TXMLSec.Verify][1006] 00D43D7A [Main.pas][Main][TMainForm.UpdateAttachmentsAndSignatures][298] 00D44784 [Main.pas][Main][TMainForm.LoadFile][427] 00D44886 [Main.pas][Main][TMainForm.BtnOpenClick][443] 00578075 [Vcl.Controls.pas][Vcl.Controls][TControl.Click][7536] 0059B84F [Vcl.StdCtrls.pas][Vcl.StdCtrls][TCustomButton.Click][5470] 0059C365 [Vcl.StdCtrls.pas][Vcl.StdCtrls][TCustomButton.CNCommand][5931] 00577B19 [Vcl.Controls.pas][Vcl.Controls][TControl.WndProc][7420] 75FD5E7A [Unknown function at GetClassLongW] 75FD60BF [Unknown function at GetClassLongW] 75FD5EBC [Unknown function at GetClassLongW] function Mime64Decode(const Encoded:string):TBytes; var InLen , OutLen : NativeUInt; Raw : RawByteString; begin Raw := RawByteString(Encoded); InLen := Length(Encoded); OutLen := 0; if InLen>0 then begin OutLen := MimeDecodedSize(InLen); SetLength(Result,OutLen); try OutLen := MimeDecode(Raw[1],InLen,Result[0]); except OutLen := 0; end; end; SetLength(Result,OutLen); end; Is there any alternative to allocate memory to TBytes? Best regards.

Yes.

The leak is generated by a bad usage of SSL routine. The result of Base64Decode (TBytes=Blob) is passed to d2i_OCSP_RESPONSE as a Pointer not double Pointer PPointer. Bad: PBlob := Blob; resp := d2i_OCSP_RESPONSE(nil,@PBlob,Length(Blob)); Correct: PBlob := @Blob; resp := d2i_OCSP_RESPONSE(nil,@PBlob,Length(Blob)); Thus, the content of TBytes is modified by changing it's prefix (RefCnt, Length, ...) not by reallocating it. Sorry for the inconvenience.

The leak is generated by a bad usage of SSL routine. The result of Base64Decode (TBytes=Blob) is passed to d2i_OCSP_RESPONSE as a Pointer not double Pointer PPointer. Bad: PBlob := Blob; resp := d2i_OCSP_RESPONSE(nil,@PBlob,Length(Blob)); Correct: PBlob := @Blob; resp := d2i_OCSP_RESPONSE(nil,@PBlob,Length(Blob)); Best regards.

I guess that is a Reallocation problem! The code changed to: SetLength(Result,0); SetLength(Result,OutLen); solved the problem. But it's at a higher risk: Result content would be lost when setting length to 0.

Hello, Is there a function GetBaseType which returns the Base Type of a sub-type? type TCustomDateTime = type TDateTime; GetBaseType(TypeInfo(TCustomDateTime)) would return TypeInfo(TDateTime). Best regards.

Using SSL libraries version 1.0.2u, EAccessViolation is raised. Code used for connection: procedure TTCPClient.Connect; var LConfig : TTCPConfig; begin Lock; LConfig := FConfig; Unlock; if LConfig.HostOrIP='' then Exit; Disconnect; try inherited Host := LConfig.HostOrIP; inherited Port := LConfig.Port except end; if LConfig.SSLEnabled then IOHandler := FSSLHandler else IOHandler := nil; try inherited Connect; except on E: Exception do HandleException(E); end; end; =============================================================================== Application Name : PGFClient.exe Memory manager : msvcrt.dll Compiler Version : Delphi: 33 Indy Version : 10.6.2.0 Zeos Version : 7.2.6-stable Report Unique ID : {4C789C3C-712A-4FE7-B68B-73FF6B4160F1} Start Time : 2020-06-07 23:33:47.688 Exception Time : 2020-06-07 23:34:19.770 Application up time : 32 seconds 82 milliseconds =============================================================================== Processor : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz System : Windows 10 (Version 10.0, Build 18362, 64-bit Edition) Display : 1680x1050 pixels, 96 bpp Total Physical Memory : 5.748 GB Free Physical Memory : 1.092 GB Max used Memory : 176.047 MB =============================================================================== Exception class : EAccessViolation Access violation at address 007D7E14 in module 'PGFClient.exe'. Read of address 0000000C ------------------------------------------------------------------------------- Module : IdSSLOpenSSL Command Line : D:\Applications-Folder\PGFClient\PGFClient.exe Procedure : IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.SetPassThrough Unit : IdSSLOpenSSL.pas Line : 2889 ------------------------------------------------------------------------------- [007D7E14] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.SetPassThrough (Line 2889, "IdSSLOpenSSL.pas" + 36) + $1F [00795019] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1737, "IdIOHandler.pas" + 62) + $1 [0079B436] IdIOHandlerStack.DoConnectTimeout (Line 329, "IdIOHandlerStack.pas" + 76) + $2C [007A13DA] IdTCPConnection.TIdTCPConnection.DoOnDisconnected (Line 584, "IdTCPConnection.pas" + 1) + $6 [007DEFE0] uTCP.TTCPClient.Connect (Line 1694, "uTCP.pas" + 13) + $A [00B29D32] uAsyncTCP.TTCPAsyncThread.Execute (Line 421, "uAsyncTCP.pas" + 21) + $0 [00B2AC95] uAsyncTCP.TTCPAsyncClient.Disconnect (Line 842, "uAsyncTCP.pas" + 5) + $3 [00DE877E] uClient.TMainForm.ControllerStart (Line 1781, "uClient.pas" + 68) + $1B [00BC5DBD] uMainForm.TUForm.Destroy (Line 1304, "uMainForm.pas" + 9) + $8 [00BC65EE] uMainForm.TUForm.WndProc (Line 1554, "uMainForm.pas" + 38) + $22 [0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C [004DDDDC] System.Classes.StdWndProc + $14 [0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3 [006760B2] Vcl.Forms.TApplication.HandleMessage + $A [006763E5] Vcl.Forms.TApplication.Run + $C9 [00E2C32D] PGFClient.PGFClient (Line 19, "" + -934) + $7

Exceptions are raised if Connected function is called before a connection attempt is made using Connect method. the variable FConnectionAttempt is introduced and initialized to False within the overridden InitComponent method: procedure TTCPClient.InitComponent; begin LoadOpenSSL; InitRecord(FConfig,SizeOf(FConfig)); inherited; FConnectionAttempt := False; IOHandler := nil; FCS := TTCPLock.Create(ClassName); Tagged := False; CompressClass := nil; FSSLHandler := TSSLIOClient.Create(Self); FPeerCertificate := ''; FCommonName := ''; FBound := False; FOnConnect := nil; FOnVerify := nil; FOnDisconnect := nil; OnConnected := nil; OnDisconnected := nil; Timeout := IdTimeoutDefault; Ciphers := 'DEFAULT'; SSLEnabled := False; end; function TTCPClient.Connected:Boolean; begin if (not FConnectionAttempt) then Exit(False); try Result := (inherited Connected); except Result := False; end; end; procedure TTCPClient.Connect; var LConfig : TTCPConfig; begin Lock; LConfig := FConfig; Unlock; if LConfig.HostOrIP='' then Exit; Disconnect; try inherited Host := LConfig.HostOrIP; inherited Port := LConfig.Port except end; if LConfig.SSLEnabled then IOHandler := FSSLHandler else IOHandler := nil; try inherited Connect; except on E: Exception do HandleException(E); end; FConnectionAttempt := True; end; It seams that calling Connected function before invoking Connect method generates an access to components/objects not already initialized (fSSLSocket and/or fSSL). After modification made, no exception is raised.

Now the exception is raised inside OpenSSL libraries (libeay32.dll) EC_GROUP_get_degree: =============================================================================== Application Name : PGFClient.exe Memory manager : msvcrt.dll Compiler Version : Delphi: 33 Indy Version : 10.6.2.0 Zeos Version : 7.2.6-stable Report Unique ID : {17CF23EB-3608-40C5-B1F7-3EB94BA7BA55} Start Time : 2020-06-10 21:15:28.616 Exception Time : 2020-06-10 21:16:06.970 Application up time : 38 seconds 354 milliseconds =============================================================================== Processor : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz System : Windows 10 (Version 10.0, Build 18362, 64-bit Edition) Display : 1680x1050 pixels, 96 bpp Total Physical Memory : 5.748 GB Free Physical Memory : 1.553 GB Max used Memory : 180.152 MB =============================================================================== Exception class : EAccessViolation Access violation at address 62A56256 in module 'libeay32.dll'. Read of address FEEEFF0E Exception trigger : UnhandledException ------------------------------------------------------------------------------- Module : Command Line : D:\Applications-Folder\PGFClient\PGFClient.exe Procedure : EC_GROUP_get_degree ------------------------------------------------------------------------------- [62A56256] EC_GROUP_get_degree + $6 [00554DEB] System.SyncObjs.TCriticalSection.Release + $B [007D6C49] IdSSLOpenSSL.SslLockingCallback (Line 2249, "IdSSLOpenSSL.pas" + 16) + $5 [00409A5C] System.TMonitor.Enter + $10 [00409F34] System.TMonitor.TryEnter + $28 [00409BEA] System.TMonitor.Exit + $6 [007D9E51] IdSSLOpenSSL.TIdSSLSocket.Connect (Line 3782, "IdSSLOpenSSL.pas" + 36) + $B [007D85BE] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.OpenEncodedConnection (Line 3091, "IdSSLOpenSSL.pas" + 54) + $13 [007D7EDE] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.StartSSL (Line 2819, "IdSSLOpenSSL.pas" + 2) + $2 [007D7EC1] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.ConnectClient (Line 2813, "IdSSLOpenSSL.pas" + 23) + $5 [0079F12A] IdIOHandlerSocket.TIdIOHandlerSocket.Open (Line 369, "IdIOHandlerSocket.pas" + 13) + $4 [007D7F56] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Open (Line 2839, "IdSSLOpenSSL.pas" + 2) + $0 [0079AB5C] IdTCPClient.TIdTCPClientCustom.Connect (Line 328, "IdTCPClient.pas" + 54) + $B [0079596D] IdIOHandler.TIdIOHandler.SetHost (Line 1958, "IdIOHandler.pas" + 1) + $8 [007DF1FF] uTCP.TTCPClient.Connect (Line 1699, "uTCP.pas" + 14) + $3 [00B2ACB1] uAsyncTCP.TTCPAsyncClient.Connect (Line 774, "uAsyncTCP.pas" + 8) + $4 [00B29FF4] uAsyncTCP.TTCPAsyncThread.Execute (Line 442, "uAsyncTCP.pas" + 42) + $6 [004DA455] System.Classes.ThreadProc + $49 [0040ADAC] System.ThreadWrapper + $28

The function Readable is overridden to avoid exception. type TIdSSLSocketWrapper=class(TIdSSLSocket); function TSSLIOClient.Readable(AMSec:Integer):Boolean; var IdSSLSocketWrapper : TIdSSLSocketWrapper; begin IdSSLSocketWrapper := TIdSSLSocketWrapper(fSSLSocket); Result := Assigned(IdSSLSocketWrapper) and Assigned(IdSSLSocketWrapper.fSSL); Result := Result and inherited; end;

This TCP Client Wrapper is used for connecting to the server: type TTCPClientNotify = procedure(Client:TTCPClient) of object; TTCPClientVerify = function(Client:TTCPClient;const Certificate:string):Boolean of object; TSSLOptions=class private FP12 : TBytes; FKeyPassword : string; FPEMCert , FPEMKey : string; FCiphers : string; public constructor Create; property P12 : TBytes read FP12 write FP12; property KeyPassword : string read FKeyPassword write FKeyPassword; property Ciphers : string read FCiphers write FCiphers; end; TSSLIOClient = class(TIdSSLIOHandlerSocketOpenSSL) private FSSLOptions : TSSLOptions; FCACert : PX509; FCert : PX509; FPrivateKey : PEVP_PKEY; procedure InitSSLContext; property PassThrough; function GetPeerCert:string; function GetPeerCommonName:string; protected procedure InitComponent;override; public destructor Destroy;override; property SSLOptions:TSSLOptions read FSSLOptions write FSSLOptions; procedure StartSSL;override; property PeerCert : string read GetPeerCert; property PeerCommonName : string read GetPeerCommonName; end; TTCPConfig= packed record HostOrIP : string; Port : Integer; Tagged : Boolean; MaxConnections : Word; Timeout : Integer; P12 : TBytes; KeyPassword : string; Ciphers : string; SSLEnabled : Boolean; LinkCheckInterval : Integer; end; TTCPClient=class(TIdTCPClient) strict private property OnConnected; property OnDisconnected; private var FCS : TTCPLock; FSSLHandler : TSSLIOClient; FPeerCertificate : string; FCommonName : string; FConfig : TTCPConfig; FLastError : Integer; FLastErrorDesc : string; FBound : Boolean; FOnConnect : TTCPClientNotify; FOnVerify : TTCPClientVerify; FOnDisconnect : TTCPClientNotify; procedure ClearErrors; procedure SetHostOrIP(Value:string); procedure SetRemotePort(Value:Integer); procedure SetTagged(Value:Boolean); procedure SetTimeout(Value:Integer); procedure SetP12(Value:TBytes); procedure SetKeyPassword(Value:string); procedure SetCiphers(Value:string); procedure SetSSLEnabled(Value:Boolean); function GetPeerInfo(Index:Integer):string; procedure HandleException(AException:Exception); procedure SetBound(Value:Boolean); protected procedure InitComponent;override; procedure DoOnConnected;override; procedure DoOnDisconnected;override; function DoOnVerify(const PEMCert:string):Boolean;virtual; public Destructor Destroy;override; procedure Lock; procedure Unlock; public property Host : string read FConfig.HostOrIP write SetHostOrIP; property Port : Integer read FConfig.Port write SetRemotePort; property Tagged : Boolean read FConfig.Tagged write SetTagged; property Timeout : Integer read FConfig.Timeout write SetTimeout; property P12 : TBytes read FConfig.P12 write SetP12; property KeyPassword : string read FConfig.KeyPassword write SetKeyPassword; property Ciphers : string read FConfig.Ciphers write SetCiphers; property SSLEnabled : Boolean read FConfig.SSLEnabled write SetSSLEnabled; procedure SetError(ErrorCode:Integer;ErrorDesc:string); procedure AssignConfig(Config:TTCPConfig); procedure Connect;overload;override; procedure Connect(const AHost:string;const APort:Integer);reintroduce;overload; procedure Reconnect; procedure Disconnect(ANotifyPeer:Boolean);override; function Connected:Boolean;override; property Bound : Boolean read FBound write SetBound; public property LastError : Integer read FLastError; property LastErrorDesc : string read FLastErrorDesc; property PeerCertificate : string index 1 read GetPeerInfo; property CommonName : string index 2 read GetPeerInfo; public property OnConnect : TTCPClientNotify read FOnConnect write FOnConnect; property OnVerify : TTCPClientVerify read FOnVerify write FOnVerify; property OnDisconnect : TTCPClientNotify read FOnDisconnect write FOnDisconnect; end; implementation procedure HandleSocketException(E:Exception;var SocketError:Integer); begin if E=nil then SocketError := 0 else begin SocketError := WSANO_RECOVERY; if (E is EIdSocketError) then SocketError := (E as EIdSocketError).LastError else if (E is EIdOpenSSLError) then SocketError := Id_WSAENOPROTOOPT else if (E is EIdReadTimeout) then SocketError := Id_WSAETIMEDOUT else if (E is EIdConnClosedGracefully) then SocketError := Id_WSAEHOSTDOWN else if (E is EIdAlreadyConnected) then SocketError := Id_WSAEISCONN ; end; end; /////////////////////////////////////////////////////////////////////////// constructor TSSLOptions.Create; begin LoadOpenSSL; FP12 := nil; FKeyPassword := ''; FPEMCert := ''; FPEMKey := ''; FCiphers := ''; end; /////////////////////////////////////////////////////////////////////////// function VerifyCallback(ok:TIdC_INT;ctx:PX509_STORE_CTX):TIdC_INT;cdecl; begin Result := 1; end; function TSSLIOClient.GetPeerCert: string; begin if Assigned(fSSLSocket) and Assigned(fSSLSocket.PeerCert) then Result := TCPX509ToPEM(fSSLSocket.PeerCert.Certificate) else Result := ''; end; function TSSLIOClient.GetPeerCommonName:string; begin if Assigned(fSSLSocket) and Assigned(fSSLSocket.PeerCert) then Result := TCPX509Name(fSSLSocket.PeerCert.Certificate) else Result := ''; end; procedure TSSLIOClient.InitComponent; begin LoadOpenSSL; inherited; FCACert := nil; FCert := nil; FPrivateKey := nil; FSSLOptions := TSSLOptions.Create; FSSLOptions.FCiphers := SSLClientCiphers; PassThrough := False; end; destructor TSSLIOClient.Destroy; begin Close; if FCACert <>nil then X509_free(FCACert); if FCert <>nil then X509_free(FCert); if FPrivateKey<>nil then EVP_PKEY_free(FPrivateKey); FreeAndNil(FSSLOptions); inherited; end; type TTCPSSLContext = class(TIdSSLContext) public constructor Create; end; constructor TTCPSSLContext.Create; const SSLVersion = High(TIdSSLVersion); begin inherited; RootCertFile := ''; CertFile := ''; KeyFile := ''; DHParamsFile := ''; VerifyDepth := 0; VerifyMode := []; VerifyDirs := ''; CipherList := ''; VerifyOn := False; StatusInfoOn := False; Method := sslvSSLv23; SSLVersions := [SSLVersion,Pred(SSLVersion)]; end; procedure TSSLIOClient.InitSSLContext; begin if Assigned(fSSLContext) then FreeAndNil(fSSLContext); fSSLContext := TTCPSSLContext.Create; fSSLContext.Parent := Self; fSSLContext.StatusInfoOn := Assigned(fOnStatusInfo) or Assigned(fOnStatusInfoEx); fSSLContext.Mode := sslmClient; TTCPSSLContext(fSSLContext).InitContext(sslCtxClient); end; procedure TSSLIOClient.StartSSL; var Error : Integer; FSSLCtx : PSSL_CTX; begin InitSSLContext; FSSLCtx := TTCPSSLContext(fSSLContext).fContext; Error := SSL_CTX_set_options(FSSLCtx,SSL_OP_STRONG); if Error>0 then begin SSL_CTX_set_mode(FSSLCtx,SSL_MODE_AUTO_RETRY); PrepareSSL(FSSLOptions,FCACert,FCert,FPrivateKey); if Assigned(FPrivateKey) and Assigned(FCACert) and Assigned(FCert) then begin if Error>0 then Error := SSL_CTX_use_certificate(FSSLCtx,FCert); if Error>0 then Error := SSL_CTX_use_PrivateKey(FSSLCtx,FPrivateKey); if Error>0 then Error := SSL_CTX_check_private_key(FSSLCtx); end; SSL_CTX_set_verify(FSSLCtx,SSL_VERIFY_PEER,VerifyCallback); SSL_CTX_set_verify_depth(FSSLCtx,1); if Error>0 then Error := SSL_CTX_ctrl(FSSLCtx,SSL_CTRL_SET_ECDH_AUTO,1,nil); if (Error>0) and (FSSLOptions.FCiphers<>'') then begin Error := SSL_CTX_set_cipher_list(FSSLCtx,PAnsiChar(RawByteString(FSSLOptions.FCiphers))); end; end; if Error<=0 then begin FreeAndNil(fSSLContext); EIdOSSLCreatingContextError.RaiseException(RSSSLCreatingContextError); end; inherited; end; /////////////////////////////////////////////////////////////////////////// procedure TTCPClient.InitComponent; begin LoadOpenSSL; InitRecord(FConfig,SizeOf(FConfig)); inherited; FCS := TTCPLock.Create(ClassName); Tagged := False; FSSLHandler := TSSLIOClient.Create(Self); FPeerCertificate := ''; FCommonName := ''; FBound := False; FOnConnect := nil; FOnVerify := nil; FOnDisconnect := nil; OnConnected := nil; OnDisconnected := nil; Timeout := IdTimeoutDefault; Ciphers := 'DEFAULT'; SSLEnabled := False; end; procedure TTCPClient.Lock; begin FCS.Lock; end; procedure TTCPClient.Unlock; begin FCS.Unlock; end; procedure TTCPClient.SetHostOrIP(Value: string); var _Port : Integer; _Params : string; begin Value := ParseURI(Trim(Value),0,_Port,_Params); if (FConfig.HostOrIP=Value) and (FConfig.Port=_Port) then Exit; Lock; FConfig.HostOrIP := Value; if _Port>0 then FConfig.Port := _Port; Unlock; end; procedure TTCPClient.SetRemotePort(Value: Integer); begin if FConfig.Port=Value then Exit; Lock; FConfig.Port := Value; Unlock; end; procedure TTCPClient.SetTagged(Value:Boolean); begin if FConfig.Tagged=Value then Exit; if Connected then raise TCPException.Create('Tagged can only be set when connection is closed !...'); Lock; FConfig.Tagged := Value; Unlock; end; procedure TTCPClient.SetTimeout(Value:Integer); begin if Value<=0 then Value := IdTimeoutDefault; if FConfig.Timeout=Value then Exit; Lock; FConfig.Timeout := Value; ReadTimeout := TimeoutMS(FConfig.Timeout); Unlock; end; procedure TTCPClient.SetP12(Value:TBytes); begin if Similar(Value,FConfig.P12) then Exit; Lock; FConfig.P12 := Value; Unlock; end; procedure TTCPClient.SetKeyPassword(Value: string); begin Value := Trim(Value); if FConfig.KeyPassword=Value then Exit; Lock; FConfig.KeyPassword := Value; Unlock; end; procedure TTCPClient.SetCiphers(Value: string); begin Value := Trim(Value); if FConfig.Ciphers=Value then Exit; Lock; FConfig.Ciphers := Value; Unlock; end; procedure TTCPClient.SetSSLEnabled(Value:Boolean); begin if FConfig.SSLEnabled=Value then Exit; Lock; FConfig.SSLEnabled := Value; Unlock; end; destructor TTCPClient.Destroy; begin Disconnect; FreeAndNil(FCS); inherited; end; function TTCPClient.DoOnVerify(const PEMCert:string):Boolean; begin if Assigned(FOnVerify) then Result := FOnVerify(Self,PEMCert) else Result := True; end; procedure TTCPClient.DoOnConnected; begin inherited; Socket.Binding.SetKeepAliveValues(True,KeepAliveDefault,KeepAliveIntervalDefault); if Assigned(FSSLHandler) then begin FPeerCertificate := FSSLHandler.PeerCert; FCommonName := FSSLHandler.PeerCommonName; end else begin FPeerCertificate := ''; FCommonName := ''; end; if DoOnVerify(FPeerCertificate) then begin if Assigned(FOnConnect) then FOnConnect(Self); if Assigned(FCompressor) then FCompressor.FActive := True; end else Disconnect; end; procedure TTCPClient.SetBound(Value:Boolean); begin Lock; FBound := Value; Unlock; end; procedure TTCPClient.DoOnDisconnected; begin inherited; if Assigned(FOnDisconnect) then FOnDisconnect(Self); end; function TTCPClient.GetPeerInfo(Index:Integer): string; begin case Index of 1 : Result := FPeerCertificate; 2 : Result := FCommonName; end; end; procedure TTCPClient.AssignConfig(Config:TTCPConfig); begin FConfig.HostOrIP := Config.HostOrIP; FConfig.Port := Config.Port; FConfig.Tagged := Config.Tagged; FConfig.Timeout := Config.Timeout; FConfig.P12 := Config.P12; FConfig.KeyPassword := Config.KeyPassword; FConfig.Ciphers := Config.Ciphers; FConfig.SSLEnabled := Config.SSLEnabled; FConfig.LinkCheckInterval := Config.LinkCheckInterval; end; procedure TTCPClient.HandleException(AException: Exception); begin inherited; HandleSocketException(AException,FLastError); Lock; FLastErrorDesc := AException.Message; Unlock; end; procedure TTCPClient.ClearErrors; begin Lock; FLastError := 0; FLastErrorDesc := ''; Unlock; end; procedure TTCPClient.SetError(ErrorCode:Integer;ErrorDesc: string); begin Lock; FLastError := ErrorCode; FLastErrorDesc := ErrorDesc; Unlock; end; function TTCPClient.Connected: Boolean; begin try Result := (inherited Connected); except Result := False; end; end; procedure TTCPClient.Disconnect(ANotifyPeer:Boolean); begin try inherited Disconnect(ANotifyPeer); except end; end; procedure TTCPClient.Connect; var LConfig : TTCPConfig; begin Lock; LConfig := FConfig; Unlock; if LConfig.HostOrIP='' then Exit; Disconnect; try inherited Host := LConfig.HostOrIP; inherited Port := LConfig.Port except end; if LConfig.SSLEnabled then IOHandler := FSSLHandler else IOHandler := nil; try inherited Connect; except on E: Exception do HandleException(E); end; end; procedure TTCPClient.Connect(const AHost:string;const APort:Integer); begin SetHostOrIP(AHost); SetRemotePort(APort); Connect; end; procedure TTCPClient.Reconnect; begin Connect; end; /////////////////////////////////////////////////////////////////////////// TTCPClient connection is invoked from a the Thread Pool: function TTCPAsyncClient.Connect(Client:TTCPClient):Boolean; begin if FTerminated then Exit(False); Client.AssignConfig(FConfig); Client.Bound := False; if Client.Connected then Client.Disconnect; Result := False; if Client.Host<>'' then begin Client.Connect; Result := Client.Connected; end; end; But this exception is raised: =============================================================================== Application Name : PGFClient.exe Memory manager : msvcrt.dll Compiler Version : Delphi: 33 Indy Version : 10.6.2.0 Zeos Version : 7.2.6-stable Report Unique ID : {E824D1A9-DCC4-4F71-ADC7-0882AB6D23DD} Start Time : 2020-06-10 20:05:08.588 Exception Time : 2020-06-10 20:05:58.583 Application up time : 49 seconds 995 milliseconds =============================================================================== Processor : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz System : Windows 10 (Version 10.0, Build 18362, 64-bit Edition) Display : 1680x1050 pixels, 96 bpp Total Physical Memory : 5.748 GB Free Physical Memory : 1.772 GB Max used Memory : 174.250 MB =============================================================================== Exception class : EAccessViolation Access violation at address 007D7F78 in module 'PGFClient.exe'. Read of address 0000000C Exception trigger : UnhandledException ------------------------------------------------------------------------------- Module : IdSSLOpenSSL Command Line : D:\Applications-Folder\PGFClient\PGFClient.exe Procedure : IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Readable Unit : IdSSLOpenSSL.pas Line : 2846 ------------------------------------------------------------------------------- [007D7F78] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.Readable (Line 2846, "IdSSLOpenSSL.pas" + 3) + $6 [00620030] Vcl.Themes.{System.Generics.Collections}TList<Vcl.Themes.TStyleHookClass>.GetCapacity + $8 [0079517D] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1696, "IdIOHandler.pas" + 21) + $8 [0079B59A] IdIOHandlerStack.TIdIOHandlerStack.Connected (Line 243, "IdIOHandlerStack.pas" + 1) + $8 [007A153E] IdTCPConnection.TIdTCPConnection.Connected (Line 503, "IdTCPConnection.pas" + 7) + $4 [007DF064] uTCP.TTCPClient.Connected (Line 1653, "uTCP.pas" + 2) + $0 [00B29DAA] uAsyncTCP.TTCPAsyncThread.Connected (Line 383, "uAsyncTCP.pas" + 1) + $B [00B2AD19] uAsyncTCP.TTCPAsyncClient.Connect (Line 803, "uAsyncTCP.pas" + 14) + $7 [00DE881E] uClient.TMainForm.ControllerStart (Line 1760, "uClient.pas" + 47) + $9 [00BC5E71] uMainForm.TUForm.SafeActivate (Line 1288, "uMainForm.pas" + 10) + $14 [00BC66A6] uMainForm.TUForm.WndProc (Line 1521, "uMainForm.pas" + 5) + $3 [0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C [004DDDDC] System.Classes.StdWndProc + $14 [0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3 [006760B2] Vcl.Forms.TApplication.HandleMessage + $A [006763E5] Vcl.Forms.TApplication.Run + $C9 [00E2C32D] PGFClient.PGFClient (Line 18, "" + -935) + $7

Please find the exception raised at the form creation and not at it's shutdown. =============================================================================== Application Name : PGFClient.exe Memory manager : msvcrt.dll Compiler Version : Delphi: 33 Indy Version : 10.6.2.0 Zeos Version : 7.2.6-stable Report Unique ID : {44B4A782-BEAF-4AB4-AEAC-5863139C89AC} Start Time : 2020-06-09 22:42:32.370 Exception Time : 2020-06-09 22:43:08.037 Application up time : 35 seconds 667 milliseconds =============================================================================== Processor : eMachines, eMachines G640, AMD64 Family 16 Model 6 Stepping 3, AMD Athlon(tm) II P320 Dual-Core Processor, 2.095 GHz System : Windows 10 (Version 10.0, Build 18362, 64-bit Edition) Display : 1680x1050 pixels, 96 bpp Total Physical Memory : 5.748 GB Free Physical Memory : 2.211 GB Max used Memory : 179.254 MB =============================================================================== Exception class : EAccessViolation Access violation at address 007D98E8 in module 'PGFClient.exe'. Read of address 0000000C Exception trigger : UnhandledException ------------------------------------------------------------------------------- Module : IdSSLOpenSSL Command Line : D:\Applications-Folder\PGFClient\PGFClient.exe Procedure : IdSSLOpenSSL.TIdSSLSocket.GetSSLError Unit : IdSSLOpenSSL.pas Line : 3647 ------------------------------------------------------------------------------- [007D98E8] IdSSLOpenSSL.TIdSSLSocket.GetSSLError (Line 3647, "IdSSLOpenSSL.pas" + 5) + $1 [007D87F4] IdSSLOpenSSL.TIdSSLIOHandlerSocketOpenSSL.CheckForError (Line 3134, "IdSSLOpenSSL.pas" + 4) + $8 [007952C0] IdIOHandler.TIdIOHandler.ReadFromSource (Line 1737, "IdIOHandler.pas" + 62) + $8 [0079B59A] IdIOHandlerStack.TIdIOHandlerStack.Connected (Line 243, "IdIOHandlerStack.pas" + 1) + $8 [007A153E] IdTCPConnection.TIdTCPConnection.Connected (Line 503, "IdTCPConnection.pas" + 7) + $4 [007DF0EE] uTCP.TTCPClient.Connected (Line 1664, "uTCP.pas" + 7) + $0 [00B29E3E] uAsyncTCP.TTCPAsyncThread.Connected (Line 383, "uAsyncTCP.pas" + 1) + $B [00B2ADAD] uAsyncTCP.TTCPAsyncClient.Connect (Line 803, "uAsyncTCP.pas" + 14) + $7 [00DE888E] uClient.TMainForm.ControllerStart (Line 1760, "uClient.pas" + 47) + $9 [00BC5ECD] uMainForm.TUForm.SafeActivate (Line 1287, "uMainForm.pas" + 10) + $14 [00BC66FE] uMainForm.TUForm.WndProc (Line 1520, "uMainForm.pas" + 5) + $3 [0057980C] Vcl.Controls.TWinControl.MainWndProc + $2C [004DDDDC] System.Classes.StdWndProc + $14 [0067606F] Vcl.Forms.TApplication.ProcessMessage + $F3 [006760B2] Vcl.Forms.TApplication.HandleMessage + $A [006763E5] Vcl.Forms.TApplication.Run + $C9 [00E2C32D] PGFClient.PGFClient (Line 18, "" + -935) + $7 Would the creation of the the client into a thread be the problem? type TTCPAsyncWorker=class(TTCPClient) private end; //////////////////////////////////////////////////////////////////////// function TTCPAsyncClient.Connect(Client:TTCPClient):Boolean; begin if FTerminated then Exit(False); Client.AssignConfig(FConfig); Client.Bound := False; if Client.Connected then Client.Disconnect; Result := False; if Client.Host<>'' then begin Client.Connect; Result := Client.Connected; end; end; //////////////////////////////////////////////////////////////////////// procedure TTCPAsyncThread.Execute; var TCPHandler : TTCPHandler; Data , Pattern : TBytes; begin inherited; COMInitialize; InitRecord(TCPHandler,SizeOf(TCPHandler)); FWorker := TTCPAsyncWorker.Create(nil); TCPHandler.Worker := FWorker; FWorker.SSLEnabled := FAsyncClient.SSLEnabled; FWorker.Timeout := IdTimeoutDefault; FWorker.OnConnect := FAsyncClient.DoOnConnect; FWorker.OnDisconnect := FAsyncClient.DoOnDisconnect; FStarted := True; while (not FAsyncClient.FTerminated) do begin RelinquishTimeSlice(20); if FAsyncClient.FTerminated then Break; if (FAsyncClient.Host='') or (FAsyncClient.Port=0) then Continue; while FWorker.Bound do begin if FAsyncClient.Tagged then begin TCPHandler.Data := FWorker.Read(TCPHandler.AsyncTag); if TCPHandler.Data=nil then begin RelinquishTimeSlice; Break; end; ProcessTagRead(TCPHandler); end else begin if (not FAsyncClient.DoOnWaitForData(TCPHandler,Data,Pattern)) then begin Disconnect; Break; end; MatchData(Data,Pattern); end; end; if FAsyncClient.FTerminated then Break; if (not Connected) then begin if FWorker.LastError<>0 then FAsyncClient.DoOnDisconnect(FWorker); FAsyncClient.Connect(FWorker); end; end; COMUninitialize; FreeAndNil(FWorker); end; Best regards.

Thank you Remy, Indeed, the exception is raised because the function Connected is called before the FSSLHandler is assigned to IOHandler so fSSLSocket and/or fSSL not assigned too. function TIdSSLIOHandlerSocketOpenSSL.Readable(AMSec: Integer = IdTimeoutDefault): Boolean; begin if not fPassThrough then begin Result := ssl_pending(fSSLSocket.fSSL) > 0; if Result then Exit; end; Result := inherited Readable(AMSec); end;