Jump to content

PeterBelow

Members
  • Content Count

    549
  • Joined

  • Last visited

  • Days Won

    13

Everything posted by PeterBelow

  1. buf is declared as a single Widechar but you tell ToUnicodeEx that it can hold 255 Widechars. A good way to ruin your call stack.
  2. The error message makes no sense since it gives the impression that the code would work if T is constraint to class or interface. That is of course not the case.
  3. Like Remy said this would be much easier to handle if you transmit the whole input string after the user has entered it. There are ways to figure out which character would be created from a virtual key code and the current state of the modifier keys (Shift, Alt, Ctrl), see the MapVirtualKeyEx Windows API function, but this pointless if you have to deal with accented characters or other composites that are created by a sequence of keystrokes, or Alt+numpad input. Let Windows do this work for you and use the OnKeyPress event; it gives you the character directly.
  4. PeterBelow

    Fix DBGrid Scrollbar Problem

    A TDBGrid is a kind of virtual grid. It shows rows from a dataset and does not know how many rows the dataset contains (the dataset itself may not know that, in fact). So it scrolls the active row in the dataset, not the rows in the grid; the selected row in the grid corresponds to the active record in the dataset. The grid actually contains only enough rows to fill the visible area, which get reused for new content as the dataset is scrolled.
  5. I tried something like that and the compiler does not accept the "set of T" declaration, moaning about T not having a class or interface constraint. Which makes no sense at all in this case.
  6. Sets have their use but they also have limitations, e. g. they are not supported with generics as far as I know, so a "set of T" does not work. If you could replace the set with a list you could turn the class into a generic base class with the generic T: record parameter for the enumeration that the set is now defined with. Of course a check for "x in set" is much faster than a check for "x in list". The compiler (11.1) accepts something like type TWrapper<T: record> = class private FSet: TList<T>; end; TEnum = (one, two, three); TEnumWrapper = class(TWrapper<TEnum>) end; But you still cannot apply functions like Ord to T in methods of TWrapper, nor cast it to Byte. The constraint system for generics is too limited here since you cannot specify T as an ordinal type.
  7. PeterBelow

    Delete unicode non-breaking space

    You are approaching this from the wrong angle. The data you showed pasted into notepad looks like a semicolon-separated CSV format. To dissect this you can use TStringlist. Something like this: var LText, LLine: TStringlist; i: integer; begin LText := TStringlist.Create; try LText := Clipboard.AsText; // This splits the data into lines LLine := TStringlist.Create; try LLine.StrictDelimiter := true; LLine.Delimiter := ';'; for i:= 0 to LText.Count - 1 do begin LLine.DelimitedText := LText[i]; if i = 0 then ProcessHeaderLine(LLine) else ProcessDataLine(LLine); end; finally LLine.Free; end; finally LText.Free; end; end; Untested, just typed into the post directly. The two Process routines are something you would write yourself. For each the passed stringlist should hold 5 lines, the column captions for the header and the column values for the data. If you really want to replace a non-breaking Unicode space it is a single character with the code #$00A0, not a two-character string. Your hex viewer probably pastes the clipboard content as ANSI text, while Notepad pastes it as Unicode (UTF-16).
  8. PeterBelow

    load from file

    The System.IOUtils unit contains a number of helpers to work with files in general. The TPath record has methods to build a path, dissect a path, find system folders etc.
  9. A function return value of type string as well as other compiler-managed types (e.g. dynamic arrays) is actually implemented as an additional Var parameter, so your function would be equivalent to procedure SwitchCase(const aStr: string; var Result:string); The compiler initializes the string variable passed for Result at the point of call, so it will always be valid. It is not guaranteed to be nil (string.empty), though. The compiler may reuse another hidden local variable used previously in the calling method. Such things are documented in the Delphi Language guide, see https://docwiki.embarcadero.com/RADStudio/Sydney/en/Program_Control_(Delphi)
  10. PeterBelow

    So here's my challemge...

    Is this for a multi-user application, where several users may request a new code/number combination for the same code concurrently? That may pose a problem unless you can figure out a way to avoid or at least detect collisions. On a database level sequences (or generators, nomenclature differs between databases) were introduced to solve such issues, but in your case you would need one sequence per code. A unique index on the table storing the code+number values would at least give you a way to detect collisions if you simply use a SELECT max(value) FROM <table> WHERE value like :code+'%' to get the last value used.
  11. PeterBelow

    ScrollBox ScrollBar Mouse Tracking

    The VCL controls do not implement a default handling of the mouse wheel, unless a Windows control implements it on the API level. TScrollbox is not based on an API control, so you have to code this yourself. You only have to do this once, though: create a descendant of TScollbox that implements the behaviour you want and the use that. Note that when creating a component you do not use the parent component's events, those are for the component user. Instead you overwrite the virtual or dynamic methods that fire the events.
  12. PeterBelow

    ScrollBox ScrollBar Mouse Tracking

    Hard to say with the info you give us. A scrollbox (VCL) sets its range automatically based on the position and dimensions of the controls it contains. If it is empty or the content is aligned alClient there is nothing to scroll. If all content fits in the client area of the scrollbox there is nothing to scroll either.
  13. PeterBelow

    INI problem

    I don't know much about the US legal system, other than that it is weird by german standards and have no actual case I could point to. But in my opinion a known safety problem like the one this discussion is about would be a quality issue. Of course if the client decides to use such an unsafe installation folder and the possible risk is spelled out in the installation guide then it is his problem. As far as I'm aware (and i'm definitely not a lawyer) in Germany software is treated like other products (hardware) now as far as consumer protection legislation and liability is concerned, so damage caused by faulty software could be reason for a (private) lawsuite. In this particular case it would probably boil down to how much knowlege of the risk involved can be reasonably expected of the user installing the software...
  14. PeterBelow

    INI problem

    Are you also aware of the legal repercussions that may have? It's of course OK if you only use the program on your own computers, but if you sell it to clients it opens you up to litigation. If the program is infected on the client's computer and then causes damage there the client could sue you, since the program does not follow accepted safety standards for software. Depends on your countries legislation, of course.
  15. PeterBelow

    INI problem

    That requires write access for the user account to the folder the program is in, and that makes it vulnerable to malware attacks.
  16. I just checked my Pro installations and both 10.4 and 11.1 only have the three source files you listed. For the other FireDac units only the DCUs are there. The latest Feature Matrix lists full FireDac source code as Enterprise /Architect edition only.
  17. PeterBelow

    Experience/opinions on FastMM5

    What's so shocking about these numbers?
  18. PeterBelow

    How to Create a RSA key using CMD by Delphi

  19. PeterBelow

    Delphi 11.1 Crash on Search Menu Access

    Works fine for me as well, D11.1 on Win10. Does your source file use an encoding other than ANSI?
  20. PeterBelow

    INI problem

    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.
  21. PeterBelow

    Can someone provide inbound and outbound ports used by IDE?

    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.
  22. PeterBelow

    Comport Serial Port help

    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.
  23. PeterBelow

    Identify "reference to procedure"

    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.
  24. PeterBelow

    quality.embarcadero.com not working?

    Failss for me as well.
  25. PeterBelow

    Analyze strings for common parts

    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
×