Commit 4c256697: Portando atualizações do JCL upstream

JclMime.pas

-13+15

/common/JclMime.pas

View

procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; InputOffset: SizeInt;

const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt);

var

B, InnerLimit, OuterLimit: SizeInt;

InIndex: SizeInt;

OutIndex: SizeInt;

B: SizeInt;

InnerLimit, OuterLimit: TJclAddr;

InIndex: TJclAddr;

OutIndex: TJclAddr;

begin

{ Do we have enough input to encode a full line? }

if InputByteCount < MIME_DECODED_LINE_BREAK then

procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; InputOffset: SizeInt;

const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt);

var

B, InnerLimit, OuterLimit: SizeInt;

InIndex: SizeInt;

OutIndex: SizeInt;

B: SizeInt;

InnerLimit, OuterLimit: TJclAddr;

InIndex: TJclAddr;

OutIndex: TJclAddr;

begin

if InputByteCount = 0 then

Exit;

end;

{ End of data & padding. }

case InputByteCount - OuterLimit of

case TJclAddr(InputByteCount) - OuterLimit of

1:

begin

B := InputBuffer[InIndex + 0];

procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer);

var

B: Cardinal;

InnerLimit, OuterLimit: SizeInt;

InnerLimit, OuterLimit: TJclAddr;

InPtr: PByte3;

OutPtr: PByte4;

begin

end;

{ End of data & padding. }

case InputByteCount - OuterLimit of

case TJclAddr(InputByteCount) - OuterLimit of

1:

begin

B := InPtr^.B1;

var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt;

var

LByteBuffer, LByteBufferSpace, C: Cardinal;

InIndex, OuterLimit: SizeInt;

OutIndex: SizeInt;

InIndex, OuterLimit: TJclAddr;

OutIndex: TJclAddr;

begin

if InputByteCount > 0 then

begin

InIndex := InputOffset;

OuterLimit := InIndex + InputByteCount;

OuterLimit := InIndex + TJclAddr(InputByteCount);

OutIndex := OutputOffset;

LByteBuffer := ByteBuffer;

LByteBufferSpace := ByteBufferSpace;

end;

ByteBuffer := LByteBuffer;

ByteBufferSpace := LByteBufferSpace;

Result := OutIndex - OutputOffset;

Result := OutIndex - TJclAddr(OutputOffset);

end

else

Result := 0;

JclResources.pas

+16

/common/JclResources.pas

View

RsCompressionSquashFSExtensions = '*.squashfs';

RsCompressionCramFSName = 'CramFS archive';

RsCompressionCramFSExtensions = '*.cramfs';

RsCompressionExtName = 'Ext filesystem archive';

RsCompressionExtExtensions = '*.ext;*.ext2;*.ext3;*.ext4;*.img';

RsCompressionVMDKName = 'Virtual Machine Disk archive';

RsCompressionVMDKExtensions = '*.vmdk';

RsCompressionVDIName = 'Virtual Disk Image archive';

RsCompressionVDIExtensions = '*.vdi';

RsCompressionQcowName = 'QEMU Copy On Write archive';

RsCompressionQcowExtensions = '*.qcow;*.qcow2;*.qcow2c';

RsCompressionGPTName = 'GUID Partition Table archive';

RsCompressionGPTExtensions = '*.gpt;*.mbr';

RsCompressionRar5Name = 'RAR v5 archive';

RsCompressionRar5Extensions = '*.rar;*.r00';

RsCompressionIHexName = 'IHex archive';

RsCompressionIHexExtensions = '*.ihex';

RsCompressionHxsName = 'Help 2.0 archive';

RsCompressionHxsExtensions = '*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit';

RsCompressionDuplicate = 'The file %s already exists in the archive';

RsCompressionReplaceError = 'At least one compression volume could not be replaced after an archive out-of-place update';

JclSysInfo.pas

-18+283

/common/JclSysInfo.pas

View

function ModuleFromAddr(const Addr: Pointer): HMODULE;

function IsSystemModule(const Module: HMODULE): Boolean;

procedure BeginModuleFromAddrCache;

procedure EndModuleFromAddrCache;

function CachedModuleFromAddr(const Addr: Pointer): HMODULE;

function IsMainAppWindow(Wnd: THandle): Boolean;

function IsWindowResponding(Wnd: THandle; Timeout: Integer): Boolean;

function GetWindowsVersionNumber: string;

function GetWindowsServicePackVersion: Integer;

function GetWindowsServicePackVersionString: string;

function GetWindows10ReleaseId: Integer;

function GetWindows10ReleaseName: String;

function GetWindows10ReleaseCodeName: String;

function GetWindows10ReleaseVersion: String;

function GetOpenGLVersion(const Win: THandle; out Version, Vendor: AnsiString): Boolean;

function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean;

function GetProcessorArchitecture: TProcessorArchitecture;

{$IFDEF MSWINDOWS}

function GetRegisteredCompany: string;

var

LastAccessMode: TJclRegWOW64Access;

begin

{ TODO : check for MSDN documentation }

LastAccessMode := RegGetWOW64AccessMode;

try

RegSetWOW64AccessMode(raNative);

Result := RegReadStringDef(HKEY_LOCAL_MACHINE, REG_CURRENT_VERSION, 'RegisteredOrganization', '');

finally

RegSetWOW64AccessMode(LastAccessMode);

end;

function GetRegisteredOwner: string;

var

LastAccessMode: TJclRegWOW64Access;

begin

{ TODO : check for MSDN documentation }

LastAccessMode := RegGetWOW64AccessMode;

try

RegSetWOW64AccessMode(raNative);

Result := RegReadStringDef(HKEY_LOCAL_MACHINE, REG_CURRENT_VERSION, 'RegisteredOwner', '');

finally

RegSetWOW64AccessMode(LastAccessMode);

end;

{ TODO: Check supported platforms, maybe complete rewrite }

var

MI: TMemoryBasicInformation;

begin

MI.AllocationBase := nil;

VirtualQuery(Addr, MI, SizeOf(MI));

if MI.State <> MEM_COMMIT then

Result := 0

if (VirtualQuery(Addr, MI, SizeOf(MI)) = SizeOf(MI)) and (MI.State = MEM_COMMIT) then

Result := HMODULE(MI.AllocationBase)

else

Result := HMODULE(MI.AllocationBase);

Result := 0;

end;

function IsSystemModule(const Module: HMODULE): Boolean;

end;

CurModule := CurModule.Next;

end;

// Cache for the slow VirtualQuery calls

//

// BeginModuleFromAddrCache;

// try

// Module := CachedModuleFromAddr(Address);

// ...

// finally

// EndModuleFromAddrCache;

// end;

type

PModuleAddrSize = ^TModuleAddrSize;

TModuleAddrSize = record

BaseAddress: TJclAddr;

Size: SizeInt;

Module: HMODULE;

end;

TModuleAddrSizeList = class(TList)

public

Counter: Integer;

LastAccessIndex: Integer;

end;

// The main module (EXE) and the module that contains the JclSysInfo unit can be

// cached once for all Begin/EndModuleFromAddrCache blocks.

var

MainModuleAddrSize, InstanceModuleAddrSize: TModuleAddrSize;

threadvar

ModuleAddrSize: TModuleAddrSizeList;

procedure BeginModuleFromAddrCache;

const

ModuleCodeOffset = $1000;

var

List: TModuleAddrSizeList;

MainModule: HMODULE;

P: PModuleAddrSize;

begin

List := ModuleAddrSize;

if List = nil then

begin

List := TModuleAddrSizeList.Create;

List.Counter := 1;

List.LastAccessIndex := -1;

ModuleAddrSize := List;

// Query the module addresses for the main module and JclSysInfo's module and

// add them to the list.

MainModule := 0;

if MainModuleAddrSize.Module = 0 then

begin

MainModule := GetModuleHandle(nil);

CachedModuleFromAddr(Pointer(MainModule + ModuleCodeOffset));

if List.Count = 1 then

begin

// If JclSysInfo is in the main module then we can skip this

if MainModule <> HInstance then

begin

CachedModuleFromAddr(Pointer(HInstance + ModuleCodeOffset));

if List.Count = 2 then

InstanceModuleAddrSize := PModuleAddrSize(List[1])^;

end;

MainModuleAddrSize := PModuleAddrSize(List[0])^;

List.LastAccessIndex := -1;

end;

if (MainModule = 0) and (MainModuleAddrSize.Module <> 0) then

begin

New(P);

P^ := MainModuleAddrSize;

List.Add(P);

if InstanceModuleAddrSize.Module <> 0 then

begin

New(P);

P^ := InstanceModuleAddrSize;

List.Add(P);

end;

end

else

Inc(List.Counter);

end;

procedure EndModuleFromAddrCache;

var

List: TModuleAddrSizeList;

I: Integer;

begin

List := ModuleAddrSize;

if List <> nil then

begin

Dec(List.Counter);

if List.Counter = 0 then

begin

for I := 0 to List.Count - 1 do

Dispose(PModuleAddrSize(List[I]));

List.Free;

ModuleAddrSize := nil;

end;

function CachedModuleFromAddr(const Addr: Pointer): HMODULE;

var

P: PModuleAddrSize;

List: TModuleAddrSizeList;

I, LastAccessIndex: Integer;

MI: TMemoryBasicInformation;

begin

List := ModuleAddrSize;

if List = nil then

begin

Result := ModuleFromAddr(Addr);

Exit;

end;

LastAccessIndex := List.LastAccessIndex;

if LastAccessIndex <> -1 then

begin

P := List[LastAccessIndex];

if (P.BaseAddress <= TJclAddr(Addr)) and

(TJclAddr(Addr) < P.BaseAddress + TJclAddr(P.Size)) then

begin

Result := P.Module;

Exit;

end;

for I := 0 to List.Count - 1 do

begin

P := List[I];

if (P.BaseAddress <= TJclAddr(Addr)) and

(TJclAddr(Addr) < P.BaseAddress + TJclAddr(P.Size)) then

begin

List.LastAccessIndex := I;

Result := P.Module;

Exit;

end;

if (VirtualQuery(Addr, MI, SizeOf(MI)) = SizeOf(MI)) and (MI.State = MEM_COMMIT) then

begin

New(P);

P.Module := HMODULE(MI.AllocationBase);

P.BaseAddress := TJclAddr(MI.BaseAddress);

P.Size := MI.RegionSize;

List.LastAccessIndex := List.Add(P);

Result := HMODULE(MI.AllocationBase);

end

else

Result := 0;

end;

// Reference: http://msdn.microsoft.com/library/periodic/period97/win321197.htm

{ TODO : wrong link }

// Starting with Windows 8.1, the GetVersion(Ex) API is deprecated and will detect the

// application as Windows 8 (kernel version 6.2) until an application manifest is included

// See https://msdn.microsoft.com/en-us/library/windows/desktop/dn302074.aspx

if (Win32MajorVersion = 6) and (Win32MinorVersion = 2) then

Result := strToInt(RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentBuildNumber', intToStr(Win32BuildNumber)))

if ((Win32MajorVersion = 6) and (Win32MinorVersion = 2)) or (Win32MajorVersion = 10) then

Result := StrToInt(RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentBuildNumber', IntToStr(Win32BuildNumber)))

else

Result := Win32BuildNumber;

end;

function GetWindowsMajorVersionNumber: Integer;

var

Ver: string;

begin

// Starting with Windows 8.1, the GetVersion(Ex) API is deprecated and will detect the

// application as Windows 8 (kernel version 6.2) until an application manifest is included

// See https://msdn.microsoft.com/en-us/library/windows/desktop/dn302074.aspx

if (Win32MajorVersion = 6) and (Win32MinorVersion = 2) then

if ((Win32MajorVersion = 6) and (Win32MinorVersion = 2)) or (Win32MajorVersion = 10) then

begin

// CurrentMajorVersionNumber present in registry starting with Windows 10

// If CurrentMajorVersionNumber not present in registry then use CurrentVersion

Result := RegReadIntegerDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentMajorVersionNumber', -1);

if Result = -1 then

Result := strToInt(StrBefore('.', RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentVersion', intToStr(Win32MajorVersion) + '.' + intToStr(Win32MinorVersion))));

begin

Ver := RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentVersion', IntToStr(Win32MajorVersion) + '.' + IntToStr(Win32MinorVersion));

Result := StrToIntDef(Copy(Ver, 1, Pos('.', Ver) - 1), 2); // don't use StrBefore because it uses StrCaseMap that may not be initialized yet

end;

end

else

Result := Win32MajorVersion;

end;

function GetWindowsMinorVersionNumber: Integer;

var

Ver: string;

begin

// Starting with Windows 8.1, the GetVersion(Ex) API is deprecated and will detect the

// application as Windows 8 (kernel version 6.2) until an application manifest is included

// See https://msdn.microsoft.com/en-us/library/windows/desktop/dn302074.aspx

if (Win32MajorVersion = 6) and (Win32MinorVersion = 2) then

if ((Win32MajorVersion = 6) and (Win32MinorVersion = 2)) or (Win32MajorVersion = 10) then

begin

// CurrentMinorVersionNumber present in registry starting with Windows 10

// If CurrentMinorVersionNumber not present then use CurrentVersion

Result := RegReadIntegerDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentMinorVersionNumber', -1);

if Result = -1 then

Result := strToInt(StrAfter('.', RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentVersion', intToStr(Win32MajorVersion) + '.' + intToStr(Win32MinorVersion))));

begin

Ver := RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'CurrentVersion', IntToStr(Win32MajorVersion) + '.' + IntToStr(Win32MinorVersion));

Result := StrToIntDef(Copy(Ver, Pos('.', Ver) + 1, Length(Ver)), 2); // don't use StrAfter because it uses StrCaseMap that may not be initialized yet

end;

end

else

Result := Win32MinorVersion;

function GetWindowsVersionNumber: string;

begin

// Returns version number as MajorVersionNumber.MinorVersionNumber (string type)

Result := intToStr(GetWindowsMajorVersionNumber) + '.' + intToStr(GetWindowsMinorVersionNumber);

Result := Format('%d.%d', [GetWindowsMajorVersionNumber, GetWindowsMinorVersionNumber]);

end;

function GetWindowsServicePackVersion: Integer;

else

Result := '';

end;

function GetWindows10ReleaseId: Integer;

begin

if IsWin10 then

Result := StrToIntDef(RegReadStringDef(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'ReleaseId', '0'), -1)

else

Result := -1;

end;

function GetWindows10ReleaseName: String;

begin

if IsWin10 then

begin

case GetWindows10ReleaseId of

1507:

Result := 'Windows 10';

1511:

Result := 'Windows 10 November Update';

1607:

Result := 'Windows 10 Anniversary Update';

1703:

Result := 'Windows 10 Creators Update';

1709:

Result := 'Windows 10 Fall Creators Update';

1803:

Result := 'Windows 10 April 2018 Update';

else

Result := '';

end;

end

else

Result := '';

end;

function GetWindows10ReleaseCodeName: String;

begin

if IsWin10 then

begin

case GetWindows10ReleaseId of

1507:

Result := 'Threshold 1';

1511:

Result := 'Threshold 2';

1607:

Result := 'Redstone 1';

1703:

Result := 'Redstone 2';

1709:

Result := 'Redstone 3';

1803:

Result := 'Redstone 4';

else

Result := '';

end;

end

else

Result := '';

end;

function GetWindows10ReleaseVersion: String;

var

WindowsReleaseId: Integer;

begin

if IsWin10 then

begin

WindowsReleaseId := GetWindows10ReleaseId;

if WindowsReleaseId > 0 then

Result := 'Windows 10 Version ' + IntToStr(WindowsReleaseId)

else

Result := '';

end

else

Result := '';

end;

// Imports copied from OpenGL unit. Direct using of OpenGL unit might cause unexpected problems due

// setting 8087CW in the intialization section

{

GetSystemInfo(SystemInfo);

end;

var

CachedGetProcessorArchitecture: DWORD = DWORD(-1);

function GetProcessorArchitecture: TProcessorArchitecture;

var

ASystemInfo: TSystemInfo;

begin

if CachedGetProcessorArchitecture = DWORD(-1) then

begin

ASystemInfo.dwOemId := 0;

GetNativeSystemInfo(ASystemInfo);

case ASystemInfo.wProcessorArchitecture of

CachedGetProcessorArchitecture := ASystemInfo.wProcessorArchitecture;

end;

case CachedGetProcessorArchitecture of

PROCESSOR_ARCHITECTURE_INTEL:

Result := pax8632;

PROCESSOR_ARCHITECTURE_IA64:

end;

function IsWindows64: Boolean;

var

ASystemInfo: TSystemInfo;

begin

ASystemInfo.dwOemId := 0;

GetNativeSystemInfo(ASystemInfo);

Result := ASystemInfo.wProcessorArchitecture in [PROCESSOR_ARCHITECTURE_IA64,PROCESSOR_ARCHITECTURE_AMD64];

Result := GetProcessorArchitecture in [paIA64, pax8664];

end;

function JclCheckWinVersion(Major, Minor: Integer): Boolean;

jedi.inc

/include/jedi/jedi.inc

View

crossplatform.inc

/include/crossplatform.inc

View

jcl.inc

/include/jcl.inc

View

jcld25win32.inc

/include/jcld25win32.inc

View

jcld25win64.inc

/include/jcld25win64.inc

View

unixonly.inc

/include/unixonly.inc

View

windowsonly.inc

/include/windowsonly.inc

View

JclDebug.pas

/windows/JclDebug.pas

View

JclPeImage.pas

/windows/JclPeImage.pas

View

JclTD32.pas

/windows/JclTD32.pas

View



	common
	JclMime.pas
	JclResources.pas
	JclSysInfo.pas
	include
	jedi
	jedi.inc
	crossplatform.inc
	jcl.inc
	jcld25win32.inc +
	jcld25win64.inc +
	unixonly.inc
	windowsonly.inc
	windows
	JclDebug.pas
	JclPeImage.pas
	JclTD32.pas