From 139f1dded2095ef8b3610b76c66698c81ae1c4f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Thu, 25 Oct 2018 12:50:01 +0200 Subject: [PATCH] Added memory information properties to GlobalCEFApp --- demos/CookieVisitor/CookieVisitor.dproj | 28 +++ demos/CookieVisitor/uCookieVisitor.pas | 2 +- demos/MiniBrowser/uMiniBrowser.dfm | 11 +- demos/MiniBrowser/uMiniBrowser.pas | 17 ++ demos/SimpleBrowser2/SimpleBrowser2.dpr | 2 +- demos/SimpleBrowser2/uSimpleBrowser2.pas | 4 +- .../SimpleLazarusBrowser.lps | 179 +++++++++++++++--- .../usimplelazarusbrowser.lfm | 2 +- .../usimplelazarusbrowser.pas | 2 - source/uCEFApplication.pas | 122 +++++++++++- source/uCEFMiscFunctions.pas | 17 +- source/uCEFTypes.pas | 14 ++ 12 files changed, 351 insertions(+), 49 deletions(-) diff --git a/demos/CookieVisitor/CookieVisitor.dproj b/demos/CookieVisitor/CookieVisitor.dproj index 244fdcb4..b2cb3d82 100644 --- a/demos/CookieVisitor/CookieVisitor.dproj +++ b/demos/CookieVisitor/CookieVisitor.dproj @@ -34,6 +34,12 @@ true true + + true + Cfg_1 + true + true + true Base @@ -45,6 +51,12 @@ true true + + true + Cfg_2 + true + true + .\$(Platform)\$(Config) false @@ -60,6 +72,7 @@ 3082 CookieVisitor CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + ..\..\bin DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;vclFireDAC;FireDACDb2Driver;GR32_DSGN_RSXE5;DataSnapFireDAC;svnui;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;CEF4Delphi;DbxCommonDriver;IndyProtocols240;IndySystem240;fmx;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;IndyCore240;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;GR32_RSXE5;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;bindcompvcl;DataSnapConnectors;VCLRESTComponents;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;DataSnapClient;DataSnapServerMidas;$(DCC_UsePackage) @@ -72,6 +85,11 @@ DBXSqliteDriver;bindcompdbx;fmxase;DBXDb2Driver;DBXInterBaseDriver;vcl;DBXSybaseASEDriver;vclactnband;vclFireDAC;FireDACDb2Driver;DataSnapFireDAC;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;DBXMSSQLDriver;vclimg;FireDACInfxDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;FireDACPgDriver;DBXOracleDriver;inetdb;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;DbxCommonDriver;IndyProtocols240;IndySystem240;fmx;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;fmxdae;vclwinx;rtl;FireDACDSDriver;DbxClientDriver;IndyCore240;DBXSybaseASADriver;CustomIPTransport;vcldsnap;dbexpress;FireDACDBXDriver;vclx;bindcomp;appanalytics;dsnap;DataSnapCommon;DBXInformixDriver;bindcompvcl;DataSnapConnectors;VCLRESTComponents;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;DBXFirebirdDriver;DataSnapProviderClient;FireDACMongoDBDriver;FireDACCommonODBC;DataSnapClient;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + 1033 + $(BDS)\bin\default_app.manifest DEBUG;$(DCC_Define) @@ -88,6 +106,12 @@ true 1033 + + true + true + true + 1033 + false RELEASE;$(DCC_Define) @@ -98,6 +122,10 @@ true true + + true + true + MainSource diff --git a/demos/CookieVisitor/uCookieVisitor.pas b/demos/CookieVisitor/uCookieVisitor.pas index 41df93f8..f8f69ea2 100644 --- a/demos/CookieVisitor/uCookieVisitor.pas +++ b/demos/CookieVisitor/uCookieVisitor.pas @@ -126,7 +126,7 @@ implementation {$R *.dfm} uses - uSimpleTextViewer; + uSimpleTextViewer, uCEFTask, uCEFMiscFunctions; // This demo has a context menu to test the DeleteCookies function and a CookieVisitor example. diff --git a/demos/MiniBrowser/uMiniBrowser.dfm b/demos/MiniBrowser/uMiniBrowser.dfm index e0d180e6..9ae66350 100644 --- a/demos/MiniBrowser/uMiniBrowser.dfm +++ b/demos/MiniBrowser/uMiniBrowser.dfm @@ -38,7 +38,7 @@ object MiniBrowserFrm: TMiniBrowserFrm BevelOuter = bvNone Enabled = False ShowCaption = False - TabOrder = 0 + TabOrder = 1 object NavButtonPnl: TPanel Left = 0 Top = 0 @@ -221,7 +221,7 @@ object MiniBrowserFrm: TMiniBrowserFrm Height = 652 Align = alClient TabStop = True - TabOrder = 1 + TabOrder = 0 end object DevTools: TCEFWindowParent Left = 1184 @@ -337,6 +337,13 @@ object MiniBrowserFrm: TMiniBrowserFrm Caption = 'Resolve host...' OnClick = Resolvehost1Click end + object N5: TMenuItem + Caption = '-' + end + object Memoryinfo1: TMenuItem + Caption = 'Memory info...' + OnClick = Memoryinfo1Click + end end object SaveDialog1: TSaveDialog Left = 32 diff --git a/demos/MiniBrowser/uMiniBrowser.pas b/demos/MiniBrowser/uMiniBrowser.pas index 0dd7c287..2615e5b4 100644 --- a/demos/MiniBrowser/uMiniBrowser.pas +++ b/demos/MiniBrowser/uMiniBrowser.pas @@ -116,6 +116,8 @@ type Resolvehost1: TMenuItem; Timer1: TTimer; OpenfilewithaDAT1: TMenuItem; + N5: TMenuItem; + Memoryinfo1: TMenuItem; procedure FormShow(Sender: TObject); procedure BackBtnClick(Sender: TObject); procedure ForwardBtnClick(Sender: TObject); @@ -198,6 +200,7 @@ type procedure OpenfilewithaDAT1Click(Sender: TObject); procedure Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; httpStatusCode: Integer); + procedure Memoryinfo1Click(Sender: TObject); protected FResponse : TStringList; @@ -741,6 +744,20 @@ begin end; end; +procedure TMiniBrowserFrm.Memoryinfo1Click(Sender: TObject); +const + BYTES_PER_MEGABYTE = 1024 * 1024; +var + TempMessage : string; +begin + TempMessage := 'Total memory used by this application : ' + inttostr(GlobalCEFApp.UsedMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF + + 'Total system memory : ' + inttostr(GlobalCEFApp.TotalSystemMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF + + 'Available physical memory : ' + inttostr(GlobalCEFApp.AvailableSystemMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF + + 'Memory load : ' + inttostr(GlobalCEFApp.SystemMemoryLoad) + ' %'; + + MessageDlg(TempMessage, mtInformation, [mbOK], 0); +end; + procedure TMiniBrowserFrm.Chromium1ResourceResponse(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const request: ICefRequest; const response: ICefResponse; diff --git a/demos/SimpleBrowser2/SimpleBrowser2.dpr b/demos/SimpleBrowser2/SimpleBrowser2.dpr index 5030c1af..2213bebb 100644 --- a/demos/SimpleBrowser2/SimpleBrowser2.dpr +++ b/demos/SimpleBrowser2/SimpleBrowser2.dpr @@ -47,7 +47,7 @@ uses Forms, Windows, {$ENDIF } - uCEFApplication, + uCEFApplication, uCEFConstants, uSimpleBrowser2 in 'uSimpleBrowser2.pas' {Form1}; {$R *.res} diff --git a/demos/SimpleBrowser2/uSimpleBrowser2.pas b/demos/SimpleBrowser2/uSimpleBrowser2.pas index 67446562..889ffe71 100644 --- a/demos/SimpleBrowser2/uSimpleBrowser2.pas +++ b/demos/SimpleBrowser2/uSimpleBrowser2.pas @@ -103,7 +103,7 @@ implementation {$R *.dfm} uses - uCEFApplication; + uCEFApplication, uCefMiscFunctions; // This is a demo with the simplest web browser you can build using CEF4Delphi and // it doesn't show any sign of progress like other web browsers do. @@ -141,6 +141,7 @@ procedure TForm1.FormCreate(Sender: TObject); begin FCanClose := False; FClosing := False; + Chromium1.DefaultURL := AddressEdt.Text; end; procedure TForm1.FormShow(Sender: TObject); @@ -190,7 +191,6 @@ procedure TForm1.BrowserCreatedMsg(var aMessage : TMessage); begin Caption := 'Simple Browser 2'; AddressPnl.Enabled := True; - GoBtn.Click; end; procedure TForm1.BrowserDestroyMsg(var aMessage : TMessage); diff --git a/demos/SimpleLazarusBrowser/SimpleLazarusBrowser.lps b/demos/SimpleLazarusBrowser/SimpleLazarusBrowser.lps index c064205b..7cbff02e 100644 --- a/demos/SimpleLazarusBrowser/SimpleLazarusBrowser.lps +++ b/demos/SimpleLazarusBrowser/SimpleLazarusBrowser.lps @@ -4,14 +4,14 @@ - + - + @@ -22,9 +22,9 @@ - - - + + + @@ -132,21 +132,21 @@ - - + + - - - - + + + + @@ -225,17 +225,18 @@ - - - + + + - - - + + + + @@ -274,38 +275,160 @@ + - - - + - - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/demos/SimpleLazarusBrowser/usimplelazarusbrowser.lfm b/demos/SimpleLazarusBrowser/usimplelazarusbrowser.lfm index 8f6a8fb4..bf0f1c16 100644 --- a/demos/SimpleLazarusBrowser/usimplelazarusbrowser.lfm +++ b/demos/SimpleLazarusBrowser/usimplelazarusbrowser.lfm @@ -10,7 +10,7 @@ object Form1: TForm1 OnCreate = FormCreate OnShow = FormShow Position = poScreenCenter - LCLVersion = '1.8.2.0' + LCLVersion = '1.8.4.0' object AddressPnl: TPanel Left = 0 Height = 23 diff --git a/demos/SimpleLazarusBrowser/usimplelazarusbrowser.pas b/demos/SimpleLazarusBrowser/usimplelazarusbrowser.pas index d23e474d..7ece4bd8 100644 --- a/demos/SimpleLazarusBrowser/usimplelazarusbrowser.pas +++ b/demos/SimpleLazarusBrowser/usimplelazarusbrowser.pas @@ -47,9 +47,7 @@ uses uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes, uCEFChromiumEvents; type - { TForm1 } - TForm1 = class(TForm) CEFWindowParent1: TCEFWindowParent; Chromium1: TChromium; diff --git a/source/uCEFApplication.pas b/source/uCEFApplication.pas index 916cf136..b26f7e7a 100644 --- a/source/uCEFApplication.pas +++ b/source/uCEFApplication.pas @@ -196,6 +196,10 @@ type function GetMustCreateRenderProcessHandler : boolean; function GetGlobalContextInitialized : boolean; function GetChildProcessesCount : integer; + function GetUsedMemory : cardinal; + function GetTotalSystemMemory : uint64; + function GetAvailableSystemMemory : uint64; + function GetSystemMemoryLoad : cardinal; function LoadCEFlibrary : boolean; virtual; function Load_cef_app_capi_h : boolean; @@ -373,6 +377,10 @@ type property MustFreeLibrary : boolean read FMustFreeLibrary write FMustFreeLibrary; property AutoplayPolicy : TCefAutoplayPolicy read FAutoplayPolicy write FAutoplayPolicy; property ChildProcessesCount : integer read GetChildProcessesCount; + property UsedMemory : cardinal read GetUsedMemory; + property TotalSystemMemory : uint64 read GetTotalSystemMemory; + property AvailableSystemMemory : uint64 read GetAvailableSystemMemory; + property SystemMemoryLoad : cardinal read GetSystemMemoryLoad; property OnRegCustomSchemes : TOnRegisterCustomSchemesEvent read FOnRegisterCustomSchemes write FOnRegisterCustomSchemes; @@ -432,13 +440,13 @@ implementation uses {$IFDEF DELPHI16_UP} - System.Math, System.IOUtils, System.SysUtils, {$IFDEF MSWINDOWS}WinApi.TlHelp32,{$ENDIF} + System.Math, System.IOUtils, System.SysUtils, {$IFDEF MSWINDOWS}WinApi.TlHelp32, PSAPI,{$ENDIF} {$ELSE} Math, {$IFDEF DELPHI14_UP}IOUtils,{$ENDIF} SysUtils, {$IFDEF FPC} - {$IFDEF MSWINDOWS}jwatlhelp32,{$ENDIF} + {$IFDEF MSWINDOWS}jwatlhelp32, jwapsapi,{$ENDIF} {$ELSE} - TlHelp32, + TlHelp32, {$IFDEF MSWINDOWS}PSAPI,{$ENDIF} {$ENDIF} {$ENDIF} uCEFLibFunctions, uCEFMiscFunctions, uCEFCommandLine, uCEFConstants, @@ -1519,7 +1527,10 @@ begin Result := 0; {$IFDEF MSWINDOWS} - TempHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); + TempHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); + if (TempHandle = INVALID_HANDLE_VALUE) then exit; + + ZeroMemory(@TempProcess, SizeOf(TProcessEntry32)); TempProcess.dwSize := Sizeof(TProcessEntry32); TempPID := GetCurrentProcessID; TempMain := ExtractFileName(paramstr(0)); @@ -1544,6 +1555,109 @@ begin {$ENDIF} end; +function TCefApplication.GetUsedMemory : cardinal; +{$IFDEF MSWINDOWS} +var + TempHandle : THandle; + TempProcess : TProcessEntry32; + TempPID : DWORD; + TempProcHWND : HWND; + TempMemCtrs : TProcessMemoryCounters; + TempMain, TempSubProc, TempName : string; +{$ENDIF} +begin + Result := 0; + +{$IFDEF MSWINDOWS} + TempHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); + if (TempHandle = INVALID_HANDLE_VALUE) then exit; + + ZeroMemory(@TempProcess, SizeOf(TProcessEntry32)); + TempProcess.dwSize := Sizeof(TProcessEntry32); + TempPID := GetCurrentProcessID; + TempMain := ExtractFileName(paramstr(0)); + TempSubProc := ExtractFileName(FBrowserSubprocessPath); + + Process32First(TempHandle, TempProcess); + + repeat + if (TempProcess.th32ProcessID = TempPID) or + (TempProcess.th32ParentProcessID = TempPID) then + begin + TempName := TempProcess.szExeFile; + TempName := ExtractFileName(TempName); + + if (CompareText(TempName, TempMain) = 0) or + ((length(TempSubProc) > 0) and (CompareText(TempName, TempSubProc) = 0)) then + begin + TempProcHWND := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, TempProcess.th32ProcessID); + + if (TempProcHWND <> 0) then + begin + ZeroMemory(@TempMemCtrs, SizeOf(TProcessMemoryCounters)); + TempMemCtrs.cb := SizeOf(TProcessMemoryCounters); + + {$IFDEF FPC} + if GetProcessMemoryInfo(TempProcHWND, TempMemCtrs, TempMemCtrs.cb) then inc(Result, TempMemCtrs.WorkingSetSize); + {$ELSE} + if GetProcessMemoryInfo(TempProcHWND, @TempMemCtrs, TempMemCtrs.cb) then inc(Result, TempMemCtrs.WorkingSetSize); + {$ENDIF} + + CloseHandle(TempProcHWND); + end; + end; + end; + until not(Process32Next(TempHandle, TempProcess)); + + CloseHandle(TempHandle); +{$ENDIF} +end; + +function TCefApplication.GetTotalSystemMemory : uint64; +{$IFDEF MSWINDOWS} +var + TempMemStatus : TMyMemoryStatusEx; +{$ENDIF} +begin + Result := 0; + + {$IFDEF MSWINDOWS} + ZeroMemory(@TempMemStatus, SizeOf(TMyMemoryStatusEx)); + TempMemStatus.dwLength := SizeOf(TMyMemoryStatusEx); + if GetGlobalMemoryStatusEx(TempMemStatus) then Result := TempMemStatus.ullTotalPhys; + {$ENDIF} +end; + +function TCefApplication.GetAvailableSystemMemory : uint64; +{$IFDEF MSWINDOWS} +var + TempMemStatus : TMyMemoryStatusEx; +{$ENDIF} +begin + Result := 0; + + {$IFDEF MSWINDOWS} + ZeroMemory(@TempMemStatus, SizeOf(TMyMemoryStatusEx)); + TempMemStatus.dwLength := SizeOf(TMyMemoryStatusEx); + if GetGlobalMemoryStatusEx(TempMemStatus) then Result := TempMemStatus.ullAvailPhys; + {$ENDIF} +end; + +function TCefApplication.GetSystemMemoryLoad : cardinal; +{$IFDEF MSWINDOWS} +var + TempMemStatus : TMyMemoryStatusEx; +{$ENDIF} +begin + Result := 0; + + {$IFDEF MSWINDOWS} + ZeroMemory(@TempMemStatus, SizeOf(TMyMemoryStatusEx)); + TempMemStatus.dwLength := SizeOf(TMyMemoryStatusEx); + if GetGlobalMemoryStatusEx(TempMemStatus) then Result := TempMemStatus.dwMemoryLoad; + {$ENDIF} +end; + function TCefApplication.LoadCEFlibrary : boolean; var TempOldDir, TempString : string; diff --git a/source/uCEFMiscFunctions.pas b/source/uCEFMiscFunctions.pas index 5a4cb895..acec22b8 100644 --- a/source/uCEFMiscFunctions.pas +++ b/source/uCEFMiscFunctions.pas @@ -127,6 +127,7 @@ function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInforma function PathIsRelativeAnsi(pszPath: LPCSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsRelativeA'; function PathIsRelativeUnicode(pszPath: LPCWSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsRelativeW'; +function GetGlobalMemoryStatusEx(var Buffer: TMyMemoryStatusEx): BOOL; stdcall; external Kernel32DLL name 'GlobalMemoryStatusEx'; {$IFNDEF DELPHI12_UP} {$IFDEF WIN64} @@ -422,11 +423,11 @@ var TempTime : TSystemTime; begin Result := 0; - - try - TempTime := CefTimeToSystemTime(dt); + + try + TempTime := CefTimeToSystemTime(dt); SystemTimeToTzSpecificLocalTime(nil, @TempTime, @TempTime); - Result := SystemTimeToDateTime(TempTime); + Result := SystemTimeToDateTime(TempTime); except on e : exception do if CustomExceptionHandler('CefTimeToDateTime', e) then raise; @@ -438,11 +439,11 @@ var TempTime : TSystemTime; begin FillChar(Result, SizeOf(TCefTime), 0); - - try - DateTimeToSystemTime(dt, TempTime); + + try + DateTimeToSystemTime(dt, TempTime); TzSpecificLocalTimeToSystemTime(nil, @TempTime, @TempTime); - Result := SystemTimeToCefTime(TempTime); + Result := SystemTimeToCefTime(TempTime); except on e : exception do if CustomExceptionHandler('DateTimeToCefTime', e) then raise; diff --git a/source/uCEFTypes.pas b/source/uCEFTypes.pas index 51bd1eaa..85a5a533 100644 --- a/source/uCEFTypes.pas +++ b/source/uCEFTypes.pas @@ -2953,6 +2953,20 @@ type on_key_event : function(self: PCefWindowDelegate; window: PCefWindow; const event: PCefKeyEvent): Integer; stdcall; end; + {$IFDEF MSWINDOWS} + TMyMemoryStatusEx = record + dwLength : DWORD; + dwMemoryLoad : DWORD; + ullTotalPhys : uint64; + ullAvailPhys : uint64; + ullTotalPageFile : uint64; + ullAvailPageFile : uint64; + ullTotalVirtual : uint64; + ullAvailVirtual : uint64; + ullAvailExtendedVirtual : uint64; + end; + {$ENDIF} + implementation end.