Jump to content
maXcomX

How to translate PSAPI_WORKING_SET_BLOCK?

By maXcomX, in Windows API

Recommended Posts

maXcomX    3

maXcomX
Posted (edited)

Hello,

 

I'm trying to translate PSAPI_WORKING_SET_BLOCK (psapi.h) structure to Delphi. 

 

Now I'm struggling with as far as I become this far:

  

type

  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: NativeUInt): NativeUInt;
    procedure SetBits(const aIndex: NativeUInt;
                      const aValue: NativeUInt);

  public
    property Protection: NativeUInt  index $0005 read GetBits write SetBits;    //  5 bits at offset 0
    property ShareCount: NativeUInt  index $0503 read GetBits write SetBits;    //  3 bits at offset 5
    property Shared: NativeUInt      index $0801 read GetBits write SetBits;    //  1 bit at offset 8
    property Reserved: NativeUInt    index $0903 read GetBits write SetBits;    //  3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: NativeUInt index $1253 read GetBits write SetBits;    //  52 bits at offset 12
    {$ELSE}
    property VirtualPage: NativeUInt index $1220 read GetBits write SetBits;    //  20 bits at offset 9
    {$ENDIF}
  end;



  PSAPI_WORKING_SET_BLOCK = record
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
    end;
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;

The issue is that index is a integerConstant clause, so NativeUint will not work in this situation.

 

 

How do I tackle this?

 

Like this? 

type



  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: Integer): NativeUInt;
    procedure SetBits(const aIndex: Integer; const aValue: NativeUInt);

  public
    property Protection: NativeUInt index 5 read GetBits write SetBits;    //  5 bits at offset 0
    property ShareCount: NativeUInt index 503 read GetBits write SetBits;  //  3 bits at offset 5
    property Shared: NativeUInt index 801 read GetBits write SetBits;      //  1 bit at offset 8
    property Reserved: NativeUInt index 903 read GetBits write SetBits;    //  3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: NativeUInt index 1253 read GetBits write SetBits; //  52 bits at offset 12
    {$ELSE}
    property VirtualPage: NativeUInt index 1220 read GetBits write SetBits; //  20 bits at offset 9
    {$ENDIF}
  end;

  PSAPI_WORKING_SET_BLOCK = record
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
  end;
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;

And cast the GetBits and SetBits methods, aIndex parameter from Integer to NativeUInt when accessing the appropriate bits in the Flags field?

Edited by maXcomX
Added specific information

Share this post

Link to post

Remy Lebeau    1393

Remy Lebeau
Posted (edited)
2 hours ago, maXcomX said:

The issue is that index is a integerConstant clause, so NativeUint will not work in this situation.

You don't need to pass in NativeUInt indexes to begin with.  You are passing in 2 very small values (offset and bit count) which you can bit-stuff into a plain Integer just fine (and pay attention that you are using hex values correctly!), eg: 

type
  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: Integer): ULONG_PTR;
    procedure SetBits(const aIndex: Integer; const aValue: ULONG_PTR);

  public
    property Protection: ULONG_PTR  index $0005 read GetBits write SetBits;    //  5 bits at offset 0
    property ShareCount: ULONG_PTR  index $0503 read GetBits write SetBits;    //  3 bits at offset 5
    property Shared: ULONG_PTR      index $0801 read GetBits write SetBits;    //  1 bit at offset 8
    property Reserved: ULONG_PTR    index $0903 read GetBits write SetBits;    //  3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: ULONG_PTR index $0C34 read GetBits write SetBits;    //  52 bits at offset 12
    {$ELSE}
    property VirtualPage: ULONG_PTR index $0C14 read GetBits write SetBits;    //  20 bits at offset 12
    {$ENDIF}
  end;

function MakeMask(NumBits: UInt8): ULONG_PTR;
var
  I: UInt8;
begin
  Result := 0;
  for I := 1 to NumBits do begin
    Result := (Result shl 1) or 1;
  end;
end;

// depending on C compiler implementation, you might need to
// reverse the math on these bit shifts, as bitfield ordering
// is not standardized!

function STRUCT_PSAPI_WORKING_SET_BLOCK.GetBits(const aIndex: Integer): ULONG_PTR;
var
  Offset: NumBits: UInt8;
  Mask: ULONG_PTR;
begin
  Offset := UInt8(aIndex shr 8);
  NumBits = UInt8(aIndex);
  Mask := MakeMask(NumBits);
  Result := (Flags shr Offset) and Mask;
end;

procedure STRUCT_PSAPI_WORKING_SET_BLOCK.SetBits(const aIndex: Integer; const aValue: ULONG_PTR);
var
  Offset: NumBits: UInt8;
  Mask: ULONG_PTR;
begin
  Offset := UInt8(aIndex shr 8);
  NumBits = UInt8(aIndex);
  Mask := MakeMask(NumBits);
  Flags := Flags and not (Mask shl Offset);
  Flags := Flags or ((aValue and Mask) shl Offset);
end;

That being said, I would have translated each bitfield into its own getter/setter instead, to more closely mimic how bitfields actually work in C, and to pass around more appropriate data types, eg: 

type
  VirtualPageValueType = {$IFDEF WIN64}UInt64{$ELSE}UInt32{$ENDIF};

  _PSAPI_WORKING_SET_BLOCK_STRUCT = record
  private
    Flags: ULONG_PTR;

    function GetProtection: UInt8;
    function GetShareCount: UInt8;
    function GetShared: Boolean;
    function GetReserved: UInt8;
    function GetVirtualPage: VirtualPageValueType;

    procedure SetProtection(const AValue: UInt8);
    procedure SetShareCount(const AValue: UInt8);
    procedure SetShared(const AValue: Boolean);
    procedure SetReserved(const AValue: UInt8);
    procedure SetVirtualPage(const AValue: VirtualPageValueType);

  public    
    property Protection: UInt8 read GetProtection write SetProtection;
    property ShareCount: UInt8 read GetShareCount write SetShareCount;
    property Shared: Boolean read GetShared write SetShared;
    property Reserved: UInt8 read GetReserved write SetReserved;
    property VirtualPage: VirtualPageValueType read GetVirtualPage write SetVirtualPage;
  end;

  _PSAPI_WORKING_SET_BLOCK = record
    case Integer of
      0: (Flags: ULONG_PTR);
      1: (Struct: _PSAPI_WORKING_SET_BLOCK_STRUCT);
  end;

  PSAPI_WORKING_SET_BLOCK = _PSAPI_WORKING_SET_BLOCK;
  PPSAPI_WORKING_SET_BLOCK = ^STRUCT_PSAPI_WORKING_SET_BLOCK;
  
  ...

// Notes:
//
// hex            | binary
// ---------------------------
// $01            | %0000_0001
// $07            | %0000_0111
// $1F            | %0001_1111
// $FFFFF         | %1111_1111_1111_1111_1111
// $FFFFFFFFFFFFF | %1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111
//
// depending on C compiler implementation, you might need to
// reverse the math on these bit shifts, as bitfield ordering
// is not standardized!

function _PSAPI_WORKING_SET_BLOCK_STRUCT.GetProtection: UInt8;
begin
  Result := UInt8(Flags and $1F);
end;

function _PSAPI_WORKING_SET_BLOCK_STRUCT.GetShareCount: UInt8;
begin
  Result := UInt8((Flags shr 5) and $07);
end;

function _PSAPI_WORKING_SET_BLOCK_STRUCT.GetShared: Boolean;
begin
  Result := ((Flags shr 8) and $01) <> 0;
end;

function _PSAPI_WORKING_SET_BLOCK_STRUCT.GetReserved: UInt8;
begin
  Result := UInt8((Flags shr 9) and $07);
end;

function _PSAPI_WORKING_SET_BLOCK_STRUCT.GetVirtualPage: VirtualPageValueType;
const
  cMask: ULONG_PTR = {$IFDEF WIN64}$FFFFFFFFFFFFF{$ELSE}$FFFFF{$ENDIF};
begin
  Result := VirtualPageValueType((Flags shr 12) and cMask);
end;

procedure _PSAPI_WORKING_SET_BLOCK_STRUCT.SetProtection(const AValue: UInt8);
begin
  Flags := Flags and not $1F;
  Flags := Flags or (ULONG_PTR(aValue) and $1F);
end;

procedure _PSAPI_WORKING_SET_BLOCK_STRUCT.SetShareCount(const AValue: UInt8);
begin
  Flags := Flags and not ($07 shl 5);
  Flags := Flags or ((ULONG_PTR(aValue) and $07) shl 5);
end;

procedure _PSAPI_WORKING_SET_BLOCK_STRUCT.SetShared(const AValue: Boolean);
begin
  if AValue then
    Flags := Flags or (ULONG_PTR(1) shl 8)
  else
    Flags := Flags and not ($1 shl 8);
end;

procedure _PSAPI_WORKING_SET_BLOCK_STRUCT.SetReserved(const AValue: UInt8);
begin
  Flags := Flags and not ($07 shl 9);
  Flags := Flags or ((ULONG_PTR(aValue) and $07) shl 9);
end;

procedure _PSAPI_WORKING_SET_BLOCK_STRUCT.SetVitualPage(const AValue: VirtualPageValueType);
const
  cMask: ULONG_PTR = {$IFDEF WIN64}$FFFFFFFFFFFFF{$ELSE}$FFFFF{$ENDIF};
begin
  Flags := Flags and not (cMask shl 12);
  Flags := Flags or ((ULONG_PTR(aValue) and cMask) shl 12);
end;

 

Edited by Remy Lebeau

Share this post

Link to post

maXcomX    3

maXcomX
Posted

Sorry a bit late response.

Delphi has a unit called psapi.pas, but it's incomplete , for some reason this record is not translated (since Delphi XE7, or earlier, the first translation of this header I found was from  Borland).

 

I did indeed made a mistake.

 

So I translated it  like this: 

  STRUCT_PSAPI_WORKING_SET_BLOCK = record
  private
    Flags: ULONG_PTR;
    function GetBits(const aIndex: Integer): ULONG_PTR;
    procedure SetBits(const aIndex: Integer;
                      const aValue: ULONG_PTR);

  public
    property Protection: ULONG_PTR  index $0005 read GetBits write SetBits;    // 5 bits at offset 0
    property ShareCount: ULONG_PTR  index $0503 read GetBits write SetBits;    // 3 bits at offset 5
    property Shared: ULONG_PTR      index $0801 read GetBits write SetBits;    // 1 bit at offset 8
    property Reserved: ULONG_PTR    index $0903 read GetBits write SetBits;    // 3 bits at offset 9
    {$IFDEF WIN64}
    property VirtualPage: ULONG_PTR index $1253 read GetBits write SetBits;    // 52 bits at offset 12
    {$ELSE}
    property VirtualPage: ULONG_PTR index $1220 read GetBits write SetBits;    // 20 bits at offset 9
    {$ENDIF}
  end;

  PSAPI_WORKING_SET_BLOCK = record
  public
    case Integer of
      0: ( struct: STRUCT_PSAPI_WORKING_SET_BLOCK );
    end;
  {$EXTERNALSYM PSAPI_WORKING_SET_BLOCK}
  PPSAPI_WORKING_SET_BLOCK = ^PSAPI_WORKING_SET_BLOCK;
  {$EXTERNALSYM PPSAPI_WORKING_SET_BLOCK}


// PSAPI_WORKING_SET_BLOCK /////////////////////////////////////////////////////
function STRUCT_PSAPI_WORKING_SET_BLOCK.GetBits(const aIndex: Integer): ULONG_PTR;
begin
  Result := GetUBits(Flags,
                     aIndex);
end;

procedure STRUCT_PSAPI_WORKING_SET_BLOCK.SetBits(const aIndex: Integer;
                                                 const aValue: ULONG_PTR);
begin
  SetUBits(Flags,
           aIndex,
           aValue);
end;
// /////////////////////////////////////////////////////////////////////////////

// global unit helpers

// Record helpers //////////////////////////////////////////////////////////////

function GetUBits(const Bits: ULONG_PTR;
                  const aIndex: Integer): ULONG_PTR;
begin
  Result := (Bits shr (aIndex shr 8)) and  // offset
             ((1 shl Byte(aIndex)) - 1);   // mask
end;

procedure SetUBits(var Bits: ULONG_PTR;
                   const aIndex: Integer;
                   const aValue: ULONG_PTR);
var
  Offset: Byte;
  Mask: Integer;

begin
  Mask := ((1 shl Byte(aIndex)) - 1);
  Assert(Integer(aValue) <= Mask);

  Offset := aIndex shr 8;
  Bits := (Bits and (not (Mask shl Offset)))
          or DWORD(aValue shl Offset);
end;

 In the middle of discussing this issue with Rudy Veldhuis, he passed away  😞 But he pointed out in his blog which is still online, a similar solution.

Henri Gourvest (from DSPack) opinion is to skip structs containing C/C++ bitshifting, because it's rarely used and what you commented that bitfield ordering is not standardized.

So good reasons why Embarcadero still did not include this in psapi.pas?

 

Thanks in advance, Tony.

 

 

 

 

 

 

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Go To Topic Listing Windows API
×