mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2024-11-16 00:05:55 +01:00
858f1a1625
Added more code comments in the TabbedBrowser2 demo. Removed FastMM4 from the SimpleOSRBrowser demo. Modified TCEFWorkScheduler for FPC in Linux.
2422 lines
82 KiB
ObjectPascal
2422 lines
82 KiB
ObjectPascal
// ************************************************************************
|
|
// ***************************** CEF4Delphi *******************************
|
|
// ************************************************************************
|
|
//
|
|
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
|
|
// browser in Delphi applications.
|
|
//
|
|
// The original license of DCEF3 still applies to CEF4Delphi.
|
|
//
|
|
// For more information about CEF4Delphi visit :
|
|
// https://www.briskbard.com/index.php?lang=en&pageid=cef
|
|
//
|
|
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
|
|
//
|
|
// ************************************************************************
|
|
// ************ vvvv Original license and comments below vvvv *************
|
|
// ************************************************************************
|
|
(*
|
|
* Delphi Chromium Embedded 3
|
|
*
|
|
* Usage allowed under the restrictions of the Lesser GNU General Public License
|
|
* or alternatively the restrictions of the Mozilla Public License 1.1
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
* the specific language governing rights and limitations under the License.
|
|
*
|
|
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
|
|
* Web site : http://www.progdigy.com
|
|
* Repository : http://code.google.com/p/delphichromiumembedded/
|
|
* Group : http://groups.google.com/group/delphichromiumembedded
|
|
*
|
|
* Embarcadero Technologies, Inc is not permitted to use or redistribute
|
|
* this source code without explicit permission.
|
|
*
|
|
*)
|
|
|
|
unit uCEFMiscFunctions;
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE OBJFPC}{$H+}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
|
|
{$MINENUMSIZE 4}
|
|
|
|
{$I cef.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DELPHI16_UP}
|
|
{$IFDEF MSWINDOWS}
|
|
WinApi.Windows, WinApi.ActiveX, {$IFDEF FMX}FMX.Types,{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF FMX}FMX.Types,{$ENDIF} {$IFDEF MACOS}Macapi.Foundation, FMX.Helpers.Mac,{$ENDIF}
|
|
{$ENDIF}
|
|
System.Types, System.IOUtils, System.Classes, System.SysUtils, System.UITypes, System.Math,
|
|
{$ELSE}
|
|
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF}
|
|
{$IFDEF DELPHI14_UP}Types, IOUtils,{$ENDIF} Classes, SysUtils, Math,
|
|
{$IFDEF FPC}LCLType,{$IFNDEF MSWINDOWS}InterfaceBase, Forms,{$ENDIF}{$ENDIF}
|
|
{$ENDIF}
|
|
uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFResourceHandler,
|
|
uCEFRegisterCDMCallback, uCEFConstants;
|
|
|
|
const
|
|
Kernel32DLL = 'kernel32.dll';
|
|
SHLWAPIDLL = 'shlwapi.dll';
|
|
NTDLL = 'ntdll.dll';
|
|
User32DLL = 'User32.dll';
|
|
|
|
type
|
|
TOSVersionInfoEx = record
|
|
dwOSVersionInfoSize: DWORD;
|
|
dwMajorVersion: DWORD;
|
|
dwMinorVersion: DWORD;
|
|
dwBuildNumber: DWORD;
|
|
dwPlatformId: DWORD;
|
|
szCSDVersion: array[0..127] of WideChar;
|
|
wServicePackMajor: WORD;
|
|
wServicePackMinor: WORD;
|
|
wSuiteMask: WORD;
|
|
wProductType: BYTE;
|
|
wReserved:BYTE;
|
|
end;
|
|
{$IFDEF DELPHI14_UP}
|
|
TDigitizerStatus = record
|
|
IntegratedTouch : boolean;
|
|
ExternalTouch : boolean;
|
|
IntegratedPen : boolean;
|
|
ExternalPen : boolean;
|
|
MultiInput : boolean;
|
|
Ready : boolean;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function CefColorGetA(color: TCefColor): Byte;
|
|
function CefColorGetR(color: TCefColor): byte;
|
|
function CefColorGetG(color: TCefColor): Byte;
|
|
function CefColorGetB(color: TCefColor): Byte;
|
|
|
|
function CefColorSetARGB(a, r, g, b: Byte): TCefColor;
|
|
|
|
function CefInt64Set(int32_low, int32_high: Integer): Int64;
|
|
|
|
function CefInt64GetLow(const int64_val: Int64): Integer;
|
|
function CefInt64GetHigh(const int64_val: Int64): Integer;
|
|
|
|
function CefGetObject(ptr: Pointer): TObject; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
function CefGetData(const i: ICefBaseRefCounted): Pointer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
|
|
function CefStringAlloc(const str: ustring): TCefString;
|
|
function CefStringClearAndGet(str: PCefString): ustring;
|
|
|
|
function CefString(const str: ustring): TCefString; overload;
|
|
function CefString(const str: PCefString): ustring; overload;
|
|
function CefUserFreeString(const str: ustring): PCefStringUserFree;
|
|
procedure CefStringFree(const str: PCefString);
|
|
function CefStringFreeAndGet(const str: PCefStringUserFree): ustring;
|
|
procedure CefStringSet(const str: PCefString; const value: ustring);
|
|
procedure CefStringInitialize(const aCefString : PCefString); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
|
|
function CefRegisterExtension(const name, code: ustring; const Handler: ICefv8Handler): Boolean;
|
|
|
|
function CefPostTask(aThreadId : TCefThreadId; const aTask: ICefTask) : boolean;
|
|
function CefPostDelayedTask(aThreadId : TCefThreadId; const aTask : ICefTask; aDelayMs : Int64) : boolean;
|
|
function CefCurrentlyOn(aThreadId : TCefThreadId) : boolean;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function CefTimeToSystemTime(const dt: TCefTime): TSystemTime;
|
|
function SystemTimeToCefTime(const dt: TSystemTime): TCefTime;
|
|
{$ELSE}
|
|
{$IFDEF LINUX}
|
|
{$IFDEF FPC}
|
|
function CefTimeToSystemTime(const dt: TCefTime): TSystemTime;
|
|
function SystemTimeToCefTime(const dt: TSystemTime): TCefTime;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function CefTimeToDateTime(const dt: TCefTime): TDateTime;
|
|
function DateTimeToCefTime(dt: TDateTime): TCefTime;
|
|
|
|
function cef_string_wide_copy(const src: PWideChar; src_len: NativeUInt; output: PCefStringWide): Integer;
|
|
function cef_string_utf8_copy(const src: PAnsiChar; src_len: NativeUInt; output: PCefStringUtf8): Integer;
|
|
function cef_string_utf16_copy(const src: PChar16; src_len: NativeUInt; output: PCefStringUtf16): Integer;
|
|
function cef_string_copy(const src: PCefChar; src_len: NativeUInt; output: PCefString): Integer;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring = ''; aExStyle : DWORD = 0);
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = ''; aExStyle : DWORD = 0);
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = ''; aExStyle : DWORD = 0);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MACOS}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring = ''; aHidden : boolean = False);
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = ''; aHidden : boolean = False);
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = ''; aHidden : boolean = False);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring = '');
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = '');
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = '');
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function ProcessUnderWow64(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall; external Kernel32DLL name 'IsWow64Process';
|
|
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation; lpLocalTime, lpUniversalTime: PSystemTime): BOOL; stdcall; external Kernel32DLL;
|
|
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; lpUniversalTime, lpLocalTime: PSystemTime): BOOL; stdcall; external Kernel32DLL;
|
|
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';
|
|
function PathCanonicalizeAnsi(pszBuf: LPSTR; pszPath: LPCSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathCanonicalizeA';
|
|
function PathCanonicalizeUnicode(pszBuf: LPWSTR; pszPath: LPCWSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathCanonicalizeW';
|
|
function PathIsUNCAnsi(pszPath: LPCSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsUNCA';
|
|
function PathIsUNCUnicode(pszPath: LPCWSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsUNCW';
|
|
function PathIsURLAnsi(pszPath: LPCSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsURLA';
|
|
function PathIsURLUnicode(pszPath: LPCWSTR): BOOL; stdcall; external SHLWAPIDLL name 'PathIsURLW';
|
|
|
|
{$IFNDEF DELPHI12_UP}
|
|
const
|
|
GWLP_WNDPROC = GWL_WNDPROC;
|
|
GWLP_HWNDPARENT = GWL_HWNDPARENT;
|
|
{$IFDEF WIN64}
|
|
function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: int64): int64; stdcall; external user32 name 'SetWindowLongPtrW';
|
|
{$ELSE}
|
|
function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: LongInt): LongInt; stdcall; external user32 name 'SetWindowLongW';
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
|
|
function CustomPathIsRelative(const aPath : string) : boolean;
|
|
function CustomPathCanonicalize(const aOriginalPath : string; var aCanonicalPath : string) : boolean;
|
|
function CustomAbsolutePath(const aPath : string; aMustExist : boolean = False) : string;
|
|
function CustomPathIsURL(const aPath : string) : boolean;
|
|
function CustomPathIsUNC(const aPath : string) : boolean;
|
|
function GetModulePath : string;
|
|
|
|
function CefIsCertStatusError(Status : TCefCertStatus) : boolean;
|
|
|
|
function CefCrashReportingEnabled : boolean;
|
|
procedure CefSetCrashKeyValue(const aKey, aValue : ustring);
|
|
|
|
procedure CefLog(const aFile : string; aLine, aSeverity : integer; const aMessage : string);
|
|
procedure CefDebugLog(const aMessage : string; aSeverity : integer = CEF_LOG_SEVERITY_ERROR);
|
|
procedure CefKeyEventLog(const aEvent : TCefKeyEvent);
|
|
procedure CefMouseEventLog(const aEvent : TCefMouseEvent);
|
|
procedure OutputDebugMessage(const aMessage : string);
|
|
function CustomExceptionHandler(const aFunctionName : string; const aException : exception) : boolean;
|
|
|
|
function CefRegisterSchemeHandlerFactory(const SchemeName, DomainName : ustring; const handler: TCefResourceHandlerClass = nil): Boolean;
|
|
function CefClearSchemeHandlerFactories : boolean;
|
|
|
|
function CefAddCrossOriginWhitelistEntry(const SourceOrigin, TargetProtocol, TargetDomain: ustring; AllowTargetSubdomains: Boolean): Boolean;
|
|
function CefRemoveCrossOriginWhitelistEntry(const SourceOrigin, TargetProtocol, TargetDomain: ustring; AllowTargetSubdomains: Boolean): Boolean;
|
|
function CefClearCrossOriginWhitelist: Boolean;
|
|
|
|
procedure UInt64ToFileVersionInfo(const aVersion : uint64; var aVersionInfo : TFileVersionInfo);
|
|
{$IFDEF MSWINDOWS}
|
|
function GetExtendedFileVersion(const aFileName : ustring) : uint64;
|
|
function GetStringFileInfo(const aFileName, aField : ustring; var aValue : ustring) : boolean;
|
|
function GetDLLVersion(const aDLLFile : ustring; var aVersionInfo : TFileVersionInfo) : boolean;
|
|
procedure OutputLastErrorMessage;
|
|
{$ENDIF}
|
|
|
|
function SplitLongString(aSrcString : string) : string;
|
|
function GetAbsoluteDirPath(const aSrcPath : string; var aRsltPath : string) : boolean;
|
|
function CheckSubprocessPath(const aSubprocessPath : string; var aMissingFiles : string) : boolean;
|
|
function CheckLocales(const aLocalesDirPath : string; var aMissingFiles : string; const aLocalesRequired : string = '') : boolean;
|
|
function CheckResources(const aResourcesDirPath : string; var aMissingFiles : string; aCheckDevResources: boolean = True; aCheckExtensions: boolean = True) : boolean;
|
|
function CheckDLLs(const aFrameworkDirPath : string; var aMissingFiles : string) : boolean;
|
|
{$IFDEF MSWINDOWS}
|
|
function CheckDLLVersion(const aDLLFile : ustring; aMajor, aMinor, aRelease, aBuild : uint16) : boolean;
|
|
function GetDLLHeaderMachine(const aDLLFile : ustring; var aMachine : integer) : boolean;
|
|
{$ENDIF}
|
|
function FileVersionInfoToString(const aVersionInfo : TFileVersionInfo) : string;
|
|
function CheckFilesExist(var aList : TStringList; var aMissingFiles : string) : boolean;
|
|
function Is32BitProcess : boolean;
|
|
|
|
function CefParseUrl(const url: ustring; var parts: TUrlParts): Boolean;
|
|
function CefCreateUrl(var parts: TUrlParts): ustring;
|
|
function CefFormatUrlForSecurityDisplay(const originUrl: string): string;
|
|
function CefGetMimeType(const extension: ustring): ustring;
|
|
procedure CefGetExtensionsForMimeType(const mimeType: ustring; var extensions: TStringList);
|
|
|
|
function CefBase64Encode(const data: Pointer; dataSize: NativeUInt): ustring;
|
|
function CefBase64Decode(const data: ustring): ICefBinaryValue;
|
|
function CefUriEncode(const text: ustring; usePlus: Boolean): ustring;
|
|
function CefUriDecode(const text: ustring; convertToUtf8: Boolean; unescapeRule: TCefUriUnescapeRule): ustring;
|
|
|
|
function CefGetPath(const aPathKey : TCefPathKey) : ustring;
|
|
|
|
function CefCreateDirectory(const fullPath: ustring): Boolean;
|
|
function CefGetTempDirectory(out tempDir: ustring): Boolean;
|
|
function CefCreateNewTempDirectory(const prefix: ustring; out newTempPath: ustring): Boolean;
|
|
function CefCreateTempDirectoryInDirectory(const baseDir, prefix: ustring; out newDir: ustring): Boolean;
|
|
function CefDirectoryExists(const path: ustring): Boolean;
|
|
function CefDeleteFile(const path: ustring; recursive: Boolean): Boolean;
|
|
function CefZipDirectory(const srcDir, destFile: ustring; includeHiddenFiles: Boolean): Boolean;
|
|
procedure CefLoadCRLSetsFile(const path : ustring);
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function CefIsKeyDown(aWparam : WPARAM) : boolean;
|
|
function CefIsKeyToggled(aWparam : WPARAM) : boolean;
|
|
function GetCefMouseModifiers : TCefEventFlags; overload;
|
|
function GetCefMouseModifiers(awparam : WPARAM) : TCefEventFlags; overload;
|
|
function GetCefKeyboardModifiers(aWparam : WPARAM; aLparam : LPARAM) : TCefEventFlags;
|
|
procedure CefCheckAltGrPressed(aWparam : WPARAM; var aEvent : TCefKeyEvent);
|
|
|
|
procedure DropEffectToDragOperation(aEffect : Longint; var aAllowedOps : TCefDragOperations);
|
|
procedure DragOperationToDropEffect(const aDragOperations : TCefDragOperations; var aEffect: Longint);
|
|
|
|
function GetWindowsMajorMinorVersion(var wMajorVersion, wMinorVersion : DWORD) : boolean;
|
|
function RunningWindows10OrNewer : boolean;
|
|
function GetDPIForHandle(aHandle : HWND; var aDPI : UINT) : boolean;
|
|
function GetDefaultCEFUserAgent : string;
|
|
{$IFDEF DELPHI14_UP}
|
|
function TouchPointToPoint(aHandle : HWND; const TouchPoint: TTouchInput): TPoint;
|
|
function GetDigitizerStatus(var aDigitizerStatus : TDigitizerStatus; aDPI : cardinal = 0) : boolean;
|
|
function HasTouchOrPen(aDPI : cardinal = 0) : boolean;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function DeviceToLogical(aValue : integer; const aDeviceScaleFactor : double) : integer; overload;
|
|
function DeviceToLogical(aValue : single; const aDeviceScaleFactor : double) : single; overload;
|
|
procedure DeviceToLogical(var aEvent : TCEFMouseEvent; const aDeviceScaleFactor : double); overload;
|
|
procedure DeviceToLogical(var aEvent : TCefTouchEvent; const aDeviceScaleFactor : double); overload;
|
|
procedure DeviceToLogical(var aPoint : TPoint; const aDeviceScaleFactor : double); overload;
|
|
function LogicalToDevice(aValue : integer; const aDeviceScaleFactor : double) : integer; overload;
|
|
procedure LogicalToDevice(var aRect : TCEFRect; const aDeviceScaleFactor : double); overload;
|
|
|
|
function GetScreenDPI : integer;
|
|
function GetDeviceScaleFactor : single;
|
|
|
|
function DeleteDirContents(const aDirectory : string; const aExcludeFiles : TStringList = nil) : boolean;
|
|
function DeleteFileList(const aFileList : TStringList) : boolean;
|
|
function MoveFileList(const aFileList : TStringList; const aSrcDirectory, aDstDirectory : string) : boolean;
|
|
|
|
function CefGetDataURI(const aString, aMimeType : ustring) : ustring; overload;
|
|
function CefGetDataURI(aData : pointer; aSize : integer; const aMimeType : ustring; const aCharset : ustring = '') : ustring; overload;
|
|
|
|
function ValidCefWindowHandle(aHandle : TCefWindowHandle) : boolean;
|
|
procedure InitializeWindowHandle(var aHandle : TCefWindowHandle);
|
|
|
|
implementation
|
|
|
|
uses
|
|
uCEFApplicationCore, uCEFSchemeHandlerFactory, uCEFValue,
|
|
uCEFBinaryValue, uCEFStringList;
|
|
|
|
function CefColorGetA(color: TCefColor): Byte;
|
|
begin
|
|
Result := (color shr 24) and $FF;
|
|
end;
|
|
|
|
function CefColorGetR(color: TCefColor): byte;
|
|
begin
|
|
Result := (color shr 16) and $FF;
|
|
end;
|
|
|
|
function CefColorGetG(color: TCefColor): Byte;
|
|
begin
|
|
Result := (color shr 8) and $FF;
|
|
end;
|
|
|
|
function CefColorGetB(color: TCefColor): Byte;
|
|
begin
|
|
Result := color and $FF;
|
|
end;
|
|
|
|
function CefColorSetARGB(a, r, g, b: Byte): TCefColor;
|
|
begin
|
|
Result := (a shl 24) or (r shl 16) or (g shl 8) or b;
|
|
end;
|
|
|
|
function CefInt64Set(int32_low, int32_high: Integer): Int64;
|
|
begin
|
|
Result := int32_low or (int32_high shl 32);
|
|
end;
|
|
|
|
function CefInt64GetLow(const int64_val: Int64): Integer;
|
|
begin
|
|
Result := Integer(int64_val);
|
|
end;
|
|
|
|
function CefInt64GetHigh(const int64_val: Int64): Integer;
|
|
begin
|
|
Result := (int64_val shr 32) and $FFFFFFFF;
|
|
end;
|
|
|
|
function CefStringClearAndGet(str: PCefString): ustring;
|
|
begin
|
|
if (str <> nil) and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
Result := CefString(str);
|
|
cef_string_utf16_clear(str);
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefGetObject(ptr: Pointer): TObject; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
begin
|
|
if (ptr <> nil) then
|
|
begin
|
|
Dec(PByte(ptr), SizeOf(Pointer));
|
|
Result := TObject(PPointer(ptr)^);
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function CefGetData(const i: ICefBaseRefCounted): Pointer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
begin
|
|
if (i <> nil) then
|
|
Result := i.Wrap
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function CefString(const str: PCefString): ustring;
|
|
begin
|
|
if (str <> nil) and (str^.str <> nil) and (str^.length > 0) and (str^.length < nativeuint(high(integer))) then
|
|
SetString(Result, str^.str, str^.length)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefString(const str: ustring): TCefString;
|
|
begin
|
|
Result.str := PChar16(PWideChar(str));
|
|
Result.length := Length(str);
|
|
Result.dtor := nil;
|
|
end;
|
|
|
|
procedure CefStringFree(const str: PCefString);
|
|
begin
|
|
if (str <> nil) and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
cef_string_utf16_clear(str);
|
|
end;
|
|
|
|
procedure CefStringSet(const str: PCefString; const value: ustring);
|
|
begin
|
|
if (str <> nil) and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
cef_string_utf16_set(PWideChar(value), Length(value), str, Ord(True));
|
|
end;
|
|
|
|
procedure CefStringInitialize(const aCefString : PCefString); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
|
|
begin
|
|
if (aCefString <> nil) then
|
|
begin
|
|
aCefString^.str := nil;
|
|
aCefString^.length := 0;
|
|
aCefString^.dtor := nil;
|
|
end;
|
|
end;
|
|
|
|
function CefStringFreeAndGet(const str: PCefStringUserFree): ustring;
|
|
begin
|
|
if (str <> nil) and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
Result := CefString(PCefString(str));
|
|
cef_string_userfree_utf16_free(str);
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefStringAlloc(const str: ustring): TCefString;
|
|
begin
|
|
CefStringInitialize(@Result);
|
|
|
|
if (str <> '') and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
cef_string_wide_to_utf16(PWideChar(str), Length(str), @Result);
|
|
end;
|
|
|
|
|
|
procedure _free_string(str: PChar16); stdcall;
|
|
begin
|
|
if (str <> nil) then FreeMem(str);
|
|
end;
|
|
|
|
function CefUserFreeString(const str: ustring): PCefStringUserFree;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
Result := cef_string_userfree_utf16_alloc();
|
|
Result^.length := Length(str);
|
|
GetMem(Result^.str, Result^.length * SizeOf(TCefChar));
|
|
Move(PCefChar(str)^, Result^.str^, Result^.length * SizeOf(TCefChar));
|
|
Result^.dtor := @_free_string;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function CefRegisterExtension(const name, code: ustring; const Handler: ICefv8Handler): Boolean;
|
|
var
|
|
TempName, TempCode : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and
|
|
GlobalCEFApp.LibLoaded and
|
|
((GlobalCEFApp.ProcessType = ptRenderer) or GlobalCEFApp.SingleProcess) and
|
|
(length(name) > 0) and
|
|
(length(code) > 0) then
|
|
begin
|
|
TempName := CefString(name);
|
|
TempCode := CefString(code);
|
|
Result := cef_register_extension(@TempName, @TempCode, CefGetData(handler)) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefPostTask(aThreadId : TCefThreadId; const aTask : ICefTask) : boolean;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded and (aTask <> nil) then
|
|
Result := cef_post_task(aThreadId, aTask.Wrap) <> 0
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefPostDelayedTask(aThreadId : TCefThreadId; const aTask : ICefTask; aDelayMs : Int64) : boolean;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded and (aTask <> nil) then
|
|
Result := cef_post_delayed_task(aThreadId, aTask.Wrap, aDelayMs) <> 0
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefCurrentlyOn(aThreadId : TCefThreadId) : boolean;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := cef_currently_on(aThreadId) <> 0
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function CefTimeToSystemTime(const dt: TCefTime): TSystemTime;
|
|
begin
|
|
Result.wYear := dt.year;
|
|
Result.wMonth := dt.month;
|
|
Result.wDayOfWeek := dt.day_of_week;
|
|
Result.wDay := dt.day_of_month;
|
|
Result.wHour := dt.hour;
|
|
Result.wMinute := dt.minute;
|
|
Result.wSecond := dt.second;
|
|
Result.wMilliseconds := dt.millisecond;
|
|
end;
|
|
|
|
function SystemTimeToCefTime(const dt: TSystemTime): TCefTime;
|
|
begin
|
|
Result.year := dt.wYear;
|
|
Result.month := dt.wMonth;
|
|
Result.day_of_week := dt.wDayOfWeek;
|
|
Result.day_of_month := dt.wDay;
|
|
Result.hour := dt.wHour;
|
|
Result.minute := dt.wMinute;
|
|
Result.second := dt.wSecond;
|
|
Result.millisecond := dt.wMilliseconds;
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF LINUX}
|
|
{$IFDEF FPC}
|
|
function CefTimeToSystemTime(const dt: TCefTime): TSystemTime;
|
|
begin
|
|
Result.Year := dt.year;
|
|
Result.Month := dt.month;
|
|
Result.DayOfWeek := dt.day_of_week;
|
|
Result.Day := dt.day_of_month;
|
|
Result.Hour := dt.hour;
|
|
Result.Minute := dt.minute;
|
|
Result.Second := dt.second;
|
|
Result.Millisecond := dt.millisecond;
|
|
end;
|
|
|
|
function SystemTimeToCefTime(const dt: TSystemTime): TCefTime;
|
|
begin
|
|
Result.year := dt.Year;
|
|
Result.month := dt.Month;
|
|
Result.day_of_week := dt.DayOfWeek;
|
|
Result.day_of_month := dt.Day;
|
|
Result.hour := dt.Hour;
|
|
Result.minute := dt.Minute;
|
|
Result.second := dt.Second;
|
|
Result.millisecond := dt.Millisecond;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function CefTimeToDateTime(const dt: TCefTime): TDateTime;
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
TempTime : TSystemTime;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := 0;
|
|
|
|
try
|
|
TempTime := CefTimeToSystemTime(dt);
|
|
SystemTimeToTzSpecificLocalTime(nil, @TempTime, @TempTime);
|
|
Result := SystemTimeToDateTime(TempTime);
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CefTimeToDateTime', e) then raise;
|
|
end;
|
|
{$ELSE}
|
|
Result := EncodeDate(dt.year, dt.month, dt.day_of_month) + EncodeTime(dt.hour, dt.minute, dt.second, dt.millisecond);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function DateTimeToCefTime(dt: TDateTime): TCefTime;
|
|
var
|
|
{$IFDEF MSWINDOWS}
|
|
TempTime : TSystemTime;
|
|
{$ELSE}
|
|
TempYear, TempMonth, TempDay, TempHour, TempMin, TempSec, TempMSec : Word;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
FillChar(Result, SizeOf(TCefTime), 0);
|
|
|
|
try
|
|
DateTimeToSystemTime(dt, TempTime);
|
|
TzSpecificLocalTimeToSystemTime(nil, @TempTime, @TempTime);
|
|
Result := SystemTimeToCefTime(TempTime);
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('DateTimeToCefTime', e) then raise;
|
|
end;
|
|
{$ELSE}
|
|
DecodeDate(dt, TempYear, TempMonth, TempDay);
|
|
DecodeTime(dt, TempHour, TempMin, TempSec, TempMSec);
|
|
|
|
Result.year := TempYear;
|
|
Result.month := TempMonth;
|
|
Result.day_of_week := DayOfWeek(dt);
|
|
Result.day_of_month := TempMonth;
|
|
Result.hour := TempHour;
|
|
Result.minute := TempMin;
|
|
Result.second := TempSec;
|
|
Result.millisecond := TempMSec;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function cef_string_wide_copy(const src: PWideChar; src_len: NativeUInt; output: PCefStringWide): Integer;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := cef_string_wide_set(src, src_len, output, ord(True))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function cef_string_utf8_copy(const src: PAnsiChar; src_len: NativeUInt; output: PCefStringUtf8): Integer;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := cef_string_utf8_set(src, src_len, output, ord(True))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function cef_string_utf16_copy(const src: PChar16; src_len: NativeUInt; output: PCefStringUtf16): Integer;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := cef_string_utf16_set(src, src_len, output, ord(True))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function cef_string_copy(const src: PCefChar; src_len: NativeUInt; output: PCefString): Integer;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := cef_string_utf16_set(src, src_len, output, ord(True))
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring; aExStyle : DWORD);
|
|
begin
|
|
aWindowInfo.ex_style := aExStyle;
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.style := WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_TABSTOP;
|
|
aWindowInfo.x := aRect.left;
|
|
aWindowInfo.y := aRect.top;
|
|
aWindowInfo.width := aRect.right - aRect.left;
|
|
aWindowInfo.height := aRect.bottom - aRect.top;
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.menu := 0;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring; aExStyle : DWORD);
|
|
begin
|
|
aWindowInfo.ex_style := aExStyle;
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.style := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_VISIBLE;
|
|
aWindowInfo.x := integer(CW_USEDEFAULT);
|
|
aWindowInfo.y := integer(CW_USEDEFAULT);
|
|
aWindowInfo.width := integer(CW_USEDEFAULT);
|
|
aWindowInfo.height := integer(CW_USEDEFAULT);
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.menu := 0;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring; aExStyle : DWORD);
|
|
begin
|
|
aWindowInfo.ex_style := aExStyle;
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.style := 0;
|
|
aWindowInfo.x := 0;
|
|
aWindowInfo.y := 0;
|
|
aWindowInfo.width := 0;
|
|
aWindowInfo.height := 0;
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.menu := 0;
|
|
aWindowInfo.windowless_rendering_enabled := ord(True);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MACOS}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring; aHidden : boolean);
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := aRect.left;
|
|
aWindowInfo.y := aRect.top;
|
|
aWindowInfo.width := aRect.right - aRect.left;
|
|
aWindowInfo.height := aRect.bottom - aRect.top;
|
|
aWindowInfo.hidden := Ord(aHidden);
|
|
aWindowInfo.parent_view := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.view := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring; aHidden : boolean);
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := 0;
|
|
aWindowInfo.y := 0;
|
|
aWindowInfo.width := 0;
|
|
aWindowInfo.height := 0;
|
|
aWindowInfo.hidden := Ord(aHidden);
|
|
aWindowInfo.parent_view := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.view := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring; aHidden : boolean);
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := 0;
|
|
aWindowInfo.y := 0;
|
|
aWindowInfo.width := 0;
|
|
aWindowInfo.height := 0;
|
|
aWindowInfo.hidden := Ord(aHidden);
|
|
aWindowInfo.parent_view := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(True);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.view := 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
procedure WindowInfoAsChild(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; aRect : TRect; const aWindowName : ustring = '');
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := aRect.left;
|
|
aWindowInfo.y := aRect.top;
|
|
aWindowInfo.width := aRect.right - aRect.left;
|
|
aWindowInfo.height := aRect.bottom - aRect.top;
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsPopUp(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = '');
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := 0;
|
|
aWindowInfo.y := 0;
|
|
aWindowInfo.width := 0;
|
|
aWindowInfo.height := 0;
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(False);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
|
|
procedure WindowInfoAsWindowless(var aWindowInfo : TCefWindowInfo; aParent : TCefWindowHandle; const aWindowName : ustring = '');
|
|
begin
|
|
aWindowInfo.window_name := CefString(aWindowName);
|
|
aWindowInfo.x := 0;
|
|
aWindowInfo.y := 0;
|
|
aWindowInfo.width := 0;
|
|
aWindowInfo.height := 0;
|
|
aWindowInfo.parent_window := aParent;
|
|
aWindowInfo.windowless_rendering_enabled := ord(True);
|
|
aWindowInfo.shared_texture_enabled := ord(False);
|
|
aWindowInfo.external_begin_frame_enabled := ord(False);
|
|
aWindowInfo.window := 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function CefIsCertStatusError(Status : TCefCertStatus) : boolean;
|
|
begin
|
|
Result := (GlobalCEFApp <> nil) and
|
|
GlobalCEFApp.LibLoaded and
|
|
(cef_is_cert_status_error(Status) <> 0);
|
|
end;
|
|
|
|
function CefCrashReportingEnabled : boolean;
|
|
begin
|
|
Result := (GlobalCEFApp <> nil) and
|
|
GlobalCEFApp.LibLoaded and
|
|
(cef_crash_reporting_enabled() <> 0);
|
|
end;
|
|
|
|
procedure CefSetCrashKeyValue(const aKey, aValue : ustring);
|
|
var
|
|
TempKey, TempValue : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempKey := CefString(aKey);
|
|
TempValue := CefString(aValue);
|
|
cef_set_crash_key_value(@TempKey, @TempValue);
|
|
end;
|
|
end;
|
|
|
|
procedure CefLog(const aFile : string; aLine, aSeverity : integer; const aMessage : string);
|
|
var
|
|
TempFile, TempMessage : AnsiString;
|
|
begin
|
|
if (length(aFile) > 0) and (length(aMessage) > 0) then
|
|
begin
|
|
TempFile := AnsiString(aFile);
|
|
TempMessage := AnsiString(aMessage);
|
|
|
|
cef_log(@TempFile[1], aLine, aSeverity, @TempMessage[1]);
|
|
end;
|
|
end;
|
|
|
|
procedure CefDebugLog(const aMessage : string; aSeverity : integer);
|
|
const
|
|
DEFAULT_LINE = 1;
|
|
var
|
|
TempString : string;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
TempString := 'PID: ' + IntToStr(GetCurrentProcessID) + ', TID: ' + IntToStr(GetCurrentThreadID);
|
|
{$ELSE}
|
|
{$IFDEF MACOS}
|
|
TempString := 'PID: ' + IntToStr(TNSProcessInfo.Wrap(TNSProcessInfo.OCClass.processInfo).processIdentifier) + ', TID: ' + IntToStr(TThread.Current.ThreadID);
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
TempString := 'PID: ' + IntToStr(GetProcessID()) + ', TID: ' + IntToStr(GetCurrentThreadID());
|
|
{$ELSE}
|
|
// TODO: Find the equivalent function to get the process ID in Delphi FMX for Linux
|
|
// TempString := 'PID: ' + IntToStr(GetProcessID()) + ', TID: ' + IntToStr(GetCurrentThreadID());
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
case GlobalCEFApp.ProcessType of
|
|
ptBrowser : TempString := TempString + ', PT: Browser';
|
|
ptRenderer : TempString := TempString + ', PT: Renderer';
|
|
ptZygote : TempString := TempString + ', PT: Zygote';
|
|
ptGPU : TempString := TempString + ', PT: GPU';
|
|
ptUtility : TempString := TempString + ', PT: Utility';
|
|
ptOther : TempString := TempString + ', PT: Other';
|
|
end;
|
|
|
|
CefLog('CEF4Delphi', DEFAULT_LINE, aSeverity, TempString + ' - ' + aMessage);
|
|
end;
|
|
end;
|
|
|
|
procedure CefKeyEventLog(const aEvent : TCefKeyEvent);
|
|
const
|
|
DEFAULT_LINE = 1;
|
|
var
|
|
TempString : string;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
case aEvent.kind of
|
|
KEYEVENT_RAWKEYDOWN : TempString := 'kind: KEYEVENT_RAWKEYDOWN';
|
|
KEYEVENT_KEYDOWN : TempString := 'kind: KEYEVENT_KEYDOWN';
|
|
KEYEVENT_KEYUP : TempString := 'kind: KEYEVENT_KEYUP';
|
|
KEYEVENT_CHAR : TempString := 'kind: KEYEVENT_CHAR';
|
|
end;
|
|
|
|
TempString := TempString + ', modifiers: $' + inttohex(aEvent.modifiers, SizeOf(aEvent.modifiers) * 2);
|
|
TempString := TempString + ', windows_key_code: $' + inttohex(aEvent.windows_key_code, SizeOf(aEvent.windows_key_code) * 2);
|
|
TempString := TempString + ', native_key_code: $' + inttohex(aEvent.native_key_code, SizeOf(aEvent.native_key_code) * 2);
|
|
TempString := TempString + ', is_system_key: ' + BoolToStr((aEvent.is_system_key <> 0), true);
|
|
TempString := TempString + ', character: $' + inttohex(ord(aEvent.character), SizeOf(aEvent.character) * 2);
|
|
TempString := TempString + ', unmodified_character: $' + inttohex(ord(aEvent.unmodified_character), SizeOf(aEvent.unmodified_character) * 2);
|
|
TempString := TempString + ', focus_on_editable_field: ' + BoolToStr((aEvent.focus_on_editable_field <> 0), true);;
|
|
|
|
CefLog('CEF4Delphi', DEFAULT_LINE, CEF_LOG_SEVERITY_INFO, TempString);
|
|
end;
|
|
end;
|
|
|
|
procedure CefMouseEventLog(const aEvent : TCefMouseEvent);
|
|
const
|
|
DEFAULT_LINE = 1;
|
|
var
|
|
TempString : string;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempString := TempString + ', x: $' + inttohex(aEvent.x, SizeOf(aEvent.x) * 2);
|
|
TempString := TempString + ', y: $' + inttohex(aEvent.y, SizeOf(aEvent.y) * 2);
|
|
TempString := TempString + ', modifiers: $' + inttohex(aEvent.modifiers, SizeOf(aEvent.modifiers) * 2);
|
|
|
|
CefLog('CEF4Delphi', DEFAULT_LINE, CEF_LOG_SEVERITY_INFO, TempString);
|
|
end;
|
|
end;
|
|
|
|
procedure OutputDebugMessage(const aMessage : string);
|
|
const
|
|
DEFAULT_LINE = 1;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF FMX}
|
|
FMX.Types.Log.d(aMessage);
|
|
{$ELSE}
|
|
{$IFDEF MSWINDOWS}
|
|
OutputDebugString({$IFDEF DELPHI12_UP}PWideChar{$ELSE}PAnsiChar{$ENDIF}(aMessage + chr(0)));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
CefLog('CEF4Delphi', DEFAULT_LINE, CEF_LOG_SEVERITY_ERROR, aMessage);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomExceptionHandler(const aFunctionName : string; const aException : exception) : boolean;
|
|
begin
|
|
OutputDebugMessage(aFunctionName + ' error : ' + aException.message);
|
|
|
|
Result := (GlobalCEFApp <> nil) and GlobalCEFApp.ReRaiseExceptions;
|
|
end;
|
|
|
|
function CefRegisterSchemeHandlerFactory(const SchemeName : ustring;
|
|
const DomainName : ustring;
|
|
const handler : TCefResourceHandlerClass) : boolean;
|
|
var
|
|
TempScheme, TempDomainName : TCefString;
|
|
TempFactory : ICefSchemeHandlerFactory;
|
|
TempDomainNamePtr : PCefString;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
if (GlobalCEFApp <> nil) and
|
|
GlobalCEFApp.LibLoaded and
|
|
(length(SchemeName) > 0) then
|
|
begin
|
|
if (length(DomainName) > 0) then
|
|
begin
|
|
TempDomainName := CefString(DomainName);
|
|
TempDomainNamePtr := @TempDomainName;
|
|
end
|
|
else
|
|
TempDomainNamePtr := nil;
|
|
|
|
TempScheme := CefString(SchemeName);
|
|
TempFactory := TCefSchemeHandlerFactoryOwn.Create(handler);
|
|
Result := cef_register_scheme_handler_factory(@TempScheme, TempDomainNamePtr, TempFactory.Wrap) <> 0;
|
|
end;
|
|
finally
|
|
TempFactory := nil;
|
|
end;
|
|
end;
|
|
|
|
function CefClearSchemeHandlerFactories : boolean;
|
|
begin
|
|
Result := (GlobalCEFApp <> nil) and
|
|
GlobalCEFApp.LibLoaded and
|
|
(cef_clear_scheme_handler_factories() <> 0);
|
|
end;
|
|
|
|
function CefAddCrossOriginWhitelistEntry(const SourceOrigin : ustring;
|
|
const TargetProtocol : ustring;
|
|
const TargetDomain : ustring;
|
|
AllowTargetSubdomains : Boolean): Boolean;
|
|
var
|
|
TempSourceOrigin, TempTargetProtocol, TempTargetDomain : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempSourceOrigin := CefString(SourceOrigin);
|
|
TempTargetProtocol := CefString(TargetProtocol);
|
|
TempTargetDomain := CefString(TargetDomain);
|
|
Result := cef_add_cross_origin_whitelist_entry(@TempSourceOrigin,
|
|
@TempTargetProtocol,
|
|
@TempTargetDomain,
|
|
Ord(AllowTargetSubdomains)) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefRemoveCrossOriginWhitelistEntry(const SourceOrigin : ustring;
|
|
const TargetProtocol : ustring;
|
|
const TargetDomain : ustring;
|
|
AllowTargetSubdomains : Boolean): Boolean;
|
|
var
|
|
TempSourceOrigin, TempTargetProtocol, TempTargetDomain : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempSourceOrigin := CefString(SourceOrigin);
|
|
TempTargetProtocol := CefString(TargetProtocol);
|
|
TempTargetDomain := CefString(TargetDomain);
|
|
Result := cef_remove_cross_origin_whitelist_entry(@TempSourceOrigin,
|
|
@TempTargetProtocol,
|
|
@TempTargetDomain,
|
|
Ord(AllowTargetSubdomains)) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefClearCrossOriginWhitelist: Boolean;
|
|
begin
|
|
Result := cef_clear_cross_origin_whitelist() <> 0;
|
|
end;
|
|
|
|
function SplitLongString(aSrcString : string) : string;
|
|
const
|
|
MAXLINELENGTH = 50;
|
|
begin
|
|
Result := '';
|
|
while (length(aSrcString) > 0) do
|
|
begin
|
|
if (Result <> '') then
|
|
Result := Result + CRLF + copy(aSrcString, 1, MAXLINELENGTH)
|
|
else
|
|
Result := Result + copy(aSrcString, 1, MAXLINELENGTH);
|
|
|
|
aSrcString := copy(aSrcString, succ(MAXLINELENGTH), length(aSrcString));
|
|
end;
|
|
end;
|
|
|
|
function GetAbsoluteDirPath(const aSrcPath : string; var aRsltPath : string) : boolean;
|
|
begin
|
|
Result := True;
|
|
|
|
if (length(aSrcPath) > 0) then
|
|
begin
|
|
aRsltPath := IncludeTrailingPathDelimiter(CustomAbsolutePath(aSrcPath));
|
|
Result := DirectoryExists(aRsltPath);
|
|
end
|
|
else
|
|
aRsltPath := '';
|
|
end;
|
|
|
|
function CheckLocales(const aLocalesDirPath : string; var aMissingFiles : string; const aLocalesRequired : string) : boolean;
|
|
const
|
|
LOCALES_REQUIRED_DEFAULT =
|
|
'am,' +
|
|
'ar,' +
|
|
'bg,' +
|
|
'bn,' +
|
|
'ca,' +
|
|
'cs,' +
|
|
'da,' +
|
|
'de,' +
|
|
'el,' +
|
|
'en-GB,' +
|
|
'en-US,' +
|
|
'es,' +
|
|
'es-419,' +
|
|
'et,' +
|
|
'fa,' +
|
|
'fi,' +
|
|
'fil,' +
|
|
'fr,' +
|
|
'gu,' +
|
|
'he,' +
|
|
'hi,' +
|
|
'hr,' +
|
|
'hu,' +
|
|
'id,' +
|
|
'it,' +
|
|
'ja,' +
|
|
'kn,' +
|
|
'ko,' +
|
|
'lt,' +
|
|
'lv,' +
|
|
'ml,' +
|
|
'mr,' +
|
|
'ms,' +
|
|
'nb,' +
|
|
'nl,' +
|
|
'pl,' +
|
|
'pt-BR,' +
|
|
'pt-PT,' +
|
|
'ro,' +
|
|
'ru,' +
|
|
'sk,' +
|
|
'sl,' +
|
|
'sr,' +
|
|
'sv,' +
|
|
'sw,' +
|
|
'ta,' +
|
|
'te,' +
|
|
'th,' +
|
|
'tr,' +
|
|
'uk,' +
|
|
'vi,' +
|
|
'zh-CN,' +
|
|
'zh-TW';
|
|
var
|
|
i : integer;
|
|
TempDir : string;
|
|
TempList : TStringList;
|
|
begin
|
|
Result := False;
|
|
TempList := nil;
|
|
|
|
try
|
|
try
|
|
if (length(aLocalesDirPath) > 0) then
|
|
TempDir := IncludeTrailingPathDelimiter(aLocalesDirPath)
|
|
else
|
|
TempDir := 'locales' + PathDelim;
|
|
|
|
TempList := TStringList.Create;
|
|
|
|
if (length(aLocalesRequired) > 0) then
|
|
TempList.CommaText := aLocalesRequired
|
|
else
|
|
TempList.CommaText := LOCALES_REQUIRED_DEFAULT;
|
|
|
|
i := 0;
|
|
while (i < TempList.Count) do
|
|
begin
|
|
TempList[i] := TempDir + TempList[i] + '.pak';
|
|
inc(i);
|
|
end;
|
|
|
|
if DirectoryExists(TempDir) then
|
|
Result := CheckFilesExist(TempList, aMissingFiles)
|
|
else
|
|
aMissingFiles := trim(aMissingFiles) + CRLF + TempList.Text;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CheckLocales', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempList <> nil) then FreeAndNil(TempList);
|
|
end;
|
|
end;
|
|
|
|
function CheckResources(const aResourcesDirPath : string; var aMissingFiles : string; aCheckDevResources, aCheckExtensions: boolean) : boolean;
|
|
var
|
|
TempDir : string;
|
|
TempList : TStringList;
|
|
TempExists : boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
try
|
|
TempExists := GetAbsoluteDirPath(aResourcesDirPath, TempDir);
|
|
|
|
TempList := TStringList.Create;
|
|
TempList.Add(TempDir + 'snapshot_blob.bin');
|
|
TempList.Add(TempDir + 'v8_context_snapshot.bin');
|
|
TempList.Add(TempDir + 'cef.pak');
|
|
TempList.Add(TempDir + 'cef_100_percent.pak');
|
|
TempList.Add(TempDir + 'cef_200_percent.pak');
|
|
|
|
if aCheckExtensions then TempList.Add(TempDir + 'cef_extensions.pak');
|
|
if aCheckDevResources then TempList.Add(TempDir + 'devtools_resources.pak');
|
|
|
|
if TempExists then
|
|
Result := CheckFilesExist(TempList, aMissingFiles)
|
|
else
|
|
aMissingFiles := trim(aMissingFiles) + CRLF + TempList.Text;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CheckResources', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempList <> nil) then FreeAndNil(TempList);
|
|
end;
|
|
end;
|
|
|
|
function CheckSubprocessPath(const aSubprocessPath : string; var aMissingFiles : string) : boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
if (length(aSubprocessPath) = 0) or FileExists(aSubprocessPath) then
|
|
Result := True
|
|
else
|
|
aMissingFiles := trim(aMissingFiles) + CRLF + ExtractFileName(aSubprocessPath);
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CheckSubprocessPath', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function CheckDLLs(const aFrameworkDirPath : string; var aMissingFiles : string) : boolean;
|
|
var
|
|
TempDir : string;
|
|
TempList : TStringList;
|
|
TempExists : boolean;
|
|
begin
|
|
Result := False;
|
|
TempList := nil;
|
|
|
|
try
|
|
try
|
|
TempExists := GetAbsoluteDirPath(aFrameworkDirPath, TempDir);
|
|
|
|
// The icudtl.dat file must be placed next to libcef.dll
|
|
// http://www.magpcss.org/ceforum/viewtopic.php?f=6&t=14503#p32263
|
|
|
|
TempList := TStringList.Create;
|
|
TempList.Add(TempDir + LIBCEF_DLL);
|
|
{$IFDEF MSWINDOWS}
|
|
TempList.Add(TempDir + CHROMEELF_DLL);
|
|
TempList.Add(TempDir + 'd3dcompiler_47.dll');
|
|
TempList.Add(TempDir + 'libEGL.dll');
|
|
TempList.Add(TempDir + 'libGLESv2.dll');
|
|
TempList.Add(TempDir + 'swiftshader\libEGL.dll');
|
|
TempList.Add(TempDir + 'swiftshader\libGLESv2.dll');
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
TempList.Add(TempDir + 'libEGL.so');
|
|
TempList.Add(TempDir + 'libGLESv2.so');
|
|
TempList.Add(TempDir + 'swiftshader/libEGL.so');
|
|
TempList.Add(TempDir + 'swiftshader/libGLESv2.so');
|
|
{$ENDIF}
|
|
TempList.Add(TempDir + 'icudtl.dat');
|
|
|
|
if TempExists then
|
|
Result := CheckFilesExist(TempList, aMissingFiles)
|
|
else
|
|
aMissingFiles := trim(aMissingFiles) + CRLF + TempList.Text;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CheckDLLs', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempList <> nil) then FreeAndNil(TempList);
|
|
end;
|
|
end;
|
|
|
|
function CheckFilesExist(var aList : TStringList; var aMissingFiles : string) : boolean;
|
|
var
|
|
i : integer;
|
|
begin
|
|
Result := True;
|
|
|
|
try
|
|
if (aList <> nil) then
|
|
begin
|
|
i := 0;
|
|
|
|
while (i < aList.Count) do
|
|
begin
|
|
if (length(aList[i]) > 0) and not(FileExists(aList[i])) then
|
|
begin
|
|
Result := False;
|
|
aMissingFiles := aMissingFiles + aList[i] + CRLF;
|
|
end;
|
|
|
|
inc(i);
|
|
end;
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('CheckFilesExist', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
procedure UInt64ToFileVersionInfo(const aVersion : uint64; var aVersionInfo : TFileVersionInfo);
|
|
begin
|
|
aVersionInfo.MajorVer := uint16(aVersion shr 48);
|
|
aVersionInfo.MinorVer := uint16((aVersion shr 32) and $FFFF);
|
|
aVersionInfo.Release := uint16((aVersion shr 16) and $FFFF);
|
|
aVersionInfo.Build := uint16(aVersion and $FFFF);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function GetExtendedFileVersion(const aFileName : ustring) : uint64;
|
|
var
|
|
TempSize : DWORD;
|
|
TempBuffer : pointer;
|
|
TempLen : UINT;
|
|
TempHandle : cardinal;
|
|
TempInfo : PVSFixedFileInfo;
|
|
begin
|
|
Result := 0;
|
|
TempBuffer := nil;
|
|
|
|
try
|
|
try
|
|
TempSize := GetFileVersionInfoSizeW(PWideChar(aFileName), TempHandle);
|
|
|
|
if (TempSize > 0) then
|
|
begin
|
|
GetMem(TempBuffer, TempSize);
|
|
|
|
if GetFileVersionInfoW(PWideChar(aFileName), TempHandle, TempSize, TempBuffer) and
|
|
VerQueryValue(TempBuffer, '\', Pointer(TempInfo), TempLen) then
|
|
begin
|
|
Result := TempInfo^.dwFileVersionMS;
|
|
Result := Result shl 32;
|
|
Result := Result or TempInfo^.dwFileVersionLS;
|
|
end;
|
|
end
|
|
else
|
|
OutputLastErrorMessage;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetExtendedFileVersion', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempBuffer <> nil) then FreeMem(TempBuffer);
|
|
end;
|
|
end;
|
|
|
|
procedure OutputLastErrorMessage;
|
|
begin
|
|
{$IFDEF DEBUG}
|
|
OutputDebugString({$IFDEF DELPHI12_UP}PWideChar{$ELSE}PAnsiChar{$ENDIF}(SysErrorMessage(GetLastError()) + chr(0)));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetStringFileInfo(const aFileName, aField : ustring; var aValue : ustring) : boolean;
|
|
type
|
|
PLangAndCodepage = ^TLangAndCodepage;
|
|
TLangAndCodepage = record
|
|
wLanguage : word;
|
|
wCodePage : word;
|
|
end;
|
|
var
|
|
TempSize : DWORD;
|
|
TempBuffer : pointer;
|
|
TempHandle : cardinal;
|
|
TempPointer : pointer;
|
|
TempSubBlock : ustring;
|
|
TempLang : PLangAndCodepage;
|
|
TempArray : array of TLangAndCodepage;
|
|
i, j : DWORD;
|
|
begin
|
|
Result := False;
|
|
TempBuffer := nil;
|
|
TempArray := nil;
|
|
aValue := '';
|
|
|
|
try
|
|
try
|
|
TempSize := GetFileVersionInfoSizeW(PWideChar(aFileName), TempHandle);
|
|
|
|
if (TempSize > 0) then
|
|
begin
|
|
GetMem(TempBuffer, TempSize);
|
|
|
|
if GetFileVersionInfoW(PWideChar(aFileName), 0, TempSize, TempBuffer) then
|
|
begin
|
|
if VerQueryValue(TempBuffer, '\VarFileInfo\Translation\', Pointer(TempLang), TempSize) then
|
|
begin
|
|
i := 0;
|
|
j := TempSize div SizeOf(TLangAndCodepage);
|
|
|
|
SetLength(TempArray, j);
|
|
|
|
while (i < j) do
|
|
begin
|
|
TempArray[i].wLanguage := TempLang^.wLanguage;
|
|
TempArray[i].wCodePage := TempLang^.wCodePage;
|
|
inc(TempLang);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
i := 0;
|
|
j := Length(TempArray);
|
|
|
|
while (i < j) and not(Result) do
|
|
begin
|
|
TempSubBlock := '\StringFileInfo\' +
|
|
IntToHex(TempArray[i].wLanguage, 4) + IntToHex(TempArray[i].wCodePage, 4) +
|
|
'\' + aField;
|
|
|
|
if VerQueryValueW(TempBuffer, PWideChar(TempSubBlock), TempPointer, TempSize) then
|
|
begin
|
|
aValue := trim(PChar(TempPointer));
|
|
Result := (length(aValue) > 0);
|
|
end;
|
|
|
|
inc(i);
|
|
end;
|
|
|
|
// Adobe's flash player DLL uses a different codepage to store the StringFileInfo fields
|
|
if not(Result) and (j > 0) and (TempArray[0].wCodePage <> 1252) then
|
|
begin
|
|
TempSubBlock := '\StringFileInfo\' +
|
|
IntToHex(TempArray[0].wLanguage, 4) + IntToHex(1252, 4) +
|
|
'\' + aField;
|
|
|
|
if VerQueryValueW(TempBuffer, PWideChar(TempSubBlock), TempPointer, TempSize) then
|
|
begin
|
|
aValue := trim(PChar(TempPointer));
|
|
Result := (length(aValue) > 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetStringFileInfo', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempBuffer <> nil) then FreeMem(TempBuffer);
|
|
end;
|
|
end;
|
|
|
|
function GetDLLVersion(const aDLLFile : ustring; var aVersionInfo : TFileVersionInfo) : boolean;
|
|
var
|
|
TempVersion : uint64;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
if FileExists(aDLLFile) then
|
|
begin
|
|
TempVersion := GetExtendedFileVersion(aDLLFile);
|
|
if (TempVersion <> 0) then
|
|
begin
|
|
UInt64ToFileVersionInfo(TempVersion, aVersionInfo);
|
|
Result := True;
|
|
end;
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetDLLVersion', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function CheckDLLVersion(const aDLLFile : ustring; aMajor, aMinor, aRelease, aBuild : uint16) : boolean;
|
|
var
|
|
TempVersionInfo : TFileVersionInfo;
|
|
begin
|
|
Result := GetDLLVersion(aDLLFile, TempVersionInfo) and
|
|
(TempVersionInfo.MajorVer = aMajor) and
|
|
(TempVersionInfo.MinorVer = aMinor) and
|
|
(TempVersionInfo.Release = aRelease) and
|
|
(TempVersionInfo.Build = aBuild);
|
|
end;
|
|
|
|
// This function is based on the answer given by 'Alex' in StackOverflow
|
|
// https://stackoverflow.com/questions/2748474/how-to-determine-if-dll-file-was-compiled-as-x64-or-x86-bit-using-either-delphi
|
|
function GetDLLHeaderMachine(const aDLLFile : ustring; var aMachine : integer) : boolean;
|
|
var
|
|
TempHeader : TImageDosHeader;
|
|
TempImageNtHeaders : TImageNtHeaders;
|
|
TempStream : TFileStream;
|
|
begin
|
|
Result := False;
|
|
aMachine := IMAGE_FILE_MACHINE_UNKNOWN;
|
|
TempStream := nil;
|
|
|
|
try
|
|
try
|
|
if FileExists(aDLLFile) then
|
|
begin
|
|
TempStream := TFileStream.Create(aDLLFile, fmOpenRead or fmShareDenyWrite);
|
|
TempStream.seek(0, soFromBeginning);
|
|
TempStream.ReadBuffer(TempHeader, SizeOf(TempHeader));
|
|
|
|
if (TempHeader.e_magic = IMAGE_DOS_SIGNATURE) and
|
|
(TempHeader._lfanew <> 0) then
|
|
begin
|
|
TempStream.Position := TempHeader._lfanew;
|
|
TempStream.ReadBuffer(TempImageNtHeaders, SizeOf(TempImageNtHeaders));
|
|
|
|
if (TempImageNtHeaders.Signature = IMAGE_NT_SIGNATURE) then
|
|
begin
|
|
aMachine := TempImageNtHeaders.FileHeader.Machine;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetDLLHeaderMachine', e) then raise;
|
|
end;
|
|
finally
|
|
if (TempStream <> nil) then FreeAndNil(TempStream);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function FileVersionInfoToString(const aVersionInfo : TFileVersionInfo) : string;
|
|
begin
|
|
Result := IntToStr(aVersionInfo.MajorVer) + '.' +
|
|
IntToStr(aVersionInfo.MinorVer) + '.' +
|
|
IntToStr(aVersionInfo.Release) + '.' +
|
|
IntToStr(aVersionInfo.Build);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function Is32BitProcessRunningIn64BitOS : boolean;
|
|
var
|
|
TempResult : BOOL;
|
|
begin
|
|
Result := ProcessUnderWow64(GetCurrentProcess, TempResult) and TempResult;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function Is32BitProcess : boolean;
|
|
begin
|
|
{$IFDEF TARGET_32BITS}
|
|
Result := True;
|
|
{$ELSE}
|
|
{$IFDEF MSWINDOWS}
|
|
Result := Is32BitProcessRunningIn64BitOS;
|
|
{$ELSE}
|
|
{$IFDEF DELPHI17_UP}
|
|
Result := TOSVersion.Architecture in [arIntelX86, arARM32];
|
|
{$ELSE}
|
|
Result := False;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomPathIsRelative(const aPath : string) : boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF DELPHI12_UP}
|
|
Result := PathIsRelativeUnicode(PChar(aPath));
|
|
{$ELSE}
|
|
Result := PathIsRelativeAnsi(PChar(aPath));
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Result := (length(aPath) > 0) and (aPath[1] <> '/');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomPathIsURL(const aPath : string) : boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF DELPHI12_UP}
|
|
Result := PathIsURLUnicode(PChar(aPath + #0));
|
|
{$ELSE}
|
|
Result := PathIsURLAnsi(PChar(aPath + #0));
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Result := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomPathIsUNC(const aPath : string) : boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF DELPHI12_UP}
|
|
Result := PathIsUNCUnicode(PChar(aPath + #0));
|
|
{$ELSE}
|
|
Result := PathIsUNCAnsi(PChar(aPath + #0));
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Result := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomPathCanonicalize(const aOriginalPath : string; var aCanonicalPath : string) : boolean;
|
|
var
|
|
TempBuffer: array [0..pred(MAX_PATH)] of Char;
|
|
begin
|
|
Result := False;
|
|
aCanonicalPath := '';
|
|
|
|
if (length(aOriginalPath) > MAX_PATH) or
|
|
(Copy(aOriginalPath, 1, 4) = '\\?\') or
|
|
CustomPathIsUNC(aOriginalPath) then
|
|
exit;
|
|
|
|
FillChar(TempBuffer, MAX_PATH * SizeOf(Char), 0);
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$IFDEF DELPHI12_UP}
|
|
if PathCanonicalizeUnicode(@TempBuffer[0], PChar(aOriginalPath + #0)) then
|
|
begin
|
|
aCanonicalPath := TempBuffer;
|
|
Result := True;
|
|
end;
|
|
{$ELSE}
|
|
if PathCanonicalizeAnsi(@TempBuffer[0], PChar(aOriginalPath + #0)) then
|
|
begin
|
|
aCanonicalPath := TempBuffer;
|
|
Result := True;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function CustomAbsolutePath(const aPath : string; aMustExist : boolean) : string;
|
|
var
|
|
TempNewPath, TempOldPath : string;
|
|
begin
|
|
if (length(aPath) > 0) then
|
|
begin
|
|
if CustomPathIsRelative(aPath) then
|
|
TempOldPath := GetModulePath + aPath
|
|
else
|
|
TempOldPath := aPath;
|
|
|
|
if not(CustomPathCanonicalize(TempOldPath, TempNewPath)) then
|
|
TempNewPath := TempOldPath;
|
|
|
|
if aMustExist and not(DirectoryExists(TempNewPath)) then
|
|
Result := ''
|
|
else
|
|
Result := TempNewPath;
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function GetModulePath : string;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := IncludeTrailingPathDelimiter(ExtractFileDir(GetModuleName(HINSTANCE{$IFDEF FPC}(){$ENDIF})));
|
|
{$ELSE}
|
|
// DLL filename not supported
|
|
Result := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
|
|
function CefParseUrl(const url: ustring; var parts: TUrlParts): Boolean;
|
|
var
|
|
TempURL : TCefString;
|
|
TempParts : TCefUrlParts;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
FillChar(TempParts, sizeof(TempParts), 0);
|
|
TempURL := CefString(url);
|
|
Result := cef_parse_url(@TempURL, TempParts) <> 0;
|
|
|
|
if Result then
|
|
begin
|
|
parts.spec := CefString(@TempParts.spec);
|
|
parts.scheme := CefString(@TempParts.scheme);
|
|
parts.username := CefString(@TempParts.username);
|
|
parts.password := CefString(@TempParts.password);
|
|
parts.host := CefString(@TempParts.host);
|
|
parts.port := CefString(@TempParts.port);
|
|
parts.origin := CefString(@TempParts.origin);
|
|
parts.path := CefString(@TempParts.path);
|
|
parts.query := CefString(@TempParts.query);
|
|
parts.fragment := CefString(@TempParts.fragment);
|
|
end;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefCreateUrl(var parts: TUrlParts): ustring;
|
|
var
|
|
TempURL : TCefString;
|
|
TempParts : TCefUrlParts;
|
|
begin
|
|
Result := '';
|
|
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempParts.spec := CefString(parts.spec);
|
|
TempParts.scheme := CefString(parts.scheme);
|
|
TempParts.username := CefString(parts.username);
|
|
TempParts.password := CefString(parts.password);
|
|
TempParts.host := CefString(parts.host);
|
|
TempParts.port := CefString(parts.port);
|
|
TempParts.origin := CefString(parts.origin);
|
|
TempParts.path := CefString(parts.path);
|
|
TempParts.query := CefString(parts.query);
|
|
TempParts.fragment := CefString(parts.fragment);
|
|
|
|
CefStringInitialize(@TempURL);
|
|
|
|
if (cef_create_url(@TempParts, @TempURL) <> 0) then
|
|
Result := CefStringClearAndGet(@TempURL);
|
|
end;
|
|
end;
|
|
|
|
function CefFormatUrlForSecurityDisplay(const originUrl: string): string;
|
|
var
|
|
TempOrigin : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempOrigin := CefString(originUrl);
|
|
Result := CefStringFreeAndGet(cef_format_url_for_security_display(@TempOrigin));
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefGetMimeType(const extension: ustring): ustring;
|
|
var
|
|
TempExt : TCefString;
|
|
begin
|
|
TempExt := CefString(extension);
|
|
Result := CefStringFreeAndGet(cef_get_mime_type(@TempExt));
|
|
end;
|
|
|
|
procedure CefGetExtensionsForMimeType(const mimeType: ustring; var extensions: TStringList);
|
|
var
|
|
TempSL : ICefStringList;
|
|
TempMimeType : TCefString;
|
|
begin
|
|
if (extensions <> nil) and (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempSL := TCefStringListOwn.Create;
|
|
TempMimeType := CefString(mimeType);
|
|
cef_get_extensions_for_mime_type(@TempMimeType, TempSL.Handle);
|
|
TempSL.CopyToStrings(extensions);
|
|
end;
|
|
end;
|
|
|
|
function CefBase64Encode(const data: Pointer; dataSize: NativeUInt): ustring;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
Result := CefStringFreeAndGet(cef_base64encode(data, dataSize))
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefBase64Decode(const data: ustring): ICefBinaryValue;
|
|
var
|
|
TempData : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempData := CefString(data);
|
|
Result := TCefBinaryValueRef.UnWrap(cef_base64decode(@TempData));
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function CefUriEncode(const text: ustring; usePlus: Boolean): ustring;
|
|
var
|
|
TempText : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempText := CefString(text);
|
|
Result := CefStringFreeAndGet(cef_uriencode(@TempText, Ord(usePlus)));
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefUriDecode(const text: ustring; convertToUtf8: Boolean; unescapeRule: TCefUriUnescapeRule): ustring;
|
|
var
|
|
TempText : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempText := CefString(text);
|
|
Result := CefStringFreeAndGet(cef_uridecode(@TempText, Ord(convertToUtf8), unescapeRule));
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefGetPath(const aPathKey : TCefPathKey) : ustring;
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
CefStringInitialize(@TempPath);
|
|
|
|
if (cef_get_path(aPathKey, @TempPath) <> 0) then
|
|
Result := CefStringClearAndGet(@TempPath);
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefCreateDirectory(const fullPath: ustring): Boolean;
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempPath := CefString(fullPath);
|
|
Result := cef_create_directory(@TempPath) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefGetTempDirectory(out tempDir: ustring): Boolean;
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
CefStringInitialize(@TempPath);
|
|
Result := cef_get_temp_directory(@TempPath) <> 0;
|
|
tempDir := CefStringClearAndGet(@TempPath);
|
|
end
|
|
else
|
|
begin
|
|
Result := False;
|
|
tempDir := '';
|
|
end;
|
|
end;
|
|
|
|
function CefCreateNewTempDirectory(const prefix: ustring; out newTempPath: ustring): Boolean;
|
|
var
|
|
TempPath, TempPref : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
CefStringInitialize(@TempPath);
|
|
TempPref := CefString(prefix);
|
|
Result := cef_create_new_temp_directory(@TempPref, @TempPath) <> 0;
|
|
newTempPath := CefStringClearAndGet(@TempPath);
|
|
end
|
|
else
|
|
begin
|
|
Result := False;
|
|
newTempPath := '';
|
|
end;
|
|
end;
|
|
|
|
function CefCreateTempDirectoryInDirectory(const baseDir, prefix: ustring; out newDir: ustring): Boolean;
|
|
var
|
|
TempBase, TempPath, TempPref: TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
CefStringInitialize(@TempPath);
|
|
TempPref := CefString(prefix);
|
|
TempBase := CefString(baseDir);
|
|
Result := cef_create_temp_directory_in_directory(@TempBase, @TempPref, @TempPath) <> 0;
|
|
newDir := CefStringClearAndGet(@TempPath);
|
|
end
|
|
else
|
|
begin
|
|
Result := False;
|
|
newDir := '';
|
|
end;
|
|
end;
|
|
|
|
function CefDirectoryExists(const path: ustring): Boolean;
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempPath := CefString(path);
|
|
Result := cef_directory_exists(@TempPath) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefDeleteFile(const path: ustring; recursive: Boolean): Boolean;
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempPath := CefString(path);
|
|
Result := cef_delete_file(@TempPath, Ord(recursive)) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CefZipDirectory(const srcDir, destFile: ustring; includeHiddenFiles: Boolean): Boolean;
|
|
var
|
|
TempSrc, TempDst : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempSrc := CefString(srcDir);
|
|
TempDst := CefString(destFile);
|
|
Result := cef_zip_directory(@TempSrc, @TempDst, Ord(includeHiddenFiles)) <> 0;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure CefLoadCRLSetsFile(const path : ustring);
|
|
var
|
|
TempPath : TCefString;
|
|
begin
|
|
if (GlobalCEFApp <> nil) and GlobalCEFApp.LibLoaded then
|
|
begin
|
|
TempPath := CefString(path);
|
|
cef_load_crlsets_file(@TempPath);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function CefIsKeyDown(aWparam : WPARAM) : boolean;
|
|
begin
|
|
Result := (GetKeyState(aWparam) < 0);
|
|
end;
|
|
|
|
function CefIsKeyToggled(aWparam : WPARAM) : boolean;
|
|
begin
|
|
Result := (GetKeyState(aWparam) and $1) <> 0;
|
|
end;
|
|
|
|
function GetCefMouseModifiers(aWparam : WPARAM) : TCefEventFlags;
|
|
begin
|
|
Result := EVENTFLAG_NONE;
|
|
|
|
if ((aWparam and MK_CONTROL) <> 0) then Result := Result or EVENTFLAG_CONTROL_DOWN;
|
|
if ((aWparam and MK_SHIFT) <> 0) then Result := Result or EVENTFLAG_SHIFT_DOWN;
|
|
if ((aWparam and MK_LBUTTON) <> 0) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
|
|
if ((aWparam and MK_MBUTTON) <> 0) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
|
|
if ((aWparam and MK_RBUTTON) <> 0) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
|
|
if CefIsKeyDown(VK_MENU) then Result := Result or EVENTFLAG_ALT_DOWN;
|
|
if CefIsKeyToggled(VK_NUMLOCK) then Result := Result or EVENTFLAG_NUM_LOCK_ON;
|
|
if CefIsKeyToggled(VK_CAPITAL) then Result := Result or EVENTFLAG_CAPS_LOCK_ON;
|
|
end;
|
|
|
|
function GetCefMouseModifiers : TCefEventFlags;
|
|
begin
|
|
Result := EVENTFLAG_NONE;
|
|
|
|
if CefIsKeyDown(MK_CONTROL) then Result := Result or EVENTFLAG_CONTROL_DOWN;
|
|
if CefIsKeyDown(MK_SHIFT) then Result := Result or EVENTFLAG_SHIFT_DOWN;
|
|
if CefIsKeyDown(MK_LBUTTON) then Result := Result or EVENTFLAG_LEFT_MOUSE_BUTTON;
|
|
if CefIsKeyDown(MK_MBUTTON) then Result := Result or EVENTFLAG_MIDDLE_MOUSE_BUTTON;
|
|
if CefIsKeyDown(MK_RBUTTON) then Result := Result or EVENTFLAG_RIGHT_MOUSE_BUTTON;
|
|
if CefIsKeyDown(VK_MENU) then Result := Result or EVENTFLAG_ALT_DOWN;
|
|
if CefIsKeyToggled(VK_NUMLOCK) then Result := Result or EVENTFLAG_NUM_LOCK_ON;
|
|
if CefIsKeyToggled(VK_CAPITAL) then Result := Result or EVENTFLAG_CAPS_LOCK_ON;
|
|
end;
|
|
|
|
function GetCefKeyboardModifiers(aWparam : WPARAM; aLparam : LPARAM) : TCefEventFlags;
|
|
begin
|
|
Result := EVENTFLAG_NONE;
|
|
|
|
if CefIsKeyDown(VK_SHIFT) then Result := Result or EVENTFLAG_SHIFT_DOWN;
|
|
if CefIsKeyDown(VK_CONTROL) then Result := Result or EVENTFLAG_CONTROL_DOWN;
|
|
if CefIsKeyDown(VK_MENU) then Result := Result or EVENTFLAG_ALT_DOWN;
|
|
if CefIsKeyToggled(VK_NUMLOCK) then Result := Result or EVENTFLAG_NUM_LOCK_ON;
|
|
if CefIsKeyToggled(VK_CAPITAL) then Result := Result or EVENTFLAG_CAPS_LOCK_ON;
|
|
|
|
|
|
case aWparam of
|
|
VK_RETURN:
|
|
if (((aLparam shr 16) and KF_EXTENDED) <> 0) then Result := Result or EVENTFLAG_IS_KEY_PAD;
|
|
|
|
VK_INSERT,
|
|
VK_DELETE,
|
|
VK_HOME,
|
|
VK_END,
|
|
VK_PRIOR,
|
|
VK_NEXT,
|
|
VK_UP,
|
|
VK_DOWN,
|
|
VK_LEFT,
|
|
VK_RIGHT :
|
|
if (((aLparam shr 16) and KF_EXTENDED) = 0) then Result := Result or EVENTFLAG_IS_KEY_PAD;
|
|
|
|
VK_NUMLOCK,
|
|
VK_NUMPAD0,
|
|
VK_NUMPAD1,
|
|
VK_NUMPAD2,
|
|
VK_NUMPAD3,
|
|
VK_NUMPAD4,
|
|
VK_NUMPAD5,
|
|
VK_NUMPAD6,
|
|
VK_NUMPAD7,
|
|
VK_NUMPAD8,
|
|
VK_NUMPAD9,
|
|
VK_DIVIDE,
|
|
VK_MULTIPLY,
|
|
VK_SUBTRACT,
|
|
VK_ADD,
|
|
VK_DECIMAL,
|
|
VK_CLEAR :
|
|
Result := Result or EVENTFLAG_IS_KEY_PAD;
|
|
|
|
VK_SHIFT :
|
|
if CefIsKeyDown(VK_LSHIFT) then
|
|
Result := Result or EVENTFLAG_IS_LEFT
|
|
else
|
|
if CefIsKeyDown(VK_RSHIFT) then
|
|
Result := Result or EVENTFLAG_IS_RIGHT;
|
|
|
|
VK_CONTROL :
|
|
if CefIsKeyDown(VK_LCONTROL) then
|
|
Result := Result or EVENTFLAG_IS_LEFT
|
|
else
|
|
if CefIsKeyDown(VK_RCONTROL) then
|
|
Result := Result or EVENTFLAG_IS_RIGHT;
|
|
|
|
VK_MENU :
|
|
if CefIsKeyDown(VK_LMENU) then
|
|
Result := Result or EVENTFLAG_IS_LEFT
|
|
else
|
|
if CefIsKeyDown(VK_RMENU) then
|
|
Result := Result or EVENTFLAG_IS_RIGHT;
|
|
|
|
VK_LWIN :
|
|
Result := Result or EVENTFLAG_IS_LEFT;
|
|
|
|
VK_RWIN :
|
|
Result := Result or EVENTFLAG_IS_RIGHT;
|
|
end;
|
|
end;
|
|
|
|
procedure CefCheckAltGrPressed(aWparam : WPARAM; var aEvent : TCefKeyEvent);
|
|
const
|
|
EITHER_SHIFT_KEY_PRESSED = $01;
|
|
EITHER_CONTROL_KEY_PRESSED = $02;
|
|
EITHER_ALT_KEY_PRESSED = $04;
|
|
EITHER_HANKAKU_KEY_PRESSED = $08;
|
|
EITHER_RESERVED1_KEY_PRESSED = $10;
|
|
EITHER_RESERVED2_KEY_PRESSED = $20;
|
|
var
|
|
TempKBLayout : HKL;
|
|
TempTranslatedChar : SHORT;
|
|
TempShiftState : byte;
|
|
begin
|
|
if (aEvent.kind = KEYEVENT_CHAR) and CefIsKeyDown(VK_RMENU) then
|
|
begin
|
|
TempKBLayout := GetKeyboardLayout(0);
|
|
TempTranslatedChar := VkKeyScanEx(char(aWparam), TempKBLayout);
|
|
TempShiftState := byte(TempTranslatedChar shr 8);
|
|
|
|
if ((TempShiftState and EITHER_CONTROL_KEY_PRESSED) <> 0) and
|
|
((TempShiftState and EITHER_ALT_KEY_PRESSED) <> 0) then
|
|
begin
|
|
aEvent.modifiers := aEvent.modifiers and not(EVENTFLAG_CONTROL_DOWN or EVENTFLAG_ALT_DOWN);
|
|
aEvent.modifiers := aEvent.modifiers or EVENTFLAG_ALTGR_DOWN;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DropEffectToDragOperation(aEffect: Longint; var aAllowedOps : TCefDragOperations);
|
|
begin
|
|
aAllowedOps := DRAG_OPERATION_NONE;
|
|
|
|
if ((aEffect and DROPEFFECT_COPY) <> 0) then aAllowedOps := aAllowedOps or DRAG_OPERATION_COPY;
|
|
if ((aEffect and DROPEFFECT_LINK) <> 0) then aAllowedOps := aAllowedOps or DRAG_OPERATION_LINK;
|
|
if ((aEffect and DROPEFFECT_MOVE) <> 0) then aAllowedOps := aAllowedOps or DRAG_OPERATION_MOVE;
|
|
end;
|
|
|
|
procedure DragOperationToDropEffect(const aDragOperations : TCefDragOperations; var aEffect: Longint);
|
|
begin
|
|
aEffect := DROPEFFECT_NONE;
|
|
|
|
if ((aDragOperations and DRAG_OPERATION_COPY) <> 0) then aEffect := aEffect or DROPEFFECT_COPY;
|
|
if ((aDragOperations and DRAG_OPERATION_LINK) <> 0) then aEffect := aEffect or DROPEFFECT_LINK;
|
|
if ((aDragOperations and DRAG_OPERATION_MOVE) <> 0) then aEffect := aEffect or DROPEFFECT_MOVE;
|
|
end;
|
|
|
|
function GetWindowsMajorMinorVersion(var wMajorVersion, wMinorVersion : DWORD) : boolean;
|
|
type
|
|
TRtlGetVersionFunc = function(var lpVersionInformation : TOSVersionInfoEx): LongInt; stdcall;
|
|
var
|
|
TempHandle : THandle;
|
|
TempInfo : TOSVersionInfoEx;
|
|
TempRtlGetVersionFunc : TRtlGetVersionFunc;
|
|
begin
|
|
Result := False;
|
|
wMajorVersion := 0;
|
|
wMinorVersion := 0;
|
|
|
|
try
|
|
TempHandle := LoadLibrary(NTDLL);
|
|
|
|
if (TempHandle <> 0) then
|
|
try
|
|
{$IFDEF FPC}Pointer({$ENDIF}TempRtlGetVersionFunc{$IFDEF FPC}){$ENDIF} := GetProcAddress(TempHandle, 'RtlGetVersion');
|
|
|
|
if assigned(TempRtlGetVersionFunc) then
|
|
begin
|
|
ZeroMemory(@TempInfo, SizeOf(TOSVersionInfoEx));
|
|
|
|
if (TempRtlGetVersionFunc(TempInfo) = 0) then
|
|
begin
|
|
Result := True;
|
|
wMajorVersion := TempInfo.dwMajorVersion;
|
|
wMinorVersion := TempInfo.dwMinorVersion;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeLibrary(TempHandle);
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetWindowsMajorMinorVersion', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
// GetDpiForWindow is only available in Windows 10 (version 1607) or newer
|
|
function GetDPIForHandle(aHandle : HWND; var aDPI : UINT) : boolean;
|
|
type
|
|
TGetDpiForWindow = function(hwnd: HWND): UINT; stdcall;
|
|
var
|
|
TempHandle : THandle;
|
|
TempGetDpiForWindowFunc : TGetDpiForWindow;
|
|
begin
|
|
Result := False;
|
|
aDPI := 0;
|
|
|
|
if (aHandle = 0) then exit;
|
|
|
|
try
|
|
TempHandle := LoadLibrary(User32DLL);
|
|
|
|
if (TempHandle <> 0) then
|
|
try
|
|
{$IFDEF FPC}Pointer({$ENDIF}TempGetDpiForWindowFunc{$IFDEF FPC}){$ENDIF} := GetProcAddress(TempHandle, 'GetDpiForWindow');
|
|
|
|
if assigned(TempGetDpiForWindowFunc) then
|
|
begin
|
|
aDPI := TempGetDpiForWindowFunc(aHandle);
|
|
Result := (aDPI <> 0);
|
|
end;
|
|
finally
|
|
FreeLibrary(TempHandle);
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('GetDPIForHandle', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function RunningWindows10OrNewer : boolean;
|
|
var
|
|
TempMajorVer, TempMinorVer : DWORD;
|
|
begin
|
|
Result := GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and (TempMajorVer >= 10);
|
|
end;
|
|
|
|
function GetDefaultCEFUserAgent : string;
|
|
var
|
|
TempOS, TempChromiumVersion : string;
|
|
TempMajorVer, TempMinorVer : DWORD;
|
|
Temp64bit : BOOL;
|
|
begin
|
|
if GetWindowsMajorMinorVersion(TempMajorVer, TempMinorVer) and
|
|
(TempMajorVer >= 4) then
|
|
TempOS := 'Windows NT'
|
|
else
|
|
TempOS := 'Windows';
|
|
|
|
TempOS := TempOS + ' ' + inttostr(TempMajorVer) + '.' + inttostr(TempMinorVer);
|
|
|
|
if ProcessUnderWow64(GetCurrentProcess(), Temp64bit) and Temp64bit then
|
|
TempOS := TempOS + '; WOW64';
|
|
|
|
if (GlobalCEFApp <> nil) then
|
|
TempChromiumVersion := GlobalCEFApp.ChromeVersion
|
|
else
|
|
TempChromiumVersion := inttostr(CEF_CHROMEELF_VERSION_MAJOR) + '.' +
|
|
inttostr(CEF_CHROMEELF_VERSION_MINOR) + '.' +
|
|
inttostr(CEF_CHROMEELF_VERSION_RELEASE) + '.' +
|
|
inttostr(CEF_CHROMEELF_VERSION_BUILD);
|
|
|
|
Result := 'Mozilla/5.0' + ' (' + TempOS + ') ' +
|
|
'AppleWebKit/537.36 (KHTML, like Gecko) ' +
|
|
'Chrome/' + TempChromiumVersion + ' Safari/537.36';
|
|
end;
|
|
|
|
{$IFDEF DELPHI14_UP}
|
|
function TouchPointToPoint(aHandle : HWND; const TouchPoint: TTouchInput): TPoint;
|
|
begin
|
|
Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
|
|
PhysicalToLogicalPoint(aHandle, Result);
|
|
end;
|
|
|
|
function GetDigitizerStatus(var aDigitizerStatus : TDigitizerStatus; aDPI : cardinal) : boolean;
|
|
var
|
|
TempStatus : integer;
|
|
begin
|
|
{$IFDEF DELPHI26_UP}
|
|
if (aDPI > 0) then
|
|
TempStatus := GetSystemMetricsForDpi(SM_DIGITIZER, aDPI)
|
|
else
|
|
{$ENDIF}
|
|
TempStatus := GetSystemMetrics(SM_DIGITIZER);
|
|
|
|
aDigitizerStatus.IntegratedTouch := ((TempStatus and NID_INTEGRATED_TOUCH) <> 0);
|
|
aDigitizerStatus.ExternalTouch := ((TempStatus and NID_EXTERNAL_TOUCH) <> 0);
|
|
aDigitizerStatus.IntegratedPen := ((TempStatus and NID_INTEGRATED_PEN) <> 0);
|
|
aDigitizerStatus.ExternalPen := ((TempStatus and NID_EXTERNAL_PEN) <> 0);
|
|
aDigitizerStatus.MultiInput := ((TempStatus and NID_MULTI_INPUT) <> 0);
|
|
aDigitizerStatus.Ready := ((TempStatus and NID_READY) <> 0);
|
|
|
|
Result := (TempStatus <> 0);
|
|
end;
|
|
|
|
function HasTouchOrPen(aDPI : cardinal) : boolean;
|
|
var
|
|
TempStatus : TDigitizerStatus;
|
|
begin
|
|
Result := GetDigitizerStatus(TempStatus, aDPI);
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function DeviceToLogical(aValue : integer; const aDeviceScaleFactor : double) : integer;
|
|
begin
|
|
Result := floor(aValue / aDeviceScaleFactor);
|
|
end;
|
|
|
|
function DeviceToLogical(aValue : single; const aDeviceScaleFactor : double) : single;
|
|
begin
|
|
Result := aValue / aDeviceScaleFactor;
|
|
end;
|
|
|
|
procedure DeviceToLogical(var aEvent : TCEFMouseEvent; const aDeviceScaleFactor : double);
|
|
begin
|
|
aEvent.x := DeviceToLogical(aEvent.x, aDeviceScaleFactor);
|
|
aEvent.y := DeviceToLogical(aEvent.y, aDeviceScaleFactor);
|
|
end;
|
|
|
|
procedure DeviceToLogical(var aEvent : TCefTouchEvent; const aDeviceScaleFactor : double);
|
|
begin
|
|
aEvent.x := DeviceToLogical(aEvent.x, aDeviceScaleFactor);
|
|
aEvent.y := DeviceToLogical(aEvent.y, aDeviceScaleFactor);
|
|
end;
|
|
|
|
procedure DeviceToLogical(var aPoint : TPoint; const aDeviceScaleFactor : double);
|
|
begin
|
|
aPoint.x := DeviceToLogical(aPoint.x, aDeviceScaleFactor);
|
|
aPoint.y := DeviceToLogical(aPoint.y, aDeviceScaleFactor);
|
|
end;
|
|
|
|
function LogicalToDevice(aValue : integer; const aDeviceScaleFactor : double) : integer;
|
|
begin
|
|
Result := floor(aValue * aDeviceScaleFactor);
|
|
end;
|
|
|
|
procedure LogicalToDevice(var aRect : TCEFRect; const aDeviceScaleFactor : double);
|
|
begin
|
|
aRect.x := LogicalToDevice(aRect.x, aDeviceScaleFactor);
|
|
aRect.y := LogicalToDevice(aRect.y, aDeviceScaleFactor);
|
|
aRect.width := LogicalToDevice(aRect.width, aDeviceScaleFactor);
|
|
aRect.height := LogicalToDevice(aRect.height, aDeviceScaleFactor);
|
|
end;
|
|
|
|
function GetScreenDPI : integer;
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
TempDC : HDC;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
TempDC := GetDC(0);
|
|
Result := GetDeviceCaps(TempDC, LOGPIXELSX);
|
|
ReleaseDC(0, TempDC);
|
|
{$ELSE}
|
|
{$IFDEF MACOS}
|
|
Result := trunc(MainScreen.backingScaleFactor);
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Result := screen.PrimaryMonitor.PixelsPerInch;
|
|
{$ELSE}
|
|
// TODO: Find a way to get the screen scale in Delphi FMX for Linux
|
|
Result := 96;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetDeviceScaleFactor : single;
|
|
begin
|
|
Result := GetScreenDPI / USER_DEFAULT_SCREEN_DPI;
|
|
end;
|
|
|
|
function DeleteDirContents(const aDirectory : string; const aExcludeFiles : TStringList) : boolean;
|
|
var
|
|
TempRec : TSearchRec;
|
|
TempPath : string;
|
|
TempIdx : integer;
|
|
begin
|
|
Result := True;
|
|
|
|
try
|
|
if (length(aDirectory) > 0) and
|
|
DirectoryExists(aDirectory) and
|
|
(FindFirst(aDirectory + '\*', faAnyFile, TempRec) = 0) then
|
|
try
|
|
repeat
|
|
TempPath := aDirectory + PathDelim + TempRec.Name;
|
|
|
|
if ((TempRec.Attr and faDirectory) <> 0) then
|
|
begin
|
|
if (TempRec.Name <> '.') and (TempRec.Name <> '..') then
|
|
begin
|
|
if DeleteDirContents(TempPath, aExcludeFiles) then
|
|
Result := RemoveDir(TempPath) and Result
|
|
else
|
|
Result := False;
|
|
end;
|
|
end
|
|
else
|
|
if (aExcludeFiles <> nil) then
|
|
begin
|
|
TempIdx := aExcludeFiles.IndexOf(TempRec.Name);
|
|
Result := ((TempIdx >= 0) or
|
|
((TempIdx < 0) and DeleteFile(TempPath))) and
|
|
Result;
|
|
end
|
|
else
|
|
Result := DeleteFile(TempPath) and Result;
|
|
|
|
until (FindNext(TempRec) <> 0) or not(Result);
|
|
finally
|
|
FindClose(TempRec);
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('DeleteDirContents', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function DeleteFileList(const aFileList : TStringList) : boolean;
|
|
var
|
|
i, TempCount : integer;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
if (aFileList <> nil) then
|
|
begin
|
|
i := 0;
|
|
TempCount := 0;
|
|
|
|
while (i < aFileList.Count) do
|
|
begin
|
|
if FileExists(aFileList[i]) and DeleteFile(aFileList[i]) then inc(TempCount);
|
|
inc(i);
|
|
end;
|
|
|
|
Result := (aFileList.Count = TempCount);
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('DeleteFileList', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function MoveFileList(const aFileList : TStringList; const aSrcDirectory, aDstDirectory : string) : boolean;
|
|
var
|
|
i, TempCount : integer;
|
|
TempSrcPath, TempDstPath : string;
|
|
begin
|
|
Result := False;
|
|
|
|
try
|
|
if (aFileList <> nil) and
|
|
(length(aSrcDirectory) > 0) and
|
|
(length(aDstDirectory) > 0) and
|
|
DirectoryExists(aSrcDirectory) and
|
|
(DirectoryExists(aDstDirectory) or CreateDir(aDstDirectory)) then
|
|
begin
|
|
i := 0;
|
|
TempCount := 0;
|
|
|
|
while (i < aFileList.Count) do
|
|
begin
|
|
TempSrcPath := IncludeTrailingPathDelimiter(aSrcDirectory) + aFileList[i];
|
|
TempDstPath := IncludeTrailingPathDelimiter(aDstDirectory) + aFileList[i];
|
|
|
|
if FileExists(TempSrcPath) and RenameFile(TempSrcPath, TempDstPath) then inc(TempCount);
|
|
|
|
inc(i);
|
|
end;
|
|
|
|
Result := (aFileList.Count = TempCount);
|
|
end;
|
|
except
|
|
on e : exception do
|
|
if CustomExceptionHandler('MoveFileList', e) then raise;
|
|
end;
|
|
end;
|
|
|
|
function CefGetDataURI(const aString, aMimeType : ustring) : ustring;
|
|
var
|
|
TempUTF : AnsiString;
|
|
begin
|
|
TempUTF := UTF8Encode(aString);
|
|
|
|
if (length(TempUTF) > 0) then
|
|
Result := CefGetDataURI(@TempUTF[1], length(TempUTF), aMimeType, 'utf-8')
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function CefGetDataURI(aData : pointer; aSize : integer; const aMimeType, aCharset : ustring) : ustring;
|
|
begin
|
|
Result := 'data:' + aMimeType;
|
|
|
|
if (length(aCharset) > 0) then Result := Result + ';charset=' + aCharset;
|
|
|
|
Result := Result + ';base64,' + CefURIEncode(CefBase64Encode(aData, aSize), false);
|
|
end;
|
|
|
|
function ValidCefWindowHandle(aHandle : TCefWindowHandle) : boolean;
|
|
begin
|
|
{$IFDEF MACOS}
|
|
Result := (aHandle <> nil);
|
|
{$ELSE}
|
|
Result := (aHandle <> 0);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure InitializeWindowHandle(var aHandle : TCefWindowHandle);
|
|
begin
|
|
{$IFDEF MACOS}
|
|
aHandle := nil;
|
|
{$ELSE}
|
|
aHandle := 0;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end.
|