Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation on 03/06/22 in all areas

  1. Anders Melander

    ANN: Better Translation Manager released

    Uploaded a new build: v1.3.8100.37233. I have finally managed to get upload to BitBucket working so it's available here now: https://bitbucket.org/anders_melander/better-translation-manager/downloads/ Changes since build 1.3.8055.21506: HighDPI scaling has been disabled in order to work around scaling problems caused by the DevExpress skinning engine. When these get resolved I will enable Per Monitor v2 scaling. https://bitbucket.org/anders_melander/better-translation-manager/issues/26/handle-highdpi-scaling @Renate Schaaf Automatically show and focus the multi-line editor if the source text contains multiple lines (optional, enabled by default). https://bitbucket.org/anders_melander/better-translation-manager/issues/15/auto-open-text-editor-when-applicable @aehimself Added a translation integration API which allows the application being translated to control BTM. Using this integration, when a form or control is focused in the application, then the corresponding module and property is selected in BTM. The integration API is contained in the file amLocalization.Integration.Tracker.API.pas Properties that have been omitted from the form resource, for example because their current values equals the default value, can now be synthesized so they can be translated. This solves the problem where for example TField.DisplayLabel could not be translated if DisplayLabel and FieldName contained the same value. A lot of minor bug fixed and improvements. See commit log: https://bitbucket.org/anders_melander/better-translation-manager/commits/
  2. Der schöne Günther

    DPROJ changes: SourceTree vs Beyond Compare

    It's just a text file. My guess is that either the file encoding or line breaks have changed. If you can provide a file "before" and "after", I'm sure we can find what's up. I don't know about SourceTree, but diff editors often have an option whether line breaks or whitespace changes should be taken into account.
  3. 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
  4. Anders Melander

    ANN: Better Translation Manager released

    That's the same problem as the one mentioned a few messages earlier:
  5. DJof SD

    docwiki.embarcadero.com is not working

    I thought he was just continuing a joke.
  6. Lajos Juhász

    docwiki.embarcadero.com is not working

    16th during the webinar we should all ask the question whenever the future of Delphi includes some kind of online documentation or not. I believe that will be the perfect place to ask!
×