/// main form of the TSynLog .log file vizualizer unit LogViewMain; interface {$I Synopse.inc} uses {$ifdef MSWINDOWS} Windows, ShellAPI, {$endif} Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ImgList, StdCtrls, CheckLst, Menus, ExtCtrls, Grids, Clipbrd, {$WARN UNIT_PLATFORM OFF} FileCtrl, {$WARN UNIT_PLATFORM ON} {$ifdef FPC} // FPC compatibility by alf (alfred) - thanks for the patch! ShellCtrls, SynTaskDialog in '..\..\Samples\ThirdPartyDemos\Ondrej\SynTaskDialog4Lazarus\SynTaskDialog.pas', {$else} SynTaskDialog, // also fix QC 37403 for Delphi 6/7/2006 {$endif} SynCommons, SynLog, {$ifndef FPC} SynMemoEx, {$endif} mORMotHttpServer; type {$ifdef FPC} TFileListBox = TShellListView; TDirectoryListBox = TShellTreeView; {$endif} { TMainLogView } TMainLogView = class(TForm) PanelLeft: TPanel; PanelThread: TPanel; PanelBottom: TPanel; BtnBrowse: TButton; EventsList: TCheckListBox; FilterMenu: TPopupMenu; EditSearch: TEdit; BtnSearchNext: TButton; Splitter2: TSplitter; Splitter3: TSplitter; BtnStats: TButton; OpenDialog: TOpenDialog; BtnMapSearch: TButton; MergedProfile: TCheckBox; ProfileGroup: TRadioGroup; ImageLogo: TImage; List: TDrawGrid; ProfileList: TDrawGrid; ThreadGroup: TGroupBox; BtnThreadNext: TButton; ThreadListBox: TCheckListBox; Splitter1: TSplitter; BtnThreadShow: TButton; PanelBrowse: TPanel; {$ifndef FPC} Drive: TDriveComboBox; {$endif} Directory: TDirectoryListBox; Files: TFileListBox; Splitter4: TSplitter; ListMenu: TPopupMenu; ListMenuCopy: TMenuItem; BtnSearchPrevious: TButton; btnServerLaunch: TButton; lblServerRoot: TLabel; edtServerRoot: TEdit; lblServerPort: TLabel; edtServerPort: TEdit; tmrRefresh: TTimer; btnListClear: TButton; btnListSave: TButton; dlgSaveList: TSaveDialog; pnlThreadBottom: TPanel; lblThreadName: TLabel; btnThread0: TButton; btnThread1: TButton; btnThreadAll: TButton; btnThreadDown: TButton; btnThreadUp: TButton; lstDays: TListBox; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure BtnFilterClick(Sender: TObject); procedure EventsListClickCheck(Sender: TObject); procedure BtnSearchNextClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure ListClick(Sender: TObject); procedure ProfileListClick(Sender: TObject); procedure ListDblClick(Sender: TObject); procedure BtnStatsClick(Sender: TObject); procedure BtnOpenClick(Sender: TObject); procedure BtnMapSearchClick(Sender: TObject); procedure MergedProfileClick(Sender: TObject); procedure ProfileGroupClick(Sender: TObject); procedure ImageLogoClick(Sender: TObject); procedure EventsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure ProfileListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure EventsListDblClick(Sender: TObject); procedure BtnThreadNextClick(Sender: TObject); procedure BtnThreadShowClick(Sender: TObject); procedure ThreadListBoxDblClick(Sender: TObject); procedure BtnThreadClick(Sender: TObject); procedure ThreadListBoxClickCheck(Sender: TObject); procedure BtnBrowseClick(Sender: TObject); procedure FilesClick(Sender: TObject); procedure ListMenuCopyClick(Sender: TObject); procedure btnServerLaunchClick(Sender: TObject); procedure tmrRefreshTimer(Sender: TObject); procedure btnListClearClick(Sender: TObject); procedure btnListSaveClick(Sender: TObject); procedure ThreadListBoxClick(Sender: TObject); procedure lstDaysDblClick(Sender: TObject); procedure PanelLeftResize(Sender: TObject); procedure btnThreadDownClick(Sender: TObject); procedure btnThreadUpClick(Sender: TObject); procedure PanelBottomResize(Sender: TObject); protected FLog: TSynLogFileView; FMainCaption: string; FMenuFilterAll: TMenuItem; FLogUncompressed: TMemoryStream; FThreadNames: TRawUTF8DynArray; FDays: TDateTimeDynArray; FLastSearch: RawUTF8; FLastSearchSender: TObject; FRemoteLogService: TSQLHTTPRemoteLogServer; // from mORMotHTTPServer FPanelThreadVisible: boolean; procedure SetLogFileName(const Value: TFileName); procedure SetListItem(Index: integer; const search: RawUTF8=''); procedure BtnFilterMenu(Sender: TObject); procedure ThreadListCheckRefresh; procedure ThreadListNameRefresh(Index: integer); procedure ReceivedOne(const Text: RawUTF8); public {$ifdef FPC} MemoBottom: TMemo; // for LCL compatibility {$else} MemoBottom: TMemoEx; {$endif} destructor Destroy; override; property LogFileName: TFileName write SetLogFileName; end; var MainLogView: TMainLogView; implementation {$ifdef FPC} {$R *.lfm} {$else} {$R *.dfm} {$endif} {$ifdef FPC} uses LCLIntf, Themes, LCLType; {$endif} resourcestring sEnterAddress = 'Enter an hexadecimal address:'; sStats = #13#10+ '%s'#13#10'%s'#13#10#13#10+ 'Started: %s'#13#10'Closed: %s'#13#10'Time elapsed: %d.%s'#13#10+ 'Events: %d'#13#10'Methods: %d'#13#10'Threads: %d'#13#10'Size: %s'#13#10#13#10+ 'Executable'#13#10'----------'#13#10#13#10'Name: %s%s'#13#10+ 'Version: %s'#13#10'Build Date: %s'#13#10'Framework: %s'#13#10#13#10+ 'Host'#13#10'----'#13#10#13#10'Computer: %s'#13#10+ 'User: %s'#13#10'CPU: %s%s'#13#10'OS: %s'#13#10#13#10+ 'Events'#13#10'------'#13#10#13#10; sNoFile = 'No File'; sRemoteLog = 'Remote Log'; sUnknown = 'Unknown'; sWindowsStats = 'Windows %s (service pack %d)'#13#10'Wow64: %s'; sTimeInfo = '%d lines - time elapsed: %s'; { TMainLogView } procedure TMainLogView.SetLogFileName(const Value: TFileName); var E: TSynLogInfo; i, y: integer; begin {$ifdef FPC} if (Value<>'') and (GetFileNameExtIndex(Value,'log,synlz,txt')<0) then exit; {$endif} FreeAndNil(FLog); FreeAndNil(FLogUncompressed); ThreadListBox.Clear; List.RowCount := 0; EventsList.Items.Clear; if FileExists(Value) then try Screen.Cursor := crHourGlass; Caption := FMainCaption+ExpandFileName(Value); if SameText(ExtractFileExt(Value),'.synlz') then begin FLogUncompressed := StreamUnSynLZ(Value,LOG_MAGIC); if FLogUncompressed=nil then exit; // invalid file content FLog := TSynLogFileView.Create(FLogUncompressed.Memory,FLogUncompressed.Size); FLog.FileName := Value; end else FLog := TSynLogFileView.Create(Value); EventsList.Items.BeginUpdate; if FLog.EventLevel=nil then begin // if not a TSynLog file -> open as plain text List.ColCount := 1; List.ColWidths[0] := 2000; end else begin List.ColCount := 4; List.ColWidths[0] := 70; List.ColWidths[1] := 60; List.ColWidths[2] := 24; List.ColWidths[3] := 2000; for E := succ(sllNone) to high(E) do if E in FLog.EventLevelUsed then EventsList.Items.AddObject(ToCaption(E),pointer(ord(E))); for i := 1 to FilterMenu.Items.Count-1 do FilterMenu.Items[i].Visible := LOG_FILTER[TSynLogFilter(FilterMenu.Items[i].Tag)]*FLog.EventLevelUsed<>[]; end; finally EventsList.Items.EndUpdate; Screen.Cursor := crDefault; end else Caption := FMainCaption+sNoFile; EventsList.Height := 8+EventsList.Count*(EventsList.ItemHeight{$ifndef MSWINDOWS}+4{$endif}); ProfileGroup.Top := EventsList.Top+EventsList.Height+12; MergedProfile.Top := ProfileGroup.Top+ProfileGroup.Height+2; y := MergedProfile.Top+32; BtnStats.Top := y; BtnMapSearch.Top := y; inc(y,32); ThreadGroup.Visible := (FLog<>nil) and (FLog.EventThread<>nil); if ThreadGroup.Visible then begin FThreadNames := FLog.ThreadNames(-1); ThreadGroup.Top := y; inc(y,ThreadGroup.Height+8); ThreadListBox.Items.BeginUpdate; ThreadListBox.Items.Clear; for i := 0 to FLog.ThreadsCount-1 do begin ThreadListBox.Items.Add(UTF8ToString(FThreadNames[i])); ThreadListBox.Checked[i] := true; end; ThreadListBox.Items.EndUpdate; end; lstDays.Visible := (FLog<>nil) and (FLog.DayChangeIndex<>nil); if lstDays.Visible then begin FLog.GetDays(FDays); lstDays.Top := y; lstDays.Items.BeginUpdate; lstDays.Items.Clear; for i := 0 to high(FDays) do lstDays.Items.Add(Format('%s (%d rows)',[DateToStr(FDays[i]), FLog.DayCount[i]])); lstDays.Items.EndUpdate; lstDays.ItemIndex := 0; PanelLeftResize(nil); end; ProfileGroup.ItemIndex := 0; MergedProfile.Checked := false; BtnFilterMenu(FMenuFilterAll); EventsList.Visible := FLog<>nil; ProfileGroup.Visible := (FLog<>nil) and (FLog.LogProcCount<>0); MergedProfile.Visible := ProfileGroup.Visible; BtnStats.Visible:= (FLog<>nil) and (FLog.EventLevel<>nil); BtnMapSearch.Visible := FLog<>nil; EditSearch.Visible := FLog<>nil; if FLog<>nil then EditSearch.SetFocus; BtnSearchNext.Visible := FLog<>nil; BtnSearchPrevious.Visible := FLog<>nil; lblServerRoot.Visible := FLog=nil; lblServerPort.Visible := FLog=nil; edtServerRoot.Visible := FLog=nil; edtServerPort.Visible := FLog=nil; btnServerLaunch.Visible := FLog=nil; btnListClear.Hide; btnListSave.Hide; List.Visible := FLog<>nil; EventsListClickCheck(nil); end; destructor TMainLogView.Destroy; begin FRemoteLogService.Free; FLog.Free; FLogUncompressed.Free; inherited; end; procedure TMainLogView.FormCreate(Sender: TObject); var F: TSynLogFilter; O: TLogProcSortOrder; M: TMenuItem; begin FMainCaption := format(Caption,[SYNOPSE_FRAMEWORK_VERSION])+' '; for F := low(F) to high(F) do begin M := TMenuItem.Create(self); M.Caption := ToCaption(F); M.Tag := ord(F); M.OnClick := BtnFilterMenu; if F=lfAll then FMenuFilterAll := M; FilterMenu.Items.Add(M); end; for O := low(O) to high(O) do ProfileGroup.Items.AddObject( GetCaptionFromEnum(TypeInfo(TLogProcSortOrder),Ord(O)),TObject(O)); ProfileList.ColWidths[0] := 60; ProfileList.ColWidths[1] := 1000; ProfileList.Hide; {$ifdef FPC} MemoBottom := TMemo.Create(self); {$else} MemoBottom := TMemoEx.Create(self); {$endif} MemoBottom.Parent := PanelBottom; MemoBottom.Align := alClient; MemoBottom.Font.Height := -11; if Screen.Fonts.IndexOf('Consolas') >= 0 then MemoBottom.Font.Name := 'Consolas' else MemoBottom.Font.Name := 'Courier New'; MemoBottom.ReadOnly := true; MemoBottom.ScrollBars := ssVertical; MemoBottom.Text := ''; end; procedure TMainLogView.FormShow(Sender: TObject); var CmdLine: TFileName; begin PanelThread.Width := 300; if ParamCount>0 then begin CmdLine := ParamStr(1); if SysUtils.DirectoryExists(CmdLine) then begin BtnBrowseClick(nil); {$ifdef FPC} Directory.Path := CmdLine; {$else} Directory.Directory := CmdLine; {$endif} end else LogFileName := CmdLine; end else begin {$ifdef FPC} Directory.Path := ExtractFileDir(ParamStr(0)); {$endif} LogFileName := ''; end; WindowState := wsMaximized; end; procedure TMainLogView.BtnFilterClick(Sender: TObject); var SenderBtn: TButton absolute Sender; begin if Sender.InheritsFrom(TButton) then with ClientToScreen(SenderBtn.BoundsRect.TopLeft) do SenderBtn.PopupMenu.Popup(X,Y+SenderBtn.Height); end; procedure TMainLogView.BtnFilterMenu(Sender: TObject); var F: TSynLogFilter; i: integer; begin if not Sender.InheritsFrom(TMenuItem) then exit; F := TSynLogFilter(TMenuItem(Sender).Tag); for i := 0 to EventsList.Count-1 do EventsList.Checked[i] := TSynLogInfo(EventsList.Items.Objects[i]) in LOG_FILTER[F]; EventsListClickCheck(nil); end; {$ifdef FPC} {$ifdef MSWINDOWS} {$define FPCCHECKBOXUNFIXED} // circumvent LCL issue under Windows {$endif} {$endif} procedure TMainLogView.EventsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var E: TSynLogInfo; {$ifdef FPCCHECKBOXUNFIXED} BRect: TRect; aTheme: TThemedElementDetails; {$endif} begin if Index<0 then exit; E := TSynLogInfo(EventsList.Items.Objects[Index]); inherited; with EventsList do begin Canvas.Brush.Color := LOG_LEVEL_COLORS[false,E]; Canvas.Font.Color := LOG_LEVEL_COLORS[true,E]; {$ifdef FPC} Canvas.FillRect(Rect); {$ifdef FPCCHECKBOXUNFIXED} BRect.Left := Rect.Left + 1; BRect.Top := Rect.Top; BRect.Bottom := Rect.Bottom; BRect.Right := Rect.Left + (Rect.Bottom - Rect.Top) - 2; if Checked[Index] then aTheme := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal) else aTheme := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal); ThemeServices.DrawElement(Canvas.Handle, aTheme, BRect); Rect.Left := BRect.Right; {$endif} {$endif} Canvas.TextRect(Rect,Rect.Left+4,Rect.Top{$ifndef MSWINDOWS}+4{$endif},ToCaption(E)); end; end; procedure TMainLogView.EventsListClickCheck(Sender: TObject); var i: integer; Sets: TSynLogInfos; begin if FLog=nil then List.RowCount := 0 else if FLog.EventLevel<>nil then begin integer(Sets) := 0; for i := 0 to EventsList.Count-1 do if EventsList.Checked[i] then Include(Sets,TSynLogInfo(EventsList.Items.Objects[i])); FLog.Events := Sets; i := FLog.Select(List.Row); if cardinal(i) < cardinal(FLog.SelectedCount) then List.Row := 0; // avoid "Grid Out Of Range" when setting RowCount List.RowCount := FLog.SelectedCount; if i>=0 then List.Row := i; end else List.RowCount := FLog.Count; SetListItem(List.Row); if List.Visible then begin List.Repaint; ListClick(nil); end; end; procedure TMainLogView.EventsListDblClick(Sender: TObject); var i: integer; begin if FLog.EventLevel=nil then // plain text file does not handle this exit; i := EventsList.ItemIndex; if i>=0 then i := fLog.SearchNextEvent(TSynLogInfo(EventsList.Items.Objects[i]),List.Row); if i>=0 then SetListItem(i); end; const TIME_FORMAT = 'hh:mm:ss.zzz'; MAXLOGLINES = 300; procedure TMainLogView.ListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var txt: string; inverted: boolean; level: TSynLogInfo; begin with List.Canvas do begin if FLog=nil then begin FillRect(Rect); exit; end; txt := FLog.GetCell(ACol,ARow,level); if FLog.EventLevel<>nil then begin Brush.Style := bsClear; if cardinal(ARow)=0 then SetListItem(ndx,s); finally Screen.Cursor := crDefault; end; end; procedure TMainLogView.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key=VK_F3 then begin if Shift=[] then BtnSearchNextClick(nil) else if ssShift in Shift then BtnSearchNextClick(BtnSearchPrevious) else exit; List.SetFocus; end else if (Shift=[ssCtrl]) and (Key=ord('F')) then EditSearch.SetFocus; end; procedure TMainLogView.ProfileListClick(Sender: TObject); var ndx,i: integer; begin i := ProfileList.Row; if (FLog<>Nil) and (cardinal(i)<=cardinal(FLog.LogProcCount)) then begin ndx := FLog.LogProc[i].Index; i := IntegerScanIndex(pointer(FLog.Selected),FLog.SelectedCount,ndx); if i>=0 then begin SetListItem(i); List.SetFocus; end; end; end; procedure TMainLogView.ProfileListDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); type TProfileListCol = (colTime, colName); var Tim: integer; s: string; begin if (FLog<>Nil) and (cardinal(ARow)nil) then begin ThreadListNameRefresh(i); ndx := FLog.EventThread[i]-1; if ndx<>ThreadListBox.ItemIndex then begin btnThread1.Caption := IntToStr(ndx+1); ThreadListBox.ItemIndex := ndx; ThreadListBoxClick(nil); end; end; if lstDays.Visible then begin ndx := lstDays.ItemIndex; if (cardinal(ndx)FDays[ndx]) then begin found := high(FLog.DayChangeIndex); for ndx := 1 to found do if FLog.DayChangeIndex[ndx]>i then begin found := ndx-1; break; end; lstDays.ItemIndex := found; end; end; end else if FLog<>nil then s := FLog.EventString(i,'',0,true) else s := ''; Selection := List.Selection; if Selection.Bottom>Selection.Top then begin elapsed := FLog.EventDateTime(Selection.Bottom)-FLog.EventDateTime(Selection.Top); if FLog.Freq=0 then begin DateTimeToString(tim,TIME_FORMAT,elapsed); s := tim+#13#10+s; end else begin tim := IntToStr(trunc(elapsed*MSecsPerDay*1000) mod 1000); s := StringOfChar('0',3-length(tim))+tim+#13#10+s; DateTimeToString(tim,TIME_FORMAT,elapsed); s := tim+'.'+s; end; s := format(sTimeInfo,[Selection.Bottom-Selection.Top+1,s]); end; if Pos(#9, s) > 0 then s := StringReplace(s, #9, ' ', [rfReplaceAll]); MemoBottom.Text := s; end; procedure TMainLogView.ListDblClick(Sender: TObject); var ndx: integer; begin ndx := fLog.SearchEnterLeave(List.Row); if ndx>=0 then SetListItem(ndx); end; procedure TMainLogView.BtnThreadNextClick(Sender: TObject); begin SetListItem(FLog.SearchNextThread(List.Row)); end; procedure TMainLogView.btnThreadDownClick(Sender: TObject); begin SetListItem(FLog.SearchNextSameThread(List.Row)); end; procedure TMainLogView.btnThreadUpClick(Sender: TObject); begin SetListItem(FLog.SearchPreviousSameThread(List.Row)); end; procedure TMainLogView.ThreadListBoxDblClick(Sender: TObject); var ID: cardinal; begin ID := ThreadListBox.ItemIndex; if ID=0 then F.Font.Name := 'Consolas' else F.Font.Name := 'Courier New'; F.Position := poScreenCenter; F.Width := 700; F.Height := 600; M := TMemo.Create(F); M.Parent := F; M.Align := alClient; M.ScrollBars := ssVertical; M.WordWrap := true; M.ReadOnly := true; if (FLog<>nil) and (FLog.EventLevel<>nil) then with FLog do begin if InstanceName<>'' then s := ' / '+UTF8ToString(InstanceName); if OS<>wUnknown then ostext := format(sWindowsStats,[WINDOWS_NAME[OS],ServicePack,BOOL_STR[Wow64]]) else ostext := UTF8ToString(DetailedOS); feat := ToText(IntelCPU,' '); if feat<>'' then feat := ' ' + LowerCase(feat); closed := EventDateTime(Count-1); elapsed := closed-StartDateTime; s := format(sStats, [FileName,StringOfChar('-',length(FileName)), DateTimeToStr(StartDateTime),DateTimeToStr(closed), trunc(elapsed),FormatDateTime('hh:mm:ss',elapsed), Count,LogProcCount,ThreadsCount,KB(Map.Size), UTF8ToString(ExecutableName),s,ExecutableVersion, DateTimeToStr(ExecutableDate),Framework,UTF8ToString(ComputerHost), UTF8ToString(RunningUser),CPU,feat,ostext]); fillchar(sets,sizeof(sets),0); for i := 0 to Count-1 do inc(sets[EventLevel[i]]); for i := 0 to EventsList.Count-1 do s := s+EventsList.Items[i]+': '+ IntToStr(sets[TSynLogInfo(EventsList.Items.Objects[i])])+#13#10; P := pointer(Headers); while (P<>nil) and (P^<>#0) do begin line := GetNextLine(P,P); Split(line,'=',name,value); if value<>'' then s := s+#13#10+UTF8ToString(name)+#13#10+StringOfChar('-',length(name))+ #13#10#13#10+UTF8ToString(StringReplaceAll(value,#9,#13#10))+#13#10; end; end; M.Text := s; F.ShowModal; finally F.Free; end; end; procedure TMainLogView.BtnOpenClick(Sender: TObject); begin if OpenDialog.Execute then LogFileName := OpenDialog.FileName; end; procedure TMainLogView.SetListItem(Index: integer; const search: RawUTF8=''); var i: integer; s,ss: string; begin if (Index<0) or (FLog=nil) then MemoBottom.Text := '' else begin List.Row := Index; if (search='') and List.Visible then List.SetFocus; if FLog.EventLevel<>nil then Index := FLog.Selected[Index]; s := FLog.EventString(Index,'',0,true); if Pos(#9, s) > 0 then s := StringReplace(s, #9, ' ', [rfReplaceAll]); MemoBottom.Text := s; if search<>'' then begin ss := UTF8ToString(search); i := Pos(ss,SysUtils.UpperCase(s)); if i>0 then begin MemoBottom.SelStart := i; MemoBottom.SelLength := length(ss); end; end; end; end; procedure TMainLogView.BtnMapSearchClick(Sender: TObject); var FN: TFileName; Addr: string; AddrInt, err: integer; Loc: RawUTF8; Map: TSynMapFile; begin if (FLog<>nil) and (FLog.ExecutableName<>'') then begin FN := ChangeFileExt(ExtractFileName(UTF8ToString(FLog.ExecutableName)),'.map'); FN := FN+';'+ChangeFileExt(FN,'.mab'); end; with TOpenDialog.Create(Application) do try DefaultExt := '.map'; Filter := '*.map;*.mab|*.map;*.mab'; if FN<>'' then Filter := FN+'|'+FN+'|'+Filter; Options := [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]; if not Execute then exit; Map := TSynMapFile.Create(FileName); try repeat if not InputQuery(BtnMapSearch.Hint,sEnterAddress,Addr) then Exit; Addr := SysUtils.Trim(Addr); if Addr='' then continue; if Addr[1]<>'$' then Addr := '$'+Addr; val(Addr,AddrInt,err); if err<>0 then continue; Loc := Map.FindLocation(AddrInt); if Loc<>'' then ShowMessage(Addr+#13#10+UTF8ToString(Loc)); until false; finally Map.Free; end; finally Free; end; end; procedure TMainLogView.MergedProfileClick(Sender: TObject); begin if FLog=nil then Exit; Screen.Cursor := crHourGlass; try FLog.LogProcMerged := MergedProfile.Checked; ProfileGroupClick(nil); finally Screen.Cursor := crDefault; end; end; procedure TMainLogView.ProfileGroupClick(Sender: TObject); var O: TLogProcSortOrder; begin O := TLogProcSortOrder(ProfileGroup.ItemIndex); if O=0 then begin FLog.Threads[i+1] := ThreadListBox.Checked[i]; EventsListClickCheck(nil); end; end; procedure TMainLogView.ThreadListNameRefresh(Index: integer); var names: TRawUTF8DynArray; i: integer; begin names := FLog.ThreadNames(Index); if names=nil then exit; for i := 0 to FLog.ThreadsCount-1 do if names[i]<>FThreadNames[i] then ThreadListBox.Items[i] := UTF8ToString(names[i]); FThreadNames := names; end; procedure TMainLogView.ThreadListBoxClick(Sender: TObject); var i: integer; begin i := ThreadListBox.ItemIndex; if i>=0 then begin lblThreadName.Caption := UTF8ToString(FThreadNames[i]); btnThread1.Caption := IntToStr(i+1); end; end; procedure TMainLogView.BtnBrowseClick(Sender: TObject); begin PanelBrowse.Visible := (Sender=nil) or not PanelBrowse.Visible; Splitter4.Visible := PanelBrowse.Visible; if PanelBrowse.Visible then Splitter4.Left := PanelBrowse.Left+PanelBrowse.Width; end; procedure TMainLogView.FilesClick(Sender: TObject); begin {$ifdef FPC} if (FLog=nil) or (FLog.FileName<>Files.Root) then if Files.Selected<>nil then LogFileName := Files.GetPathFromItem(Files.Selected); {$else} if (FLog=nil) or (FLog.FileName<>Files.FileName) then LogFileName := Files.FileName; {$endif} end; procedure TMainLogView.ListMenuCopyClick(Sender: TObject); var Selection: TGridRect; i: integer; s: string; begin Selection := List.Selection; for i := Selection.Top to Selection.Bottom do s := s+FLog.GetLineForClipboard(i)+sLineBreak; Clipboard.AsText := s; end; procedure TMainLogView.btnServerLaunchClick(Sender: TObject); var E: TSynLogInfo; i, BestFitHeight: integer; begin if FRemoteLogService=nil then try FRemoteLogService := TSQLHTTPRemoteLogServer.Create( StringToUTF8(edtServerRoot.Text),StrToInt(edtServerPort.Text),ReceivedOne); Caption := FMainCaption+sRemoteLog; except on E: Exception do begin ShowMessage(E.Message); exit; end; end; if FLog=nil then FLog := TSynLogFileView.Create; List.DoubleBuffered := true; List.ColCount := 4; List.ColWidths[0] := 70; List.ColWidths[1] := 60; List.ColWidths[2] := 24; List.ColWidths[3] := 2000; // Filtered remote log view support FLog.Events :=LOG_VERBOSE; EventsList.Items.Clear; EventsList.Items.BeginUpdate; try for E := succ(sllNone) to high(E) do begin EventsList.Items.AddObject(ToCaption(E),pointer(ord(E))); EventsList.Checked[EventsList.Count-1] := true; end; for i := 1 to FilterMenu.Items.Count-1 do FilterMenu.Items[i].Visible := true; finally EventsList.Items.EndUpdate; end; EventsList.Height := 8+EventsList.Count*EventsList.ItemHeight; EventsList.Show; btnListClear.Top := EventsList.Top+EventsList.Height+12; btnListClear.Width := EventsList.width div 2 - 2; btnListSave.Top := btnListClear.Top; btnListSave.Width := btnListClear.Width; btnListSave.Left := btnListClear.Left + btnListClear.Width + 4; if (btnListSave.Top + btnListSave.Height+12) > ImageLogo.top then begin BestFitHeight := height + btnListSave.Top + btnListSave.Height+12 - ImageLogo.top; if BestFitHeight > Screen.Height then height := Screen.Height else height := BestFitHeight; end; lblServerRoot.Hide; lblServerPort.Hide; edtServerRoot.Hide; edtServerPort.Hide; btnServerLaunch.Hide; btnListClear.Show; btnListSave.Show; EditSearch.Show; EditSearch.SetFocus; BtnSearchNext.Show; BtnSearchPrevious.Show; ReceivedOne(FormatUTF8( '%00 info Remote Logging Server started on port % with root name "%"', [NowToString(false),FRemoteLogService.Port,FRemoteLogService.Server.Model.Root])); List.Show; tmrRefresh.Enabled := true; end; const TAG_NONE = 0; TAG_REFRESH = 1; procedure TMainLogView.ReceivedOne(const Text: RawUTF8); var P: PUTF8Char; line: RawUTF8; begin // warning: this method is called from WebSockets thread, not UI thread P := pointer(Text); repeat // handle multiple log rows in the incoming text line := GetNextLine(P,P); if length(line)<24 then continue; FLog.AddInMemoryLine(line); tmrRefresh.Tag := TAG_REFRESH; // notify tmrRefreshTimer() until P=nil; end; procedure TMainLogView.tmrRefreshTimer(Sender: TObject); begin if (tmrRefresh.Tag = TAG_NONE) or (fLog = nil) then exit; // ReceivedOne() did not happen List.RowCount := FLog.SelectedCount; if FLog.SelectedCount > 0 then List.TopRow := FLog.SelectedCount-List.VisibleRowCount; List.Invalidate; tmrRefresh.Tag := TAG_NONE; end; procedure TMainLogView.btnListClearClick(Sender: TObject); begin FreeAndNil(FLog); btnServerLaunchClick(nil); end; procedure TMainLogView.btnListSaveClick(Sender: TObject); begin dlgSaveList.FileName := 'Remote '+Utf8ToString(DateTimeToIso8601(Now,false,' ')); if not dlgSaveList.Execute then exit; fLog.SaveToFile('temp~.log', StringToUTF8(ExeVersion.ProgramFileName)+' 0.0.0.0 ('+NowToString+')'#13+ 'Host=Remote User=Unknown CPU=Unknown OS=0.0=0.0.0 Wow64=0 Freq=1'#13+ 'LogView '+SYNOPSE_FRAMEWORK_VERSION+' Remote '+NowToString+#13#13); if dlgSaveList.FilterIndex=3 then FileSynLZ('temp~.log',dlgSaveList.FileName,LOG_MAGIC) else RenameFile('temp~.log',dlgSaveList.FileName); end; procedure TMainLogView.lstDaysDblClick(Sender: TObject); var ndx: integer; begin ndx := lstDays.ItemIndex; if cardinal(ndx) 0 then MemoBottom.RightMargin := (PanelBottom.ClientWidth div w) - 7; {$endif} end; end.