You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
343 lines
9.5 KiB
Plaintext
343 lines
9.5 KiB
Plaintext
{
|
|
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.
|