paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 18:06:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* commit 64-bit type support to fcl-register, patch by CCRDude, mantis #34875

Browse Source 
git-svn-id: trunk@41267 -
This commit is contained in:
marco 2019-02-09 13:57:19 +00:00
parent 46aa5f2712
commit 8b956a580e
2 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-registry/src/registry.pp
View File

@ -32,7 +32,7 @@ type
end; end;
TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian, TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian,
rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor, rdResourceRequirementList); rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor, rdResourceRequirementList, rdInt64);
TRegDataInfo = record TRegDataInfo = record
RegData: TRegDataType; RegData: TRegDataType;
@ -95,6 +95,7 @@ type
function ReadDateTime(const Name: string): TDateTime; function ReadDateTime(const Name: string): TDateTime;
function ReadFloat(const Name: string): Double; function ReadFloat(const Name: string): Double;
function ReadInteger(const Name: string): Integer; function ReadInteger(const Name: string): Integer;
function ReadInt64(const Name: string): Int64;
function ReadString(const Name: string): string; function ReadString(const Name: string): string;
procedure ReadStringList(const Name: string; AList: TStrings); procedure ReadStringList(const Name: string; AList: TStrings);
function ReadTime(const Name: string): TDateTime; function ReadTime(const Name: string): TDateTime;
@ -118,6 +119,7 @@ type
procedure WriteDateTime(const Name: string; Value: TDateTime); procedure WriteDateTime(const Name: string; Value: TDateTime);
procedure WriteFloat(const Name: string; Value: Double); procedure WriteFloat(const Name: string; Value: Double);
procedure WriteInteger(const Name: string; Value: Integer); procedure WriteInteger(const Name: string; Value: Integer);
procedure WriteInt64(const Name: string; Value: Int64);
procedure WriteString(const Name, Value: string); procedure WriteString(const Name, Value: string);
procedure WriteExpandString(const Name, Value: string); procedure WriteExpandString(const Name, Value: string);
procedure WriteStringList(const Name: string; List: TStrings); procedure WriteStringList(const Name: string; List: TStrings);
@ -346,6 +348,17 @@ begin
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]); Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end; end;
function TRegistry.ReadInt64(const Name: string): Int64;
Var
RegDataType: TRegDataType;
begin
GetData(Name, @Result, SizeOf(Int64), RegDataType);
If RegDataType<>rdInt64 Then
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;
function TRegistry.ReadBool(const Name: string): Boolean; function TRegistry.ReadBool(const Name: string): Boolean;
begin begin
@ -515,6 +528,11 @@ begin
PutData(Name, @Value, SizeOf(Integer), rdInteger); PutData(Name, @Value, SizeOf(Integer), rdInteger);
end; end;
procedure TRegistry.WriteInt64(const Name: string; Value: Int64);
begin
PutData(Name, @Value, SizeOf(Int64), rdInt64);
end;
procedure TRegistry.WriteString(const Name, Value: string); procedure TRegistry.WriteString(const Name, Value: string);
var var
u: UnicodeString; u: UnicodeString;

2
packages/fcl-registry/src/winreg.inc
View File

@ -1,7 +1,7 @@
Const Const
RegDataWords : Array [TRegDataType] of DWORD RegDataWords : Array [TRegDataType] of DWORD
= (REG_NONE,REG_SZ,REG_EXPAND_SZ,REG_BINARY,REG_DWORD,REG_DWORD_BIG_ENDIAN, = (REG_NONE,REG_SZ,REG_EXPAND_SZ,REG_BINARY,REG_DWORD,REG_DWORD_BIG_ENDIAN,
REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST); REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST,REG_QWORD);
type type
TWinRegData = record TWinRegData = record