Jump to content

Hafedh TRIMECHE

Members
  • Content Count

    24
  • Joined

  • Last visited

Community Reputation

1 Neutral

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. Hafedh TRIMECHE

    Disable control resizing at design time.

    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.
  2. Hafedh TRIMECHE

    Prevent OnClick to be handled twice

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

    Prevent OnClick to be handled twice

    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.
  4. Hafedh TRIMECHE

    Prevent OnClick to be handled twice

    The Event handler must resume execution.
  5. Hafedh TRIMECHE

    Prevent OnClick to be handled twice

    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.
  6. Hafedh TRIMECHE

    Prevent OnClick to be handled twice

    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;
  7. Hafedh TRIMECHE

    Prevent OnClick to be handled twice

    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.
  8. Hafedh TRIMECHE

    Check port in use exception

    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
  9. Hafedh TRIMECHE

    SetLength TBytes Memory Leak

    Yes.
  10. Hafedh TRIMECHE

    SetLength TBytes Memory Leak

    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.
  11. Hafedh TRIMECHE

    SetLength TBytes Memory Leak

    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.
  12. Hafedh TRIMECHE

    SetLength TBytes Memory Leak

    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.
  13. 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.
  14. Hafedh TRIMECHE

    Base (Root) RTTI Type

    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.
  15. Hafedh TRIMECHE

    Access Violation setting Passthrough (10.6.2.0)

    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.
×