PeterBelow
Members-
Content Count
508 -
Joined
-
Last visited
-
Days Won
13
Everything posted by PeterBelow
-
Experience/opinions on FastMM5
PeterBelow replied to Leif Uneus's topic in RTL and Delphi Object Pascal
What's so shocking about these numbers? -
Delphi 11.1 Crash on Search Menu Access
PeterBelow replied to MathewV's topic in Delphi IDE and APIs
Works fine for me as well, D11.1 on Win10. Does your source file use an encoding other than ANSI? -
If you don't use a full path the program will look for the file in whatever it considers to be the "current directory" at the moment. That can depend on many things, e.g. on how you start the program, and it can even change during the program run, e.g. by using a file dialog. If you do want to keep your sanity (and control of the situation) always use full pathes. A program should use a specific folder for its files, e.g. one created under TPath.GetDocumentsPath or TPath.GetHomePath.
-
Can someone provide inbound and outbound ports used by IDE?
PeterBelow replied to Stéphane Wierzbicki's topic in Delphi IDE and APIs
I had to do that at work (before retirement a couple of years ago) since the web installer was unable towork through our firewall. Just downloading the ISO and running the installer from that worked for me. -
That would be the equivalent of a Delphi Single. Use the good old Move procedure to copy the 4 bytes to a Single variable and pass that to FormatFloat to get a string representation.
-
Identify "reference to procedure"
PeterBelow replied to chkaufmann's topic in RTL and Delphi Object Pascal
If I understand this correctly a "reference to procedure" type is implemented by the compiler as a hidden class with an interface that contains the actual method called when the referenced method is called through this reference. On the point where you pass the reference the compiler creates an instance of the class and uses it to store all captured variables the method refers to. In your case that happens two times, at the point where you call Subscribe and again when you call Unsubscribe, so you get two different instances of the hidden class passed to your methods (actually you get interface references, not object references). I have no idea whether this will work, but since you can cast an interface reference to an object reference to get the object implementing the interface do that on the aHandler and compare the Classtype of that object with the one obtained from the stored handler in the same manner. -
Failss for me as well.
-
Analyze strings for common parts
PeterBelow replied to Mike Torrettinni's topic in Algorithms, Data Structures and Class Design
Play with this unit, it seems to do what you want, at least with the kind of input you showed. unit SqlLogParserU; interface uses System.Classes, System.Generics.Collections; type TStatementParts = record Fieldlist, FromList, WhereClause, OrderAndGrouping: string; end; TColumnDigest = class(TObject) strict private FName: string; FValues: TStringList; public constructor Create(const AName: string); destructor Destroy; override; property Name: string read FName; property Values: TStringList read FValues; end; TColumnDigestList = class(TObjectDictionary<string, TColumnDigest>) end; TSqlStatementDigest = class(TObject) strict private const CRegEx = '([_\d\w]+)\s*([=<>]+)\s*(''.+''|[\d.+\-]+)'; var FColumns: TColumnDigestList; FOccurences: Integer; FParts: TStatementParts; function GetColumnlist: string; function GetStatement: string; procedure NormalizeWhereClause; strict protected function GetReportItem: string; property Columns: TColumnDigestList read FColumns; public constructor Create(const AParts: TStatementParts); destructor Destroy; override; procedure AddColumnValue(const aColumn, aValue: string); procedure AnalyzeWhereclause(const aClause: string); procedure IncOccurences; property Occurences: Integer read FOccurences; property ReportItem: string read GetReportItem; end; TDigestList = class(TObjectDictionary<string, TSqlStatementDigest>) end; TLogSqlParser = class(TObject) strict private FDigestList: TDigestList; strict protected procedure AnalyzeAndLogStatement(const aParts: TStatementParts); procedure DigestStatement(const aLine: string); procedure DissectStatement(const aLine: string; var aParts: TStatementParts); procedure HandleOrderAndGrouping(var aParts: TStatementParts); function IsSelectStatement(const aLine: string): Boolean; function GetReport: string; property DigestList: TDigestList read FDigestList; public constructor Create; reintroduce; virtual; destructor Destroy; override; procedure Analyze(const aLogText: string); overload; procedure Analyze(aText: TStrings); overload; property Report: string read GetReport; end; implementation uses Sysutils, System.RegularExpressions; {== TLogSqlParser =====================================================} constructor TLogSqlParser.Create; begin inherited Create; FDigestList := TDigestList.Create([doOwnsValues]); end; destructor TLogSqlParser.Destroy; begin FDigestList.Free; inherited Destroy; end; procedure TLogSqlParser.Analyze(const aLogText: string); var LText: TStringList; begin LText := TStringList.Create(); try LText.Text := aLogText; Analyze(LText); finally LText.Free; end; end; procedure TLogSqlParser.Analyze(aText: TStrings); var I: Integer; begin DigestList.Clear; for I := 0 to aText.Count-1 do DigestStatement(aText[I]); end; procedure TLogSqlParser.AnalyzeAndLogStatement(const aParts: TStatementParts); var LDigest: TSqlStatementDigest; begin if not Digestlist.TryGetValue(aParts.Fieldlist, LDigest) then begin LDigest := TSqlStatementDigest.Create(aParts); DigestList.Add(aParts.Fieldlist, LDigest); end; LDigest.IncOccurences; LDigest.AnalyzeWhereclause(aParts.WhereClause); end; procedure TLogSqlParser.DigestStatement(const aLine: string); var LParts: TStatementParts; begin if IsSelectStatement(aLine) then begin DissectStatement(aLine.Trim.ToLower, LParts); if not LParts.Fieldlist.IsEmpty then AnalyzeAndLogStatement(LParts); end; {if} end; procedure TLogSqlParser.DissectStatement(const aLine: string; var aParts: TStatementParts); const CRegEx = 'select (.*) from (.*) where (.*)'; var LMatch: TMatch; begin LMatch := TRegEx.Match(aLine, CRegEx, [roSingleLine]); if LMatch.Success then begin aParts.Fieldlist := LMatch.Groups[1].Value; aParts.FromList := LMatch.Groups[2].Value; aParts.WhereClause := LMatch.Groups[3].Value; HandleOrderAndGrouping(aParts); end {if} else Finalize(aParts); end; function TLogSqlParser.GetReport: string; var LReport: TStringList; I: Integer; LDigest: TSqlStatementDigest; begin LReport := TStringList.Create(); for LDigest in DigestList.Values do begin LReport.Add(LDigest.ReportItem); end; {for} Result := LReport.Text; end; procedure TLogSqlParser.HandleOrderAndGrouping(var aParts: TStatementParts); const CGroupBy = ' group by '; COrderBy = ' order by '; // SQL requires grouping before ordering! CBoundaries: array [0..1] of string = (CGroupBy, COrderBy); var I: Integer; LParts: TArray<string>; S: string; begin S:= aParts.WhereClause; aParts.OrderAndGrouping := string.empty; for I := Low(CBoundaries) to High(CBoundaries) do if S.Contains(CBoundaries[I]) then begin LParts := S.Split([CBoundaries[I]]); aParts.WhereClause := LParts[0]; aParts.OrderAndGrouping := CBoundaries[I] + LParts[1]; Break; end; {if} end; function TLogSqlParser.IsSelectStatement(const aLine: string): Boolean; begin Result := aLine.Trim.StartsWith('select ', true); end; {== TSqlStatementDigest ===============================================} constructor TSqlStatementDigest.Create(const AParts: TStatementParts); begin inherited Create; FParts := AParts; NormalizeWhereClause; FColumns := TColumnDigestList.Create([doOwnsValues]); end; destructor TSqlStatementDigest.Destroy; begin FColumns.Free; inherited Destroy; end; procedure TSqlStatementDigest.AddColumnValue(const aColumn, aValue: string); var LColumn: TColumnDigest; begin if not Columns.TryGetValue(aColumn, LColumn) then begin LColumn := TColumnDigest.Create(aColumn); Columns.Add(aColumn, LColumn); end; LColumn.Values.Add(aValue); end; procedure TSqlStatementDigest.AnalyzeWhereclause(const aClause: string); var LMatch: TMatch; begin LMatch := TRegEx.Match(aClause, CRegEx); while LMatch.Success do begin AddColumnValue(LMatch.Groups[1].Value, LMatch.Groups[3].Value); LMatch := LMatch.NextMatch; end; {while} end; function TSqlStatementDigest.GetColumnlist: string; var LColumn: TColumnDigest; LText: TStringList; begin LText := TStringList.Create(); for LColumn in Columns.Values do LText.Add( Format(' Column: %s, values: [%s]',[LColumn.Name, LColumn.Values.CommaText])); Result := LText.Text; end; function TSqlStatementDigest.GetReportItem: string; const CMask = 'Sql statement: %s'+SLineBreak+ ' occurrence: %d'+SLineBreak+ '%s'; begin Result := Format(CMask,[GetStatement, Occurences, GetColumnlist]); end; function TSqlStatementDigest.GetStatement: string; begin Result := Format('select %s from %s where %s %s', [FParts.Fieldlist, FParts.FromList, FParts.WhereClause, FParts.OrderAndGrouping]); end; procedure TSqlStatementDigest.IncOccurences; begin Inc(FOccurences); end; procedure TSqlStatementDigest.NormalizeWhereClause; const CSpace = ' '; CSingleQuote = ''''; var LMatch: TMatch; S: string; LBuilder: TStringbuilder; LParts: TArray<string>; I: Integer; begin S := FParts.WhereClause; LMatch := TRegEx.Match(S, CRegEx); if LMatch.Success then begin LBuilder:= TStringbuilder.Create; try while LMatch.Success do begin for I := 1 to 3 do begin {1: column name, 2: operator, 3: value} LParts := S.Split([LMatch.Groups[I].Value], 2); if I < 3 then begin LBuilder.Append(LParts[0]); LBuilder.Append(LMatch.Groups[I].Value); end {if} else begin if LParts[0].Contains(CSingleQuote) then LBuilder.Append(CSingleQuote + '?' + CSingleQuote) else LBuilder.Append('?'); end; {else} LBuilder.Append(CSpace); S:= LParts[1]; end; {for } LMatch := LMatch.NextMatch; end; FParts.WhereClause := LBuilder.ToString; finally LBuilder.Free; end; end; {if} end; {== TColumnDigest =====================================================} constructor TColumnDigest.Create(const AName: string); begin inherited Create; FName := AName; FValues := TStringList.Create; FValues.Duplicates := dupIgnore; FValues.Sorted := true; end; destructor TColumnDigest.Destroy; begin FValues.Free; inherited Destroy; end; end. SqlLogParserU.pas -
I don't think that ever existed. If it did it would be completely useless since the actual variables you pass to a function call are rarely (in my case never ) named the same as the parameters in the function declaration.
-
You never told us which Delphi version you are using. If it has a System.Ansistrings unit: that contains a number of routines to work with ansistrings. Use the AnsiPos function to search for a character or substring; it returns the index of the found item. Use AnsiMidStr to extract a range of characters from an Ansistring (or the good old Copy function, it has an overload for Ansistrings).
-
Routine to check if set of dates match
PeterBelow replied to david_navigator's topic in Algorithms, Data Structures and Class Design
Since you only need to be precise to the minute do not store TDatetimes but multiply the values by 60*24 and truncate the result to give an integer (perhaps an int64, you could reduce the range necessary by subtracting a suitable reference date first, e.g. EncodeDate(2020,1,1)). This gives you the number of minutes from the reference date. Store these into a TList<integer>. To calculate a hash use the list's ToArray method to get an array you can feed to a suitable hash algorithm from the System.Hash unit. -
Am I using threads correctly?
PeterBelow replied to AlexQc's topic in Algorithms, Data Structures and Class Design
It is working in this case since TListboxStrings.Add (TListboxStrings is the TStrings descendant behind TListbox.Items) does indeed send a message (LB_ADDSTRING) to the control, and the control is visible on the form. But you should not rely on such implementation details when working in a background thread. Using Synchronize the pattern would be something like this: Synchronize( procedure begin Buffer.Add(LCurrentFile); end); where LCurrentfile is the local variable holding the filename to add to the listbox. The code goes inside your find loop. -
Am I using threads correctly?
PeterBelow replied to AlexQc's topic in Algorithms, Data Structures and Class Design
I see a few problems with your code. In general you cannot access UI controls from a background thread, but you pass ListBoxPrograms.Items as the Buffer parameter to the thread's constructor. This can work if the Add method of ListBoxPrograms.Items is implemented by sending a message to the listbox control, since the OS makes sure a message is delivered in the thread that created the control's window handle. On the other hand the VCL creates a control handle on an as needed basis, and if the ListBoxPrograms.Handle has not been created yet when the thread tries to add the first item the handle would be created in the background thread context, which would not work since this thread has no message loop. So: Always access UI controls only in a Synchronized or Queued method! You did not show code for the ListFilesDir method, so perhaps you are doing that already. The second point to investigate is how to safely interrupt the thread's work if it has to be killed before it has completed its work. The TThread Destructor calls Terminate and then waits for the thread to die gracefully (by leaving the Ececute method). For this to work as expected the thread's work loop has to check the Terminated property on each round and exit directly if it is true. Again this is something you would do in ListFilesDir. Then there is the question of error handling in the thread's work loop. The usual pattern is to wrap the whole body of the Execute method in a try except block and either pass a trapped exception to the main thread for reporting to the user via a Synchronized method (not a queued one!), or use the Windows.MessageBox function to report it directly. That API is thread-safe, while the VCL.Dialogs methods are not. -
Debugging Issues in D11 64Bit with Packages
PeterBelow replied to MathewV's topic in Delphi IDE and APIs
I have not been working with DLL projects much in the past and never with 64 bit DLLs, but usually one had to debug the DLL project, set the host application to use in the Run -> Parameters dialog, set a breakpoint in the DLL funtion of interest, and then just run. Do the required actions in the host to end up in the DLL at the breakpoint. If you end up in the CPU view this means that the debugger cannot find the debug information for the code you stepped into. Make sure you build the DLL with debug information. 64-bit apps are debugged in a kind of remote debugger session since the IDE is a 32 bit process. So make sure you have enabled "include remote debug symbols" in the linker options. -
Using translations in unit Consts with Delphi 10.4 VCL
PeterBelow replied to Dirk Janssens's topic in VCL
-
If I only could; McAfee rermoved that ability some years ago, one can only exempt specific EXEs now, and that is automatically removed if the EXE changes. I would not recomment McAfee for developer PCs for this reason, although it is a good product otherwise, IMO (a bit pricey, though). I can live with it since I don't program for a living and these false detections are rare.
-
Using translations in unit Consts with Delphi 10.4 VCL
PeterBelow replied to Dirk Janssens's topic in VCL
Definitely. It will also not work if you build your project with runtime packages. -
Can't you read it one byte at a time? I'm not familiar with the component you use.
-
I had a similar problem with Delphi Alexandria, McAfee would detect a freshly build Win32 debug EXE as virus and quarantine it before I could debug it under the IDE, but it would not flag the 32 bit release version of the same program and neither 64 bit debug or release versions. By the way: to send an EXE through a mail server put it into a ZIP file and password-protect that. The encryption done will make a virus scanner ignore it since it cannot identify the zipped file as executable. Some particularly paranoid mail servers will reject password-protected zip files for this reason, though.
-
You can use the OnDrawCell event to draw the cell content yourself any way you like. The stringgrid.Canvas has a TextRect method that supports aligning the text in the way you want.
-
Async await with blocking mode using Application.ProcessMessage(var Msg: TMsg)
PeterBelow replied to Nasreddine's topic in VCL
Here is an example from my old threading library code. FSignal is a TSimpleEvent the thread will signal when it has finished its work. {! Wait for the call to complete. Optionally we can process a subset of messages during the wait. That complicates the timeout handling, though, since the wait can be interrupted by messages.} function TAsyncCall.WaitForCompletion(TimeoutMSecs: Cardinal; ProcessMessages: Boolean): TWaitResult; var TargetTime, CurrentTime: int64; H: THandle; Ret: DWORD; function TimeRemaining: DWORD; begin if TimeoutMSecs = INFINITE then Result := INFINITE else begin CurrentTime := ToInt64(GetTickCount()); if CurrentTime > TargetTime then Result := 0 else begin Result := TargetTime - CurrentTime; if Result > TimeoutMSecs then Result := 0; // GetTickCount rolled over end; end; end; {! We want to block most user input here but allow paint messages to be processed and also non-client messages that relate to moving or minimizing the window to be acted upon. Timer messages are also processed! } procedure ProcessPendingMessages; var Msg: TMsg; const NSCMask = $FFF0; begin while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do case Msg.message of WM_KEYFIRST..WM_KEYLAST, WM_MOUSEFIRST..WM_MOUSELAST: ; // swallow WM_NCMOUSEMOVE..WM_NCLBUTTONDBLCLK: case Msg.wParam of HTCAPTION, HTMINBUTTON: DispatchMessage(Msg); end; {case} WM_SYSCOMMAND: case Msg.wParam and NSCMask of SC_MINIMIZE, SC_RESTORE: DispatchMessage(Msg); end; {case} else DispatchMessage(Msg); end; {case} end; begin EnsureSignalIsCreated; if FCompleted then Result := wrSignaled else if ProcessMessages then begin TargetTime := ToInt64(GetTickCount()) + TimeoutMSecs; H:= FSignal.Handle; Result := wrAbandoned; repeat Ret := MsgWaitForMultipleObjectsEx( 1, H, TimeRemaining, QS_ALLINPUT, 0); case Ret of WAIT_ABANDONED : Exit; WAIT_FAILED : Result := wrError; WAIT_TIMEOUT : Result := wrTimeout; WAIT_OBJECT_0 : Result := wrSignaled; WAIT_OBJECT_0+1: ProcessPendingMessages; end; {case } until Result <> wrAbandoned; end {if} else Result := FSignal.WaitFor(TimeoutMSecs); end; -
If the OnScroll event of the control is not sufficient for your need you have to subclass the control using its WindowProc property. Here is a short example using a TListbox filled with enough items to show a scrollbar as victim. The form also needs a TMemo to show the message traced. Note a few things regarding VCL subclassing: You need to find a place where the control you want to subclass has been created and that will only execute once during form creation. I used an overloaded Loaded method. The subclassing should be undone before the form is destroyed. A good place for that is an overloaded BeforeDestruction method. The replacement windowproc must pass all unhandeled messages to the original or the control will stop working. Usually one also passes the message one wants to handle to the original proc, perhaps with modified message parameters. type TMainform = class(Tform) ListBox1: TListBox; Memo1: TMemo; private FListWndProc: TWndMethod; procedure NewListboxProc(var Message: TMessage); protected procedure Loaded; override; public procedure BeforeDestruction; override; end; .... function GetScrollCodeAsText(aScrollcode: Smallint): string; begin case aScrollcode of SB_LINEUP: Result := 'SB_LINEUP'; SB_LINEDOWN: Result := 'SB_LINEDOWN'; SB_BOTTOM: Result := 'SB_BOTTOM'; SB_ENDSCROLL: Result := 'SB_ENDSCROLL'; SB_PAGEUP: Result := 'SB_PAGEUP'; SB_PAGEDOWN: Result := 'SB_PAGEDOWN'; SB_THUMBPOSITION: Result := 'SB_THUMBPOSITION'; SB_THUMBTRACK: Result := 'SB_THUMBTRACK'; SB_TOP: Result := 'SB_TOP'; else Result := 'unknown'; end; end; procedure TMainform.BeforeDestruction; begin if Assigned(FListWndProc) and Assigned(ListBox1) then Listbox1.WindowProc := FListWndProc; inherited; end; procedure TMainform.Loaded; begin inherited; if Assigned(ListBox1) then begin FListWndProc := Listbox1.WindowProc; Listbox1.WindowProc := NewListboxProc; end; end; procedure TMainform.NewListboxProc(var Message: TMessage); begin try if Message.Msg = WM_VSCROLL then begin memo1.Lines.Add( Format('Scroll code: %d (%s), position: %d', [TWMVScroll(Message).ScrollCode, GetScrollCodeAsText(TWMVScroll(Message).ScrollCode), TWMVScroll(Message).Pos ])); end; finally FListWndProc(Message); end; end; A click on the scrollbar thump (still in the top position) results in three messages: Scroll code: 5 (SB_THUMBTRACK), position: 0 Scroll code: 4 (SB_THUMBPOSITION), position: 0 Scroll code: 8 (SB_ENDSCROLL), position: 0
-
OnMessage only triggers for posted messages (PostMessage), but WM_VSCROLL is send (SendMessage). Using an OnSCroll event, if the control offers one, is the preferred way, though.
-
Yes, in a VCL control, at least. The control wll receive WM_VSCROLL messages when the user manipulates the scrollbar. The message parameters tell you what has happened.