‘======SOF
 
Imports System
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports Microsoft.VisualBasic
 
Public Module RdpEncrypt
 
    Public Class DPAPI
<dllimport> _
        Private Shared Function CryptProtectData( _
            ByRef pPlainText As DATA_BLOB, _
            ByVal szDescription As String, _
            ByRef pEntropy As DATA_BLOB, _
            ByVal pReserved As IntPtr, _
            ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Integer, _
            ByRef pCipherText As DATA_BLOB _
        ) As Boolean
        End Function
 
<dllimport> _
        Private Shared Function CryptUnprotectData( _
            ByRef pCipherText As DATA_BLOB, _
            ByRef pszDescription As String, _
            ByRef pEntropy As DATA_BLOB, _
            ByVal pReserved As IntPtr, _
            ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT, _
            ByVal dwFlags As Integer, _
            ByRef pPlainText As DATA_BLOB _
        ) As Boolean
        End Function
 
<structlayout> _
        Friend Structure DATA_BLOB
            Public cbData As Integer
            Public pbData As IntPtr
        End Structure
 
<structlayout> _
        Friend Structure CRYPTPROTECT_PROMPTSTRUCT
            Public cbSize As Integer
            Public dwPromptFlags As Integer
            Public hwndApp As IntPtr
            Public szPrompt As String
        End Structure
 
        Private Const CRYPTPROTECT_UI_FORBIDDEN As Integer = 1
        Private Const CRYPTPROTECT_LOCAL_MACHINE As Integer = 4
 
        Private Shared Sub InitPrompt _
        ( _
            ByRef ps As CRYPTPROTECT_PROMPTSTRUCT _
        )
            ps.cbSize = Marshal.SizeOf(GetType(CRYPTPROTECT_PROMPTSTRUCT))
            ps.dwPromptFlags = 0
            ps.hwndApp = IntPtr.Zero
            ps.szPrompt = Nothing
        End Sub
 
        Private Shared Sub InitBLOB _
        ( _
            ByVal data As Byte(), _
            ByRef blob As DATA_BLOB _
        )
            ‘ Use empty array for null parameter.
            If data Is Nothing Then
                data = New Byte(0) {}
            End If
 
            ‘ Allocate memory for the BLOB data.
            blob.pbData = Marshal.AllocHGlobal(data.Length)
 
            ‘ Make sure that memory allocation was successful.
            If blob.pbData.Equals(IntPtr.Zero) Then
                Throw New Exception( _
                        "Unable to allocate data buffer for BLOB structure.")
            End If
 
            ‘ Specify number of bytes in the BLOB.
            blob.cbData = data.Length
            Marshal.Copy(data, 0, blob.pbData, data.Length)
        End Sub
 
        Public Enum KeyType
            UserKey = 1
            MachineKey
        End Enum
 
        Private Shared defaultKeyType As KeyType = KeyType.UserKey
 
        Public Shared Function Encrypt _
        ( _
            ByVal keyType As KeyType, _
            ByVal plainText As String, _
            ByVal entropy As String, _
            ByVal description As String _
        ) As String
            If plainText Is Nothing Then
                plainText = String.Empty
            End If
            If entropy Is Nothing Then
                entropy = String.Empty
            End If
 
            Dim result As Byte()
            Dim encrypted As String = ""
            Dim i As Integer
            result = Encrypt(keyType, _
                             Encoding.Unicode.GetBytes(plainText), _
                             Encoding.Unicode.GetBytes(entropy), _
                             description)
            For i = 0 To result.Length – 1
                encrypted = encrypted &amp; Convert.ToString(result(i), 16).PadLeft(2, "0").ToUpper()
            Next
            Return encrypted.ToString()
        End Function
 
        Public Shared Function Encrypt _
        ( _
            ByVal keyType As KeyType, _
            ByVal plainTextBytes As Byte(), _
            ByVal entropyBytes As Byte(), _
            ByVal description As String _
        ) As Byte()
            If plainTextBytes Is Nothing Then
                plainTextBytes = New Byte(0) {}
            End If
 
            If entropyBytes Is Nothing Then
                entropyBytes = New Byte(0) {}
            End If
 
            If description Is Nothing Then
                description = String.Empty
            End If
 
            Dim plainTextBlob As DATA_BLOB = New DATA_BLOB
            Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB
            Dim entropyBlob As DATA_BLOB = New DATA_BLOB
 
            Dim prompt As  _
                    CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT
            InitPrompt(prompt)
 
            Try
                Try
                    InitBLOB(plainTextBytes, plainTextBlob)
                Catch ex As Exception
                    Throw New Exception("Cannot initialize plaintext BLOB.", ex)
                End Try
 
                Try
                    InitBLOB(entropyBytes, entropyBlob)
                Catch ex As Exception
                    Throw New Exception("Cannot initialize entropy BLOB.", ex)
                End Try
 
                Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN
 
                If keyType = keyType.MachineKey Then
                    flags = flags Or (CRYPTPROTECT_LOCAL_MACHINE)
                End If
 
                Dim success As Boolean = CryptProtectData( _
                                                plainTextBlob, _
                                                description, _
                                                entropyBlob, _
                                                IntPtr.Zero, _
                                                prompt, _
                                                flags, _
                                                cipherTextBlob)
 
                If Not success Then
                    Dim errCode As Integer = Marshal.GetLastWin32Error()
 
                    Throw New Exception("CryptProtectData failed.", _
                                    New Win32Exception(errCode))
                End If
 
                Dim cipherTextBytes(cipherTextBlob.cbData) As Byte
 
                Marshal.Copy(cipherTextBlob.pbData, cipherTextBytes, 0, _
                                cipherTextBlob.cbData)
 
                Return cipherTextBytes
            Catch ex As Exception
                Throw New Exception("DPAPI was unable to encrypt data.", ex)
            Finally
                If Not (plainTextBlob.pbData.Equals(IntPtr.Zero)) Then
                    Marshal.FreeHGlobal(plainTextBlob.pbData)
                End If
 
                If Not (cipherTextBlob.pbData.Equals(IntPtr.Zero)) Then
                    Marshal.FreeHGlobal(cipherTextBlob.pbData)
                End If
 
                If Not (entropyBlob.pbData.Equals(IntPtr.Zero)) Then
                    Marshal.FreeHGlobal(entropyBlob.pbData)
                End If
            End Try
        End Function
 
    End Class
 
    Sub Main(ByVal args As String())
        Try
            Dim text As String = args(0)
            Dim encrypted As String
 
            encrypted = DPAPI.Encrypt(DPAPI.KeyType.MachineKey, text, Nothing, "psw")
 
            Console.WriteLine("{0}" &amp; Chr(13) &amp; Chr(10), encrypted)
 
        Catch ex As Exception
            While Not (ex Is Nothing)
                Console.WriteLine(ex.Message)
                ex = ex.InnerException
            End While
        End Try
    End Sub
 
End Module
‘======EOF
 

typedef struct _BITFIELDSTRUCTURE {
    DWORD dwValue1;
    ULONG BitValue1: 1;
    ULONG BitValue2: 1;
    ULONG BitValue3: 1;
    ULONG BitValue4: 1;
} BITFIELDSTRUCTURE, * BITFIELDSTRUCTURE;

type
  _BITFIELDSTRUCTURE = record
  dwValue1: DWORD;
  strict private
    BitField: DWORD;
    function GetBitValue1: Boolean;
    function GetBitValue2: Boolean;
    function GetBitValue3: Boolean;
    function GetBitValue4: Boolean;
    procedure SetBitValue1(const Value: Boolean);
    procedure SetBitValue2(const Value: Boolean);
    procedure SetBitValue3(const Value: Boolean);
    procedure SetBitValue4(const Value: Boolean);
  public
    property BitValue1: Boolean read GetBitValue1 write SetBitValue1;
    property BitValue2: Boolean read GetBitValue2 write SetBitValue2;
    property BitValue3: Boolean read GetBitValue3 write SetBitValue3;
    property BitValue4: Boolean read GetBitValue4 write SetBitValue4;
  end;
  TBitFieldStructure = _BITFIELDSTRUCTURE;
  PBitFieldStructure = ^_BITFIELDSTRUCTURE;

function _BITFIELDSTRUCTURE.GetBitValue1;
begin
  Result := BitField and 1 = 1;
end;

function _BITFIELDSTRUCTURE.GetBitValue2;
begin
  Result := BitField and 2 = 2;
end;

function _BITFIELDSTRUCTURE.GetBitValue3;
begin
  Result := BitField and 4 = 4;
end;

function _BITFIELDSTRUCTURE.GetBitValue4;
begin
  Result := BitField and 8 = 8;
end;

procedure _BITFIELDSTRUCTURE.SetBitValue1(const Value: Boolean);
begin
  if Value then BitField := BitField or 1 else BitField := BitField and (not 1);
end;

procedure _BITFIELDSTRUCTURE.SetBitValue2(const Value: Boolean);
begin
  if Value then BitField := BitField or 2 else BitField := BitField and (not 2);
end;

procedure _BITFIELDSTRUCTURE.SetBitValue3(const Value: Boolean);
begin
  if Value then BitField := BitField or 4 else BitField := BitField and (not 4);
end;

procedure _BITFIELDSTRUCTURE.SetBitValue4(const Value: Boolean);
begin
  if Value then BitField := BitField or 8 else BitField := BitField and (not 8);
end;

…
  public
    constructor Create(const dummy: word);
    …

implementation

constructor _BITFIELDSTRUCTURE.Create;  // Did you know that Delphi permits leaving out (const dummy: word) here?
begin
  ZeroMemory(@Self, SizeOf(Self));
end;

…

procedure TForm1.Button1Click(Sender: TObject);
var
  BitFieldStructure: TBitFieldStructure;
begin
  BitFieldStructure := TBitFieldStructure.Create(0);

  _BITFIELDSTRUCT = record
  dwValue1: DWORD;
  BitField: Set Of (
    BitValue1, BitValue2, BitValue3, BitValue4
  );
  end;
  TBitFieldStruct = _BITFIELDSTRUCT;
  PBitFieldStruct = ^_BITFIELDSTRUCT;

procedure TForm1.Button2Click(Sender: TObject);
var
  bValue: Boolean;
  BitFieldStruct: TBitFieldStruct;
begin
  bValue := BitValue2 in BitFieldStruct.BitField;
  BitFieldStruct.BitField := [BitValue1, BitValue3];
  BitFieldStruct.BitField := BitFieldStruct.BitField – [BitValue3];
end;

const
  al32Bit=31;
  al64bit=63;
  al96bit=95;
  al128bit=127;
  al160bit=159;
  al192bit=191;
  al224bit=221;
  al256bit=255;

  _BITFIELDSTRUCT = record
  dwValue1: DWORD;
  BitField: Set Of (
    BitValue1, BitValue2, BitValue3, BitValue4, al32Bit
  );
  end;
  TBitFieldStruct = _BITFIELDSTRUCT;
  PBitFieldStruct = ^_BITFIELDSTRUCT;

ULONG   SomeValue  : 1;
ULONG   OtherValue : 1;
ULONG   ColorDepth : 3;

  BitField: Set Of (
    SomeValue, OtherValue, ColorDepth1, ColorDepth2, ColorDepth3, al32Bit
  );

function ValueFromBitSet(var ABitSet; const StartBit: Byte;
  const Count: Byte): Int64;
var
  MaxBitSet: TMaxBitSet;
  i, BitValue: Integer;
begin
  // The result can contain max. 64 bit value, Raise if Count > 64
  if Count > 64 then Raise EIntOverflow.Create(‘Count cannot exceed 64′);

  // A Delphi Set contains at most 256 bits. So we raise Exception is we exceed
  if StartBit + Count > 255 then Raise
    EIntOverflow.Create(‘Startbit + Count cannot exceed maximum set size (255)’);

  Result := 0;
  BitValue := 1;

  // A Delphi Set Of can hold a maximum of 256 bits, since we do not know
  // which size was passed to us we cast to 256 bits.
  MaxBitSet := TMaxBitSet(ABitSet);
  // Loop through the requested bits from end to start (Little Endian)
  for i := StartBit+Count-1 downto StartBit do
  begin

    // is the bit set?
    if i in MaxBitSet then
    begin
      // Multiply with BitValue and add to result
      Result := Result + BitValue;
    end;

    // Multiply BitValue by 2
    BitValue := BitValue shl 1;
  end;
end;

Struct.BitFields := [OtherValue, ColorDepth1, ColorDepth3];
WriteLn(Format(‘Value=%d’, [ValueFromBitSet(Struct.BitFields, Integer(ColorDepth1), 3)]));
end.