$theTitle=wp_title(" - ", false); if($theTitle != "") { ?>
About Virtualization, VDI, SBC, Application Compatibility and anything else I feel like
2 May // php the_time('Y') ?>
Justin Shepard converted my code to encrypt RPD passwords to VB.NET:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | '======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 & 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}" & Chr(13) & 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 |
1 May // php the_time('Y') ?>
Recently I needed to convert a C header file to Delphi which contained bitfields. Let’s take a look at a sample structure that contains bitfields:
1 2 3 4 5 6 7 | typedef struct _BITFIELDSTRUCTURE { DWORD dwValue1; ULONG BitValue1: 1; ULONG BitValue2: 1; ULONG BitValue3: 1; ULONG BitValue4: 1; } BITFIELDSTRUCTURE, * BITFIELDSTRUCTURE; |
It means that there is a DWORD (Cardinal) dwValue1 followed by a bitfield with the size of a ULONG (32 bits). In this bitfield 4 values are defined (BitValue1..4) which are used as boolean’s because the value can offcourse be 0 or 1. Since Delphi doesn’t know a bitfield type the question is how to translate it. Usually it would mean that we simply treat the whole bitfield value as a ULONG and extract the required properties by applying a bitmask (shl/shr). Starting from BDS2006 we can define a record with propertes and use getters and setters. Using this technique we can present boolean values to the user:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | 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; |
Code completion shows that the record has one DWORD Value and 4 Boolean Values which is just what we want!
Offcourse we need to implement the Getters and Setters:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | 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; |
We can even add a constructor to it, this can be used to e.g. initialize the record (in the example below we fill with zeroes). Note that only a constructor with at least one argument can be used:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | ... 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); |
So why not use a class instead of record? The answer is that a class is just a pointer we can never pass this to a function, procedure or api call that expects a record. But if we want to support older Delphi versions, like Delphi 6 or Delphi 7 and even Delphi 2005, which are still used a lot we need to find another solution. I came up with (ab)using sets to emulate bitfields, we can do this because a set is actually a set of bits (limited to 256 bits). The example structure could look like this if we use sets:
1 2 3 4 5 6 7 8 | _BITFIELDSTRUCT = record dwValue1: DWORD; BitField: Set Of ( BitValue1, BitValue2, BitValue3, BitValue4 ); end; TBitFieldStruct = _BITFIELDSTRUCT; PBitFieldStruct = ^_BITFIELDSTRUCT; |
We can use normal set operations to get and set bitvalues:
1 2 3 4 5 6 7 8 9 | 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; |
Settings like minimal enum size and record alignment are important because we need to asssure that te record size matches the C structure’s size (especially when using structures with a lot of bitfields. I choose to do this with a litte trick, first I declare some constants:
1 2 3 4 5 6 7 8 9 | const al32Bit=31; al64bit=63; al96bit=95; al128bit=127; al160bit=159; al192bit=191; al224bit=221; al256bit=255; |
We use these constants to force the correct size, in the example the bitfield was a ULONG which is 32 bits. We add the al32Bit constant to the bitfield:
1 2 3 4 5 6 7 8 | _BITFIELDSTRUCT = record dwValue1: DWORD; BitField: Set Of ( BitValue1, BitValue2, BitValue3, BitValue4, al32Bit ); end; TBitFieldStruct = _BITFIELDSTRUCT; PBitFieldStruct = ^_BITFIELDSTRUCT; |
So I thought I had it figured out… until I came to this line in the C header file:
1 2 3 | ULONG SomeValue : 1; ULONG OtherValue : 1; ULONG ColorDepth : 3; |
So we have a bitfield consisting off multiple bits! This gave me some headaches but I finally came up with the following approach
1 2 3 | BitField: Set Of ( SomeValue, OtherValue, ColorDepth1, ColorDepth2, ColorDepth3, al32Bit ); |
We need a helper function to retreive the numeric value of ColorDepth:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | 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; |
The helper function is used like this:
1 2 3 | Struct.BitFields := [OtherValue, ColorDepth1, ColorDepth3]; WriteLn(Format('Value=%d', [ValueFromBitSet(Struct.BitFields, Integer(ColorDepth1), 3)])); end. |
Some limitations remain, although I don’t think you are likely to encouter these: