RnQ/for.RnQ/RQlog.pas

{
  This file is part of R&Q.
  Under same license
}
unit RQlog;
{$I ForRnQConfig.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls, Menus,
  RDGlobal, VirtualTrees, JSON;

{$I NoRTTI.inc}

type
  PLogItem = ^TLogItem;

  TLogItem = record
    pkt: Boolean;
    Cpt, Text: String;
    PktData: String;
    Img: TPicName;
  end;

type
  TLogFrm = class(TForm)
    Splitter1: TSplitter;
    dumpBox: TMemo;
    menu: TPopupMenu;
    Clear1: TMenuItem;
    CopytoClipboard1: TMenuItem;
    procedure LogListDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
    procedure FormCreate(Sender: TObject);
    procedure LogListChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure CopytoClipboard1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure LogListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure FormDestroy(Sender: TObject);
    procedure dumpBoxKeyPress(Sender: TObject; var Key: Char);
  public
    LogList: TVirtualDrawTree;
    // procedure DestroyHandle; Override;
    procedure AddToLog(Pkt: Boolean; const S: String; const Text, Data: String; const Img: TPicName);
  end;

  procedure LoggaEvtS(s: String; const Img: TPicName = ''; const pFlush: Boolean = False);
  procedure LogEvPkt(const Head: String; const TextData: String; const Data: String; const Img: TPicName; NeedHex: Boolean = True);
  procedure FlushLogEvFile;

var
  LogFrm: TLogFrm;

implementation

{$R *.dfm}

uses
  RQUtil, RDUtils, RnQSysUtils, RDFileUtil,
  RQThemes, RnQGlobal, RnQGraphics32, Clipbrd;

var
  LogEvFileData: String;

procedure TLogFrm.AddToLog(Pkt: Boolean; const S: String; const Text, Data: String; const Img: TPicName);
var
  it: PLogItem;
  SetLast: Boolean;
  n: PVirtualNode;
begin
  SetLast := LogList.FocusedNode = LogList.GetLast;
  n := LogList.AddChild(nil);
  it := LogList.GetNodeData(n);
  it.pkt := Pkt;
  it.Cpt := S;
  it.Text := Text;
  it.Img := Img;
  it.PktData := Data;

  if SetLast then
  with LogList do
  begin
    FocusedNode := n;
    ClearSelection;
    if Assigned(n) then
      Selected[n] := True;
  end;
end; // AddToLog

procedure TLogFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin { destroyHandle }
  // Action := caFree;
  // LogFrm := nil;
end;

procedure TLogFrm.FormCreate(Sender: TObject);
begin
  LogList := TVirtualDrawTree.Create(self);
  Self.InsertComponent(LogList);
  LogList.Parent := Self;
  LogList.NodeDataSize := SizeOf(TLogItem);
  with LogList do
  begin
    Align := alTop;
    BorderStyle := bsNone;
    DefaultNodeHeight := 17;
    DrawSelectionMode := smBlendedRectangle;
    Colors.UnfocusedSelectionColor := clInactiveCaption;
    Colors.FocusedSelectionColor := clInactiveCaption;
    Colors.SelectionRectangleBlendColor := clInactiveCaption;
    Header.AutoSizeIndex := 0;
    {
      Header.Font.Charset := DEFAULT_CHARSET
      Header.Font.Color := clWindowText
      Header.Font.Height := -11
      Header.Font.Name := 'Tahoma'
      Header.Font.Style = []
    }
    Header.MainColumn := -1;
    Header.Options := [hoColumnResize, hoDrag];
    PopupMenu := menu;
    TabOrder := 1;
    TreeOptions.PaintOptions := [toUseBlendedSelection, toHideFocusRect, toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages];
    TreeOptions.SelectionOptions := [toFullRowSelect, toMiddleClickSelect, toRightClickSelect];
    TreeOptions.AutoOptions := [toAutoDropExpand, toAutoTristateTracking, toAutoScrollOnExpand, toAutoDeleteMovedNodes, toAutoChangeScale, toAutoSort];
    OnChange := LogListChange;
    OnDrawNode := LogListDrawNode;
    OnFreeNode := LogListFreeNode;
  end;
end;

procedure TLogFrm.FormDestroy(Sender: TObject);
begin
  Clear1Click(Self);
  LogFrm := nil;
end;

procedure TLogFrm.FormShow(Sender: TObject);
begin
  theme.pic2ico(RQteFormIcon, PIC_HISTORY, Self.Icon);
  ApplyTaskButton(self)
end;

const INDENT_SIZE = 2;

function PrettyPrintJSON(Value: TJSONValue; Indent: Integer = 0): String; forward;

function PrettyPrintPair(Value: TJSONPair; Last: Boolean; Indent: Integer): String;
const
  TEMPLATE = '%s : %s';
var
  Line: string;
  JSONText: String;
begin
  try
    JSONText := PrettyPrintJSON(Value.JsonValue, Indent);
    Line := Format(TEMPLATE, [Value.JsonString.ToString, Trim(JSONText)]);
  except end;

  Line := StringOfChar(' ', Indent * INDENT_SIZE) + Line;
  if not Last then
    Line := Line + ',';
  Result := Line;
end;

function PrettyPrintArrayValue(Value: TJSONValue; Last: Boolean; Indent: Integer): String;
const
  TEMPLATE = '%s';
var
  Line: string;
  JSONText: String;
begin
  try
    JSONText := PrettyPrintJSON(Value, Indent);
    Line := Format(TEMPLATE, [Trim(JSONText)]);
  except end;

  Line := StringOfChar(' ', Indent * INDENT_SIZE) + Line;
  if not Last then
    Line := Line + ',';
  Result := Line;
end;

function PrettyPrintJSON(Value: TJSONValue; Indent: Integer = 0): String;
var
  i: Integer;
begin
  if Value is TJSONObject then
  begin
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '{';
    for i := 0 to TJSONObject(Value).Count - 1 do
      Result := Result + CRLF + PrettyPrintPair(TJSONObject(Value).Pairs[i], i = TJSONObject(Value).Count - 1, Indent + 1);
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '}';
  end
  else if Value is TJSONArray then
  begin
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + '[';
    for i := 0 to TJSONArray(Value).Count - 1 do
      Result := Result + CRLF + PrettyPrintArrayValue(TJSONArray(Value).Items[i], i = TJSONArray(Value).Count - 1, Indent + 1);
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + ']';
  end else
    Result := Result + CRLF + StringOfChar(' ', Indent * INDENT_SIZE) + Value.ToString;
end;

procedure TLogFrm.LogListChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
  json: TJSONValue;
begin
  if Node = nil then
    Exit;
  with TLogItem(PLogItem(LogList.GetNodeData(Node))^) do
  begin
    if (Cpt = Text) then
      dumpBox.Text := Cpt
    else if pkt then
      dumpBox.Text := Cpt + CRLF + hexDumpS(PktData)
    else
    try
      json := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(Text), 0); // Broken double encoding
      if Assigned(json) then
        dumpBox.Text := Cpt + CRLF + Trim(PrettyPrintJSON(json))
      else
        dumpBox.Text := Cpt + CRLF + Text;
      json.Free;
    except
      dumpBox.Text := Cpt + CRLF + Text;
    end;
  end;
end;

procedure TLogFrm.LogListDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
var
  s: String;
  x: Integer;
  r: TGPRect;
begin
  with TLogItem(PLogItem(LogList.GetNodeData(PaintInfo.Node))^) do
  begin
    s := Cpt;
    if vsSelected in PaintInfo.Node.States then
    begin
      if Sender.Focused then
        PaintInfo.Canvas.Font.Color := clWindowText
      else
        PaintInfo.Canvas.Font.Color := $333333;
    end
    else
      PaintInfo.Canvas.Font.Color := $111111;
    r.x := PaintInfo.ContentRect.Left + 1;
    r.Y := 0;
    r.Height := PaintInfo.ContentRect.Bottom;
    r.Width := r.Height;
    theme.drawPic(PaintInfo.Canvas.Handle, r, Img);
    x := r.x + r.Width;
    // theme.drawPic(PaintInfo.Canvas.Handle, PaintInfo.ContentRect.Left +3, 0,
    // Img).cx+6;
    // .cx+2;

    SetBkMode(PaintInfo.Canvas.Handle, TRANSPARENT);
    PaintInfo.Canvas.textout(PaintInfo.ContentRect.Left + x, 2, s);
  end;
end;

procedure TLogFrm.LogListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  with PLogItem(LogList.GetNodeData(Node))^ do
  begin
    SetLength(Cpt, 0);
    SetLength(Text, 0);
    SetLength(Img, 0);
    SetLength(PktData, 0);
  end;
end;

procedure TLogFrm.Clear1Click(Sender: TObject);
begin
  LogList.Clear;
  dumpBox.Clear;
end;

procedure TLogFrm.CopytoClipboard1Click(Sender: TObject);
var
  s: String;
begin
  if LogList.FocusedNode = NIL then
    Exit;
  s := TLogItem(PLogItem(LogList.GetNodeData(LogList.FocusedNode))^).Text;
  s := BetterStrS(s);
  clipboard.asText := s;
end;

procedure TLogFrm.dumpBoxKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = ^A then
  begin
    (Sender as TMemo).SelectAll;
    Key := #0;
  end;
end;

procedure LoggaEvtS(s: String; const Img: TPicName = ''; const pFlush: Boolean = False);
var
  h: String;
begin
  h := '';
  while s > '' do
    h := h + chopline(s) + CRLF;
  // while h[length(h)] in [#10, #13] do
  while CharInSet(h[Length(h)], [#10, #13]) do
    SetLength(h, Length(h) - 1);
  // h :=
  s := logtimestamp + h;

  if LogPref.evts.onFile then
    LogEvFileData := LogEvFileData + s + CRLF;

  if pFlush then
    FlushLogEvFile;

  if LogPref.evts.onWindow and Assigned(LogFrm) then
  begin
    h := s;
    LogFrm.AddToLog(False, chopline(h), s, '', Img);
  end;
end; // LoggaEvt

procedure LogEvPkt(const Head: String; const TextData: String; const Data: String; const Img: TPicName; NeedHex: Boolean = True);
begin
  if LogPref.pkts.onWindow and Assigned(LogFrm) then
    LogFrm.AddToLog(NeedHex, Head, TextData, Data, Img);
end; // LogEvPkt

procedure FlushLogEvFile;
begin
  if Length(LogEvFileData) > 0 then
    if AppendFile(LogPath + EventsLogFilename, UTF(LogEvFileData)) or (Length(LogEvFileData) > MByte) then
      LogEvFileData := '';
end;

end.