| 1 | unit fClientRPCLogger; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| 7 | StdCtrls, ExtCtrls, ComCtrls, Clipbrd, Menus, uRpcLogEntry; | 
|---|
| 8 |  | 
|---|
| 9 | type | 
|---|
| 10 | TfrmRpcClientLogger = class(TForm) | 
|---|
| 11 | cbxEnableRPCLogging: TCheckBox; | 
|---|
| 12 | lblMaxRPCEntries: TLabel; | 
|---|
| 13 | UpDown1: TUpDown; | 
|---|
| 14 | maxRpcLogEntriesNumericUpDown: TEdit; | 
|---|
| 15 | rpcLogListBox: TListBox; | 
|---|
| 16 | Panel1: TPanel; | 
|---|
| 17 | lblRPCName: TLabel; | 
|---|
| 18 | lblRPCDebugID: TLabel; | 
|---|
| 19 | lblClientName: TLabel; | 
|---|
| 20 | lblClientDebugID: TLabel; | 
|---|
| 21 | lblContext: TLabel; | 
|---|
| 22 | lblDuration: TLabel; | 
|---|
| 23 | edtRPCName: TEdit; | 
|---|
| 24 | edtRPCDebugID: TEdit; | 
|---|
| 25 | edtClientName: TEdit; | 
|---|
| 26 | edtClientDebugID: TEdit; | 
|---|
| 27 | edtContext: TEdit; | 
|---|
| 28 | edtDuration1: TEdit; | 
|---|
| 29 | lblParams: TLabel; | 
|---|
| 30 | lblResults: TLabel; | 
|---|
| 31 | MainMenu1: TMainMenu; | 
|---|
| 32 | PopupMenu1: TPopupMenu; | 
|---|
| 33 | File1: TMenuItem; | 
|---|
| 34 | mnuFileClose: TMenuItem; | 
|---|
| 35 | Edit1: TMenuItem; | 
|---|
| 36 | HGelp1: TMenuItem; | 
|---|
| 37 | mnuHelpAbout: TMenuItem; | 
|---|
| 38 | mnuEditCopyToClipboard: TMenuItem; | 
|---|
| 39 | mnuPopupCopyToClipboard: TMenuItem; | 
|---|
| 40 | ParamsMemoBox: TRichEdit; | 
|---|
| 41 | ResultsMemoBox: TRichEdit; | 
|---|
| 42 | Edit2: TEdit; | 
|---|
| 43 | btnClose: TButton; | 
|---|
| 44 | procedure FormClose(Sender: TObject; var Action: TCloseAction); | 
|---|
| 45 | procedure UpDown1Click(Sender: TObject; Button: TUDBtnType); | 
|---|
| 46 | procedure mnuEditCopyToClipboardClick(Sender: TObject); | 
|---|
| 47 | procedure rpcLogListBoxClick(Sender: TObject); | 
|---|
| 48 | procedure mnuPopupCopyToClipboardClick(Sender: TObject); | 
|---|
| 49 | procedure mnuFileCloseClick(Sender: TObject); | 
|---|
| 50 | procedure btnCloseClick(Sender: TObject); | 
|---|
| 51 | private | 
|---|
| 52 | { Private declarations } | 
|---|
| 53 | public | 
|---|
| 54 | { Public declarations } | 
|---|
| 55 | procedure DisplayRpcEntry(entry: TRpcLogEntry); | 
|---|
| 56 | procedure AddRpcLogEntry(entry: TRPCLogEntry; overrideCheckBox: Boolean); | 
|---|
| 57 | end; | 
|---|
| 58 |  | 
|---|
| 59 | var | 
|---|
| 60 | frmRpcClientLogger: TfrmRpcClientLogger; | 
|---|
| 61 |  | 
|---|
| 62 | implementation | 
|---|
| 63 |  | 
|---|
| 64 | {$R *.DFM} | 
|---|
| 65 |  | 
|---|
| 66 | procedure TfrmRpcClientLogger.AddRpcLogEntry(entry: TRPCLogEntry; overrideCheckBox: Boolean); | 
|---|
| 67 | var | 
|---|
| 68 | Str, Str1: String; | 
|---|
| 69 | Max: Integer; | 
|---|
| 70 | begin | 
|---|
| 71 | if (cbxEnableRPCLogging.Checked or overrideCheckBox) then | 
|---|
| 72 | begin | 
|---|
| 73 | // If the list is full we need to delete the 0th item till we have room for one. | 
|---|
| 74 | while (rpcLogListBox.Items.Count >= StrToInt(maxRpcLogEntriesNumericUpDown.Text)) do | 
|---|
| 75 | rpcLogListBox.Items.Delete(0); | 
|---|
| 76 | with entry do | 
|---|
| 77 | begin | 
|---|
| 78 | Max := 30; | 
|---|
| 79 | if Length(Name) > 30 then | 
|---|
| 80 | Max := Length(Name); | 
|---|
| 81 | Str := Copy(Name+'                                                   ',1,Max); | 
|---|
| 82 | Str1 := '      '+IntToStr(Duration); | 
|---|
| 83 | Str := Str + '   cId: '+IntToStr(UniqueClientId)+'  time ='+Copy(Str1,Length(Str1)-5,Length(Str1))+' ms   rpcId: '+IntToStr(UniqueId)+'   '+ClientName; | 
|---|
| 84 | end;    // with | 
|---|
| 85 | rpcLogListBox.Items.AddObject(Str, entry); | 
|---|
| 86 | end; | 
|---|
| 87 | end; | 
|---|
| 88 |  | 
|---|
| 89 | procedure TfrmRpcClientLogger.FormClose(Sender: TObject; var Action: TCloseAction); | 
|---|
| 90 | begin | 
|---|
| 91 | // | 
|---|
| 92 | end; | 
|---|
| 93 | procedure TfrmRpcClientLogger.UpDown1Click(Sender: TObject; Button: TUDBtnType); | 
|---|
| 94 | begin | 
|---|
| 95 | // | 
|---|
| 96 | end; | 
|---|
| 97 |  | 
|---|
| 98 | procedure TfrmRpcClientLogger.mnuEditCopyToClipboardClick(Sender: TObject); | 
|---|
| 99 | begin | 
|---|
| 100 | if RpcLogListBox.ItemIndex > -1 then | 
|---|
| 101 | mnuPopupCopyToClipboardClick(Self); | 
|---|
| 102 | end; | 
|---|
| 103 | procedure TfrmRpcClientLogger.rpcLogListBoxClick(Sender: TObject); | 
|---|
| 104 | begin | 
|---|
| 105 | DisplayRpcEntry(TRpcLogEntry(rpcLogListBox.Items.Objects[rpcLogListBox.ItemIndex])); | 
|---|
| 106 | mnuEditCopyToClipboard.Enabled := True; | 
|---|
| 107 | end; | 
|---|
| 108 |  | 
|---|
| 109 | procedure TfrmRpcClientLogger.mnuPopupCopyToClipboardClick(Sender: TObject); | 
|---|
| 110 | var | 
|---|
| 111 | RPCEntry: TRpcLogEntry; | 
|---|
| 112 | begin | 
|---|
| 113 | RPCEntry := TRpcLogEntry(RpcLogListBox.Items.Objects[RpcLogListBox.ItemIndex]); | 
|---|
| 114 | Edit2.Text := RPCEntry.CreateClipBoardString; | 
|---|
| 115 | Edit2.SelectAll; | 
|---|
| 116 | Edit2.CopyToClipBoard; | 
|---|
| 117 | end; | 
|---|
| 118 |  | 
|---|
| 119 |  | 
|---|
| 120 |  | 
|---|
| 121 | //    private void rpcLogListBox_SelectedIndexChanged(object sender, System.EventArgs e) | 
|---|
| 122 |  | 
|---|
| 123 | procedure TfrmRpcClientLogger.DisplayRpcEntry(entry: TRpcLogEntry); | 
|---|
| 124 | var | 
|---|
| 125 | Str : String; | 
|---|
| 126 | begin | 
|---|
| 127 | Str := entry.CreateParamsDisplayString; //.Split('\n'); | 
|---|
| 128 | ParamsMemoBox.Lines.Clear; | 
|---|
| 129 | ParamsMemoBox.Lines.Add(Str); | 
|---|
| 130 |  | 
|---|
| 131 | resultsMemoBox.Text      := entry.CreateResultsDisplayString(); | 
|---|
| 132 | edtRpcName.Text      := entry.Name; | 
|---|
| 133 | edtRPCDebugId.Text    := IntToStr(entry.UniqueId); | 
|---|
| 134 | edtContext.Text      := entry.Context; | 
|---|
| 135 | if(entry.Duration < 1) then | 
|---|
| 136 | edtDuration1.Text := '<1ms' | 
|---|
| 137 | else | 
|---|
| 138 | edtDuration1.Text := IntToStr(entry.Duration) + ' ms'; | 
|---|
| 139 | edtClientName.Text    := entry.ClientName; | 
|---|
| 140 | edtClientDebugId.Text  := IntToStr(entry.UniqueClientId); | 
|---|
| 141 | end; | 
|---|
| 142 |  | 
|---|
| 143 | { | 
|---|
| 144 | procedure TfrmRpcClientLogger.FormClose(Sender: TObject; | 
|---|
| 145 | var Action: TCloseAction); | 
|---|
| 146 | begin | 
|---|
| 147 | OnRpcLoggerClose(Self,nil); | 
|---|
| 148 | end; | 
|---|
| 149 |  | 
|---|
| 150 | procedure TfrmRpcClientLogger.UpDown1Click(Sender: TObject; | 
|---|
| 151 | Button: TUDBtnType); | 
|---|
| 152 | begin | 
|---|
| 153 | // In case the max entry value is less than the rpc log entries delete the entries | 
|---|
| 154 | while (StrToInt(maxRpcLogEntriesNumericUpDown.Text) < rpcLogListBox.Items.Count) | 
|---|
| 155 | rpcLogListBox.Items.Delete(0); | 
|---|
| 156 | end; | 
|---|
| 157 |  | 
|---|
| 158 | procedure TfrmRpcClientLogger.mnuEditCopyToClipboardClick(Sender: TObject); | 
|---|
| 159 | var | 
|---|
| 160 | Clip: TClipBoard; | 
|---|
| 161 | begin | 
|---|
| 162 | // Build a string and put it on the clipboard here. | 
|---|
| 163 | //      Clipboard.SetDataObject(((RpcLogEntry)rpcLogListBox.SelectedItem).CreateClipboardString()); | 
|---|
| 164 | Clip ::= ClipBoard; | 
|---|
| 165 | Clip.SetTextBuf(PChar((RpcLogEntry)(rpcLogListBox.Items[rpcLogListBox.ItemIndex]).CreateClipboardString)); | 
|---|
| 166 | end; | 
|---|
| 167 |  | 
|---|
| 168 | procedure TfrmRpcClientLogger.rpcLogListBoxClick(Sender: TObject); | 
|---|
| 169 | begin | 
|---|
| 170 | DisplayRpcEntry((RpcLogEntry)rpcLogListBox.Items[rpcLogListBox.SelectedIndex]); | 
|---|
| 171 | mnuEditCopyToClipboard.Enabled := True; | 
|---|
| 172 | end; | 
|---|
| 173 |  | 
|---|
| 174 | procedure TfrmRpcClientLogger.mnuPopupCopyToClipboardClick( | 
|---|
| 175 | Sender: TObject); | 
|---|
| 176 | begin | 
|---|
| 177 | mnuEditCopyToClipboardClick(Sender); | 
|---|
| 178 | end; | 
|---|
| 179 | } | 
|---|
| 180 | procedure TfrmRpcClientLogger.mnuFileCloseClick(Sender: TObject); | 
|---|
| 181 | begin | 
|---|
| 182 | Self.Visible := False; | 
|---|
| 183 | end; | 
|---|
| 184 |  | 
|---|
| 185 | procedure TfrmRpcClientLogger.btnCloseClick(Sender: TObject); | 
|---|
| 186 | begin | 
|---|
| 187 | Self.Visible := False; | 
|---|
| 188 | end; | 
|---|
| 189 |  | 
|---|
| 190 | end. | 
|---|