5,793 views

Unattended Citrix Installation: Could not Access the datastore using the DSN file

23 Jun

I was working on an unattended installation of Citrix Presentation Server 4.5 or rather Citrix Xenapp. I was creating the dsn file for the installation by a script that uses the echo command and output this to a file.

This is a part of the script:

rem Create ODBC file
rem ———————————————————————–
echo [ODBC] > %ODBC%
echo DRIVER=SQL SERVER >> %ODBC%
echo UID=%SQL_SA% >> %ODBC%
echo Address=%SQL_SERVER%,1433 >> %ODBC%
echo Network=DBMSSOCN >> %ODBC%
echo LANGUAGE=us_english >> %ODBC%
echo DATABASE=%CTX_DATASTORENAME% >> %ODBC%
rem echo WSID=%COMPUTERNAME% >> %ODBC%
echo APP=Citrix IMA >> %ODBC%
echo SERVER=%SQL_SERVER% >> %ODBC%
echo Description=Citrix Datastore >> %ODBC%
echo. >> %ODBC%

Even though the generated DSN file looks ok the installation fails. If you look in the installation log you can see this error: Error 26009. Could not Access the datastore using the DSN file.

I then created a dsn file through the ODBC Data Source Administrator and then the installation went ok. I compared the DSN file with the one my script generated and it was the same.

A search with Google and in the Citrix forums leads to numerous posts with the same error but none with a real solution. Some suggestions are that you need to remove the WSID line or even the order of the entries in the DSN file. But none of these suggestions work.

So I compared the two files again and I noticed that the filesize of my generated DSN was slightly bigger. So let’s look again at the script:

echo DRIVER=SQL SERVER >> %ODBC%

See the space right before the >>? This means that after each line in the dsn file there’s a space too. If you open the file with a Hex Viewer you can easily see the spaces (ASCII value 20):

hexdump

So the solution is to change this (for all lines) to:

echo DRIVER=SQL SERVER>> %ODBC%

After that it works perfectly!

4 Comments

Filed under: Citrix, script

4,307 views

Resuming Microsoft’s (Akami) Download Manager

Author: Remko Weijnen

22 Jun

If you ever download software from Microsoft’s Volume Licensing Site you have probably seen that it uses the Akamai download manager. Sometimes your downloads get interrupted but how to restart the downloadmanager? There’s no entry in the startmenu and not even an icon on the desktop.

You can restart the downloadmanager though by creating a shortcut to “C:\Windows\DOWNLO~1\CONFLICT.1\Manager.exe”. Please notice the short directory name (~1).

1 Comment

Filed under: General

3,885 views

Configuring IBM Raid controller with Altiris

Author: Remko Weijnen

17 Jun

Today I was deploying some IBM x3550 and x3650 servers with Altiris Deployment Server. IBM Delivers a toolkit for Altiris that contains amongst others jobs for configuring raid arrays.

To do this you need to create a raid policy file and deploy this. I created this policy file:

[Policy.RAID-1]
AppliesTo.1 = t:ServeRAID-8k-l,d:4
Array_Mode = CUSTOM
Array.A = 1,2
Array.B = 3,4
Logical_Mode = CUSTOM
Logical.1 = A:FILL:1
Logical.2 = B:FILL:1

As you can see the policy only applies to the type of array controller in my servers (t:ServeRAID-8k-l). This way we prevent applying the policy to other configurarions. I have a 4 disk configuration (d:4) and want to create to RAID 1 arrays (A & B). On each array one Logical drive with the maximum size (FILL parameter).

Read the rest of this entry »

0 Comments

Filed under: Uncategorized

25,710 views

Multiple Concurrent Terminal Server Sessions On Vista SP1

Author: Remko Weijnen

14 Jun

There are several patched terminal server dll’s floating around in the net to allow multiple concurrent Terminal Server session on Windows Vista with Service Pack 1. But they all have the same limitations:

It’s not possible to start a session to Localhost, this is because the Terminal Server client does a check to see if you are running Personal Terminal Server (Vista/XP) and denies Localhost or 127.0.0.1 if true (127.0.0.2 works though).

It’s not possible to start multiple sessions with the same user. The patch for Vista RTM did allow for this but in Service Pack 1 some Terminal Server code has moved to the Local Session Manager (lsm.exe) so we need to patch this file as well.

Offcourse we need to patch Terminal Server to allow unlimited session on Vista as well.

VPatch files are in the download link below.

Vista SP1 Patches (7215 downloads)

13 Comments

Filed under: Terminal Server, Vista

10,387 views

Terminal Server Ping Tool

Author: Remko Weijnen

13 Jun

A while ago I included a new undocumented API into my JwaWinsta unit which is called WinStationServerPing. This API “pings” a Terminal or Citrix server and verifies that Terminal Server is up and running. It is not the same as a regular networking ping! This API actually makes a connection to a (remote) Terminal Server and verifies that Terminal Server runs and accepts connections.

I wrote a small cmdline tool that uses this API to ping a Terminal Server which can be used to quickly determine if a Terminal Server is up and running. I named it WTSPing.

So how does it work? Open up a command prompt (Start -> Run -> cmd) and type WTSPing /? to see the help:

Read the rest of this entry »

6 Comments

Filed under: Citrix, Terminal Server

14,317 views

Script to logoff all Terminal Server sessions

Author: Remko Weijnen

9 Jun

I needed a script to logoff all running Terminal Server sessions in order to rollout an install package. As you might know there is a commandline tool to logoff a session, it’s called logoff.exe.

These are the commandline options:

LOGOFF [sessionname | sessionid] [/SERVER:servername] [/V]

sessionname The name of the session.
sessionid The ID of the session.
/SERVER:servername Specifies the Terminal server containing the user
session to log off (default is current).
/V Displays information about the actions performed.

No option to logoff all sessions is there?

On a Terminal Server there is a special session called the Listener session, you can see it with TSAdmin in the sessions tab:

A Listener is associated with a protocol (Microsoft RDP by default) and is used to setup new sessions. If you logoff a Listener session it will logoff all session that were created through it. Great, just what we need!

So Logoff 65536 will do the trick? Let’s try:

So Logoff is smart enough to ask for confirmation, we can prevent this by using the following commandline:

Echo Y ! Logoff 65536

5 Comments

Filed under: Uncategorized

6,676 views

Encrypting RDP Passwords in VB.NET

Author: Remko Weijnen

2 May

Justin Shepard converted my code to encrypt RPD passwords to VB.NET:

'======SOF
 
Imports System
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports Microsoft.VisualBasic
 
Public Module RdpEncrypt
 
    Public Class DPAPI
&lt;dllimport&gt; _
        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
 
&lt;dllimport&gt; _
        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
 
&lt;structlayout&gt; _
        Friend Structure DATA_BLOB
            Public cbData As Integer
            Public pbData As IntPtr
        End Structure
 
&lt;structlayout&gt; _
        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

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()

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

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

2 Comments

Filed under: Uncategorized

5,063 views

Working with bitfields in Delphi

Author: Remko Weijnen

1 May

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:

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

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:

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;

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!
CodeCompletion

Offcourse we need to implement the Getters and Setters:

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;

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:

... 
  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);

...

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:

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

_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:

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;

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:

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

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:

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

_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:

ULONG   SomeValue  : 1; 
ULONG   OtherValue : 1; 
ULONG   ColorDepth : 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

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

BitField: Set Of (

SomeValue, OtherValue, ColorDepth1, ColorDepth2, ColorDepth3, al32Bit

);

We need a helper function to retreive the numeric value of ColorDepth:

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 &gt; 64 
  if Count &gt; 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 &gt; 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;

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;

The helper function is used like this:

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

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:

A Delphi Set can contain at most 256 values.
The ValueFromBitSet function returns an Int64, so values that do not fit in an Int64 cannot be returned.
Values in a Set need a unique name.

5 Comments

Filed under: Delphi, Programming

3,011 views

Using Windows Server 2008 as a SUPER workstation OS

Author: Remko Weijnen

6 Apr

Vijayshinva Karnure wrote a very cool article about running Server 2008 as a desktop os or rather as a Windows Vista replacement. It seems that besides additional features like Hyper-V, Server 2008 runs approx. 20% faster than Vista.

If only upgrading Vista to Server 2008 would be possible… (has anyone ever tried)?

Links:

http://blogs.msdn.com/vijaysk/archive/2008/02/11/using-windows-server-2008-as-a-super-desktop-os.aspx

http://vista.blorge.com/2008/03/11/windows-server-2008-is-20-faster-than-vista/

0 Comments

Filed under: Vista, Windows 2008

7,755 views

How to deactivate Internet Explorer Enhanced Security Configuration in Windows Server 2008?

Author: Remko Weijnen

4 Apr

Open Server Manager and in the Security Information tab click Configure IE ESC. An improvement in Server 2008 is that you can disable it for Administators but enable it for Normal Users, this is nice for Terminal Server and Citrix environments.

Internet Explorer Enhanced Security Configuration