9 October 2009

Cloudy Jelly

The usual advice is to stick the boiled up fruit in a bag and leave to drip. Don’t squeeze the bag, or it will be cloudy. Well, my investigations have found that it’s not really the lack of bag squeezing the helps to get clear jelly. It’s the leaving it overnight. You then take the liquor off any sediment that’s fallen to the bottom of the bucket.

I just did my annual crab apple jelly. 8lbs of crab apples. For one batch I let it drip into a bucket, didn’t squeeze and made the jam immediately. The result was pretty cloudy. For the other, I squeezed that first bag and strained through a bit more, which also got a really good squeeze. I then left it in the fridge for a day, because I was tired of making jelly. The bits all settled to the bottom, and the result is perfectly clear. So – you can squeeze the bag, so long as you leave it to settle.

Oh, and crab apple and haw jelly isn’t great. The haws smell like sardines whilst cooking, and make a very sharp jelly. Maybe I stuck too many in. Still, it’s not ruined, just not really worth the bother when the straight stuff tastes so good.

There, a dumb entry to get this thing going again. I’ve been busy, and not programmed much.

12 February 2009

Shuffle things in .Net

Shuffling is complicated. There are two nice pages on CodingHorror:

http://www.codinghorror.com/blog/archives/001008.html

http://www.codinghorror.com/blog/archives/001015.html

The second link shows a chart of the counts of the different possible draws from a  card pack when you do it a few hundred thousand times. This detects the bias of an algorithm.

 

How not to shuffle # 1

Here we go for the approach of picking a number at random, seeing if we have selected it already, adding it to the selected numbers if we haven't, and picking another if we have.

Public Class Form1

Private Shared rand As New Random
Private dic As New Dictionary(Of Integer, Integer)
Dim tb As New TextBox With {.Dock = DockStyle.Fill, .Multiline = True}

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim sw As Stopwatch = Stopwatch.StartNew
Dim shuffled(9999999)() As Integer
For
i As Integer = 0 To shuffled.GetUpperBound(0)
shuffled(i) = GetShuffledDeck(4)
Next
sw.Stop()
For i As Integer = 0 To shuffled.GetUpperBound(0)
Dim key As Integer = shuffled(i)(0) + shuffled(i)(1) * 10 + shuffled(i)(2) * 100 + shuffled(i)(3) * 1000
If dic.ContainsKey(key) Then
dic(key) = dic(key) + 1
Else
dic.Add(key, 1)
End If
Next
Dim
sb As New System.Text.StringBuilder
sb.AppendLine(sw.ElapsedMilliseconds.ToString & "ms.")
For Each kvp As KeyValuePair(Of Integer, Integer) In dic
sb.Append(kvp.ToString & " ")
Next
tb.Text = sb.ToString
Me.Controls.Add(tb)
End Sub

Function
GetShuffledDeck(ByVal numCards As Integer) As Integer()
Dim cards(numCards - 1) As Integer
For
index As Integer = 0 To cards.Length - 1 ' BTW (cards.Length - 1) will be optimized.
Dim card As Integer
Do
' We don't want two identical cards.
card = rand.Next(1, numCards + 1)
Loop While cards.Contains(card)
cards(index) = card
Next
Return
cards
End Function

End Class


This is slow, (O(n^2). My results:



29400ms.

[4312, 416350] [3241, 417266] [4231, 417358] [3214, 416887]


[2134, 416303] [3421, 416548] [4321, 415916] [1324, 415585]


[1234, 417627] [3412, 416762] [4132, 415979] [1432, 416423]


[2143, 416603] [3142, 416542] [1423, 417515] [2314, 416934]


[2341, 417028] [1243, 416388] [2431, 415852] [1342, 417022]


[2413, 416309] [4213, 418019] [3124, 417387] [4123, 415397]



They don't look biased. Standard deviation from the mean is 653.


Certainly not as much as those on the codinghorror site. Let's redo that one...



How not to shuffle # 2


Using the same code with a different shuffle function:



Function GetShuffledDeck(ByVal numCards As Integer) As Integer()
Dim cards(numCards - 1) As Integer
For
i As Integer = 0 To cards.Length - 1
cards(i) = i + 1
Next
For
i As Integer = 0 To cards.Length - 1
Dim n As Integer = rand.Next(cards.Length)
Dim temp As Integer = cards(i)
cards(i) = cards(n)
cards(n) = temp
Next
Return
cards
End Function



3618ms.

[1234, 390450] [1243, 390582] [1324, 312355] [1342, 429289]


[1423, 429646] [1432, 547601] [2134, 390203] [2143, 429178]


[2314, 351753] [2341, 351524] [2413, 429756] [2431, 545840]


[3124, 350694] [3142, 430600] [3214, 312704] [3241, 430164]


[3412, 586053] [3421, 391312] [4123, 351567] [4132, 546387]


[4213, 429804] [4231, 391291] [4312, 390192] [4321, 391055]



There's bias there. s.d. = 71880!!!



How to shuffle # 1 - Knuth shuffle / Fisher-Yates


Here I initialize the Random object with a cryptographically strong seed. Bit better than the default? The default uses the Environment.TickCount, which could be used to work out likely starting seed values.... Not likely to actually happen....

The main difference is the algorithm though, which no longer introduces bias.



Imports System.Security.Cryptography

Public Class Form1

Private Shared rand As Random
Private dic As New Dictionary(Of Integer, Integer)
Dim tb As New TextBox With {.Dock = DockStyle.Fill, .Multiline = True}

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
' get a random seed rather than using the default Random constructor, which
' just uses the Environment.TickCount
Dim rng As New RNGCryptoServiceProvider
Dim seedBytes(3) As Byte
rng.GetBytes(seedBytes)
rand = New Random(BitConverter.ToInt32(seedBytes, 0))
Dim sw As Stopwatch = Stopwatch.StartNew
Dim shuffled(9999999)() As Integer
For
i As Integer = 0 To shuffled.GetUpperBound(0)
shuffled(i) = GetShuffledDeck(4)
Next
sw.Stop()
For i As Integer = 0 To shuffled.GetUpperBound(0)
Dim key As Integer = shuffled(i)(0) + shuffled(i)(1) * 10 + shuffled(i)(2) * 100 + shuffled(i)(3) * 1000
If dic.ContainsKey(key) Then
dic(key) = dic(key) + 1
Else
dic.Add(key, 1)
End If
Next
Dim
sb As New System.Text.StringBuilder
sb.AppendLine(sw.ElapsedMilliseconds.ToString & "ms.")
Dim keys As New List(Of Integer)(dic.Keys)
keys.Sort()
For Each key As Integer In keys
sb.AppendFormat("[{0}, {1}] ", key, dic(key))
Next
tb.Text = sb.ToString
Me.Controls.Add(tb)
End Sub

Function
GetShuffledDeck(ByVal numCards As Integer) As Integer()
Dim cards(numCards - 1) As Integer
For
i As Integer = 0 To cards.Length - 1
cards(i) = i + 1
Next
For
i As Integer = cards.Length - 1 To 0 Step -1
Dim n As Integer = rand.Next(i + 1)
Dim temp As Integer = cards(i)
cards(i) = cards(n)
cards(n) = temp
Next
Return
cards
End Function

End Class



3564ms.

[1234, 417700] [1243, 416060] [1324, 416157] [1342, 416886]


[1423, 416348] [1432, 416439] [2134, 416352] [2143, 417366]


[2314, 416459] [2341, 417555] [2413, 417086] [2431, 416996]


[3124, 415841] [3142, 417191] [3214, 416693] [3241, 416009]


[3412, 416599] [3421, 416026] [4123, 416222] [4132, 416616]


[4213, 416332] [4231, 417548] [4312, 417035] [4321, 416484]



Bias free. s.d. = 526



How to shuffle # 2 - Sorting with a GUID


Again we can just alter the function:



Function GetShuffledDeck(ByVal numCards As Integer) As Integer()
Dim cards = Enumerable.Range(1, numCards)
cards = cards.OrderBy(Function(x) Guid.NewGuid)
Return cards.ToArray
End Function


20129ms.

[1234, 417906] [1243, 416614] [1324, 416582] [1342, 416302]


[1423, 416529] [1432, 416558] [2134, 416695] [2143, 416061]


[2314, 417049] [2341, 415870] [2413, 416690] [2431, 417183]


[3124, 415954] [3142, 416735] [3214, 415955] [3241, 415697]


[3412, 417235] [3421, 416427] [4123, 417626] [4132, 417726]


[4213, 417010] [4231, 415691] [4312, 418397] [4321, 415508]



Slow again. s.d. = 733



How to shuffle # 2 - Sorting with a load of random Doubles


Option Infer On

Imports
System.Security.Cryptography

Public Class Form1

Private Shared rand As Random
Private dic As New Dictionary(Of Integer, Integer)
Private tb As New TextBox With {.Dock = DockStyle.Fill, .Multiline = True}
Private rng As New RNGCryptoServiceProvider

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim sw As Stopwatch = Stopwatch.StartNew
Dim shuffled(9999999)() As Integer
For
i As Integer = 0 To shuffled.GetUpperBound(0)
shuffled(i) = GetShuffledDeck(4)
Next
sw.Stop()
For i As Integer = 0 To shuffled.GetUpperBound(0)
Dim key As Integer = shuffled(i)(0) + shuffled(i)(1) * 10 + shuffled(i)(2) * 100 + shuffled(i)(3) * 1000
If dic.ContainsKey(key) Then
dic(key) = dic(key) + 1
Else
dic.Add(key, 1)
End If
Next
Dim
sb As New System.Text.StringBuilder
sb.AppendLine(sw.ElapsedMilliseconds.ToString & "ms.")
Dim keys As New List(Of Integer)(dic.Keys)
keys.Sort()
For Each key As Integer In keys
sb.AppendFormat("[{0}, {1}] ", key, dic(key))
Next
tb.Text = sb.ToString
Me.Controls.Add(tb)
End Sub

Function
GetShuffledDeck(ByVal numCards As Integer) As Integer()
Dim cards = Enumerable.Range(1, numCards)
cards = cards.OrderBy(Function(x) RandomDouble(x))
Return cards.ToArray
End Function

' This returns a function that creates a random double. The Integer bit is just ignored.
Private Function RandomDouble() As Func(Of Integer, Double)
' 8 bytes for the double.
Dim bytes(7) As Byte
' Get cryptographically strong random bytes into the array.
rng.GetBytes(bytes)
' The function uses the bytes to create a double. x is ignored.
Dim getDouble = Function(x As Integer) BitConverter.ToDouble(bytes, 0)
Return getDouble
End Function

End Class


137380ms.

[1234, 416945] [1243, 416314] [1324, 416742]


[1342, 416652] [1423, 417382] [1432, 416208]


[2134, 417577] [2143, 416464] [2314, 415925]


[2341, 416543] [2413, 416615] [2431, 418076]


[3124, 416493] [3142, 415963] [3214, 417219]


[3241, 415923] [3412, 416774] [3421, 417394]


[4123, 416466] [4132, 416706] [4213, 415900]


[4231, 416736] [4312, 415534] [4321, 417449]



Slooooooooooooooooooooooooooooooow. - The cryptographic random numbers are very expensive!



s.d. = 605



 



So there you go. But, it's interesting to note atma's comments about experienced card players - they don't like their cards shuffled by the computer, they prefer human shuffled cards and can tell the difference.




9 February 2009

Rotated Rectangle Collision – VB.Net

I translated some C code by Oren Becker that determines if two rotated RectangleFs are overlapping. The rectangles are defined by their centre, size and angle of rotation. In the original code the size was actually (Width / 2, Height / 2) which was confusing.

RotatedRectangleF.vb


Public Structure RotatedRectangleF

Public Const Pi As Single = CType(Math.PI, Single)

Private m_centre As PointF
''' <summary>
''' Gets or sets the coordinates of the centre of this RotatedRectangleF structure.
'''
</summary>
''' <returns>
''' A System.Drawing.PointF that represents the centre of this RotatedRectangleF structure.
'''
</returns>
Public Property Centre() As PointF
Get
Return
m_centre
End Get
Set
(ByVal value As PointF)
m_centre = value
End Set
End Property

Private
m_size As SizeF
''' <summary>
''' Gets or sets the size of this RotatedRectangleF.
'''
</summary>
''' <returns>
''' A System.Drawing.SizeF that represents the width and height of this RotatedRectangleF structure.
'''
</returns>
Public Property Size() As SizeF
Get
Return
m_size
End Get
Set
(ByVal value As SizeF)
m_size = value
End Set
End Property

Private
m_angle As Single
''' <summary>
''' Gets or sets the angle in degrees measured clockwise from the x-axis that this RotatedRectangleF structure is rotated.
'''
</summary>
''' <returns>
''' A Single representing the angle in degrees measured clockwise from the x-axis that this RotatedRectangleF structure is rotated.
'''
</returns>
Public Property Angle() As Single
Get
Return
m_angle
End Get
Set
(ByVal value As Single)
m_angle = value
End Set
End Property

''' <summary>
''' Initializes a new instance of the RotatedRectangleF stucture with the specified centre, size and angle.
'''
</summary>
''' <param name="centre">The centre of the RotatedRectangleF instance.</param>
''' <param name="size">The size of the RotatedRectangleF instance.</param>
''' <param name="angle">The angle in degrees clockwise from the x-axis that this RotatedRectangleF is rotated.</param>
''' <remarks></remarks>
Sub New(ByVal centre As PointF, ByVal size As SizeF, ByVal angle As Single)
Me.Centre = centre
Me.Size = size
Me.Angle = angle
End Sub

''' <summary>
''' Render this RotatedRectangle using the provided System.Drawing.Graphics object.
'''
</summary>
''' <param name="g">The System.Drawing.Graphics object with which to draw the RotatedRectangleF.</param>
Public Sub Render(ByVal g As Graphics, ByVal p As Pen)
g.TranslateTransform(Me.Centre.X, Me.Centre.Y)
g.RotateTransform(Me.Angle)
g.DrawRectangle(p, -Me.Size.Width / 2.0F, -Me.Size.Height / 2.0F, Me.Size.Width, Me.Size.Height)
g.ResetTransform()
End Sub

''' <summary>
''' Determines whether two RotatedRectangleF structures intersect.
'''
</summary>
''' <param name="rr1">The first RotatedRectangleF structure.</param>
''' <param name="rr2">The second RotatedRectangleF structure.</param>
''' <returns>True if the two RotatedRectangleF structures intersect, False otherwise.</returns>
''' <remarks>
''' Conversion of code by Oren Becker, 2001
''' http://www.ragestorm.net/tutorial?id=22
'''
</remarks>
Public Shared Function Intersect(ByVal rr1 As RotatedRectangleF, ByVal rr2 As RotatedRectangleF) As Boolean

' Change our structure to match the one in the other code.
' Angle in radians, size is (width / 2, height / 2)
rr1 = New RotatedRectangleF(rr1.Centre, New SizeF(rr1.Size.Width / 2, rr1.Size.Height / 2), DegreesToRadians(rr1.Angle))
rr2 = New RotatedRectangleF(rr2.Centre, New SizeF(rr2.Size.Width / 2, rr2.Size.Height / 2), DegreesToRadians(rr2.Angle))

Dim ang As Single = rr1.Angle - rr2.Angle ' orientation of rotated rr1
Dim cosA As Single = CType(Math.Cos(ang), Single) ' precalculated trigonometic -
Dim sinA As Single = CType(Math.Sin(ang), Single) ' - values for repeated use

Dim x, a1 As Single ' temporary variables for various uses
Dim dx As Single ' deltaX for linear equations
Dim ext1, ext2 As Single ' // min/max vertical values

' move rr2 to make rr1 cannonic
Dim C As New PointF(rr2.Centre.X - rr1.Centre.X, rr2.Centre.Y - rr1.Centre.Y)

' rotate rr2 clockwise by rr2->ang to make rr2 axis-aligned
RotatePointFClockwise(C, rr2.Angle)

' calculate vertices of (moved and axis-aligned := 'ma') rr2
Dim BL As PointF = C - rr2.Size
Dim TR As PointF = C + rr2.Size

' calculate vertices of (rotated := 'r') rr1
Dim A, B As PointF ' vertices of rr2
A.X = -rr1.Size.Height * sinA
B.X = A.X
Dim temp1 As Single = rr1.Size.Width * cosA
A.X = A.X + temp1
B.X = B.X - temp1

A.Y = rr1.Size.Height * cosA
B.Y = A.Y
temp1 = rr1.Size.Width * sinA
A.Y = A.Y + temp1
B.Y = B.Y - temp1

temp1 = sinA * cosA

' verify that A is vertical min/max, B is horizontal min/max
If temp1 < 0 Then
temp1 = A.X
A.X = B.X
B.X = temp1
temp1 = A.Y
A.Y = B.Y
B.Y = temp1
End If

' verify that B is horizontal minimum (leftest-vertex)
If sinA < 0 Then
B.X = -B.X
B.Y = -B.Y
End If

' if rr2(ma) isn't in the horizontal range of
' colliding with rr1(r), collision is impossible
If (B.X > TR.X) OrElse (B.X > -BL.X) Then Return False

' if rr1(r) is axis-aligned, vertical min/max are easy to get
If (temp1 = 0) Then
ext1 = A.Y
ext2 = -ext1
Else
' else, find vertical min/max in the range [BL.x, TR.x]
x = BL.X - A.X
a1 = TR.X - A.X
ext1 = A.Y
' if the first vertical min/max isn't in (BL.x, TR.x), then
' find the vertical min/max on BL.x or on TR.x
If a1 * x > 0 Then
dx = A.X
If x < 0 Then
dx -= B.X
ext1 -= B.Y
x = a1
Else
dx += B.X
ext1 += B.Y
End If
ext1 *= x
ext1 /= dx
ext1 += A.Y
End If

x = BL.X + A.X
a1 = TR.X + A.X
ext2 = -A.Y
' if the second vertical min/max isn't in (BL.x, TR.x), then
' find the local vertical min/max on BL.x or on TR.x
If a1 * x > 0 Then
dx = -A.X
If x < 0 Then
dx -= B.X
ext2 -= B.Y
x = a1
Else
dx += B.X
ext2 += B.Y
End If
ext2 *= x
ext2 /= dx
ext2 -= A.Y
End If
End If

' check whether rr2(ma) is in the vertical range of colliding with rr1(r)
' (for the horizontal range of rr2)
Return Not ((ext1 < BL.Y AndAlso ext2 < BL.Y) OrElse (ext1 > TR.Y AndAlso ext2 > TR.Y))
End Function

Private Shared Function
DegreesToRadians(ByVal degrees As Single) As Single
Return
degrees * Pi / 180
End Function

Private Shared Sub
RotatePointFClockwise(ByRef point As PointF, ByVal radians As Single)
Dim temp As Single = point.X
Dim cosAngle As Single = CType(Math.Cos(radians), Single)
Dim sinAngle As Single = CType(Math.Sin(radians), Single)
point.X = temp * cosAngle + point.Y * sinAngle
point.Y = -temp * sinAngle + point.Y * cosAngle
End Sub

Public Shared Operator
=(ByVal rr1 As RotatedRectangleF, ByVal rr2 As RotatedRectangleF) As Boolean
Return
(rr1.Centre = rr2.Centre) AndAlso (rr1.Angle = rr2.Angle) AndAlso (rr1.Size = rr2.Size)
End Operator

Public Shared Operator
<>(ByVal rr1 As RotatedRectangleF, ByVal rr2 As RotatedRectangleF) As Boolean
Return Not
(rr1 = rr2)
End Operator

End Structure


And a Form1.vb to demonstrate it:


Imports System.Drawing.Drawing2D

Public Class Form1

Private selected As Integer = 1
Private rec1 As New RotatedRectangleF(New PointF(50, -150), New SizeF(100, 100), 10)
Private rec2 As New RotatedRectangleF(New Point(50, -200), New SizeF(25, 100), 55)
Private message As String
Private
messageFont As New Font("Courier New", 10, FontStyle.Regular)
Private selectedRectanglePen As Pen = Pens.Red
Private unselectedRectanglePen As Pen = Pens.Black

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
message = "Arrow keys / mouse down to move" & vbCrLf
message &= "Space to select other rectangle." & vbCrLf
message &= "z x / mouse wheel to rotate."
Me.DoubleBuffered = True
Me
.ClientSize = New Size(800, 800)
Me.Text = RotatedRectangleF.Intersect(rec1, rec2).ToString
End Sub

Private Sub
Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyData
Case Keys.Left
MoveSelectedHorizontally(-1)
Case Keys.Right
MoveSelectedHorizontally(1)
Case Keys.Up
MoveSelectedVertically(-1)
Case Keys.Down
MoveSelectedVertically(1)
Case Keys.Z
RotateSelected(-1)
Case Keys.X
RotateSelected(1)
Case Keys.Space
If selected = 1 Then
selected = 2
Else
selected = 1
End If
Me
.Refresh()
End Select
End Sub

Private Sub
MouseDidSomething(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseMove, Me.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim
pos As New PointF(CSng(e.X - Me.ClientSize.Width / 2), CSng(e.Y - Me.ClientSize.Height / 2))
If selected = 1 Then
rec1.Centre = pos
Else
rec2.Centre = pos
End If
Me
.Refresh()
Me.Text = RotatedRectangleF.Intersect(rec1, rec2).ToString
End If
End Sub

Private Sub
Form1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
If e.Delta > 0 Then
RotateSelected(1)
Else
RotateSelected(-1)
End If
End Sub

Private Sub
RotateSelected(ByVal change As Single)
If selected = 1 Then
rec1.Angle += change
Else
rec2.Angle += change
End If
Me
.Refresh()
Me.Text = RotatedRectangleF.Intersect(rec1, rec2).ToString
End Sub

Private Sub
MoveSelectedHorizontally(ByVal change As Single)
If selected = 1 Then
rec1.Centre = New PointF(rec1.Centre.X + change, rec1.Centre.Y)
Else
rec2.Centre = New PointF(rec2.Centre.X + change, rec2.Centre.Y)
End If
Me
.Refresh()
Me.Text = RotatedRectangleF.Intersect(rec1, rec2).ToString
End Sub

Private Sub
MoveSelectedVertically(ByVal change As Single)
If selected = 1 Then
rec1.Centre = New PointF(rec1.Centre.X, rec1.Centre.Y + change)
Else
rec2.Centre = New PointF(rec2.Centre.X, rec2.Centre.Y + change)
End If
Me
.Refresh()
Me.Text = RotatedRectangleF.Intersect(rec1, rec2).ToString
End Sub

Private Sub
Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
e.Graphics.DrawString(message, messageFont, Brushes.Gray, 10, 10)
e.Graphics.TranslateTransform(Me.ClientSize.Width \ 2, Me.ClientSize.Height \ 2)
e.Graphics.DrawLine(Pens.Gray, -Me.ClientSize.Width \ 2, 0, Me.ClientSize.Width \ 2, 0)
e.Graphics.DrawLine(Pens.Gray, 0, -Me.ClientSize.Height \ 2, 0, +Me.ClientSize.Height \ 2)
Dim store As Matrix = e.Graphics.Transform
If selected = 1 Then
rec2.Render(e.Graphics, unselectedRectanglePen)
e.Graphics.Transform = store
rec1.Render(e.Graphics, selectedRectanglePen)
Else
rec1.Render(e.Graphics, unselectedRectanglePen)
e.Graphics.Transform = store
rec2.Render(e.Graphics, selectedRectanglePen)
End If
End Sub



End Class



2 February 2009

VB.Net - Enumerate the windows update history using the windows update api

Someone in the forum wanted to get the Description for each windows update, and WMI/the registry were no help. They were going to try to dig the information out of "C:\Windows\SoftwareDistribution\DataStore\DataStore.edb", which is undocumented. Some people say it is a Jet database, but I'm not sure. Exchange server uses that extension too.




Anyway the windows update api will do it. This pic shows the interfaces involved:




updateApi 



First you need to get an IUpdateSession. That has a CreateUpdateSearcher method to get an IUpdateSearcher. That has GetTotalHistoryCount to get the number of IUpdateHistoryEntry items inside the IUpdateHistoryCollection. To get the collection you call QueryHistory on the IUpdateSearcher, passing in the count from before. Each IUpdateHistoryEntry has a bunch of properties, some of which have custom types, but they are all simple to retrieve. To get your hands on the interfaces, the easiest way is to use tlbimp from the Visual studio command line (or the one with the platform sdk, or the one with the framework sdk). Copy the wuapi.dll file from .../Windows/System32 to some directory of your choice, navigate there and run...


tlbimp.exe wuapi.dll /out=WUApiInterop.dll




This creates managed signatures for all the COM interfaces in wuapi.dll and sticks them in WuApiInterop.dll. You can  then create a windows forms project, add a reference to WuApiInterop.dll and get your paws on all the interfaces. I made a .Net dll that has a friendly version of the IUpdateHistoryEntry object, and a method to return a collection of them. This is the code that gets the information.



    <SecurityPermission(SecurityAction.LinkDemand, Flags:=SecurityPermissionFlag.UnmanagedCode)> _
Public Shared Function GetHistory() As ReadOnlyCollection(Of HistoryItem)
Dim session As UpdateSession = Nothing
Dim
searcher As IUpdateSearcher = Nothing
Try
session = New UpdateSession
If session Is Nothing Then Throw New InvalidOperationException("Couln't create an IUpdateSearcher.")
searcher = session.CreateUpdateSearcher
Finally
If
session IsNot Nothing Then Marshal.ReleaseComObject(session)
End Try
If
searcher Is Nothing Then Throw New InvalidOperationException("Couldn't create an IUpdateSession.")
Dim count As Integer = searcher.GetTotalHistoryCount
If count = 0 Then
Return New
ReadOnlyCollection(Of HistoryItem)(Nothing)
End If
Dim
historyCollection As IUpdateHistoryEntryCollection = Nothing
Try
historyCollection = searcher.QueryHistory(0, count)
Finally
Marshal.ReleaseComObject(searcher)
End Try
If
historyCollection Is Nothing Then Throw New InvalidOperationException("Couldn't get an IUpdateHistoryEntryCollection.")
Dim items As New List(Of HistoryItem)(count)
Try
For
i As Integer = 0 To count - 1
Dim item As IUpdateHistoryEntry = historyCollection.Item(i)
Dim friendlyItem As New HistoryItem
With friendlyItem
.ClientApplicationId = item.ClientApplicationID
.Date = item.Date
.Description = item.Description
.HResult = item.HResult
Select Case item.Operation
Case WUApiInterop.UpdateOperation.uoInstallation
.Operation = UpdateOperation.Installation
Case WUApiInterop.UpdateOperation.uoUninstallation
.Operation = UpdateOperation.Uninstallation
End Select
Select Case
item.ResultCode
Case WUApiInterop.OperationResultCode.orcAborted
.ResultCode = OperationResultCode.Aborted
Case WUApiInterop.OperationResultCode.orcFailed
.ResultCode = OperationResultCode.Failed
Case WUApiInterop.OperationResultCode.orcInProgress
.ResultCode = OperationResultCode.InProgress
Case WUApiInterop.OperationResultCode.orcNotStarted
.ResultCode = OperationResultCode.NotStarted
Case WUApiInterop.OperationResultCode.orcSucceeded
.ResultCode = OperationResultCode.Succeeded
Case WUApiInterop.OperationResultCode.orcSucceededWithErrors
.ResultCode = OperationResultCode.SucceededWithErrors
End Select
Select Case
item.ServerSelection
Case WUApiInterop.ServerSelection.ssDefault
.ServerSelection = ServerSelection.Default
Case WUApiInterop.ServerSelection.ssManagedServer
.ServerSelection = ServerSelection.ManagedServer
Case WUApiInterop.ServerSelection.ssOthers
.ServerSelection = ServerSelection.Others
Case WUApiInterop.ServerSelection.ssWindowsUpdate
.ServerSelection = ServerSelection.WindowsUpdate
End Select
.ServiceId = item.ServiceID
Uri.TryCreate(item.SupportUrl, UriKind.Absolute, .SupportUrl)
.Title = item.Title
.UninstallationNotes = item.UninstallationNotes
.UninstallationSteps = New System.Collections.Specialized.StringCollection
For j As Integer = 0 To item.UninstallationSteps.Count - 1
.UninstallationSteps.Add(item.UninstallationSteps(j))
Next
.UnmappedResultCode = item.UnmappedResultCode
Dim identity As New UpdateIdentity(item.UpdateIdentity.RevisionNumber, item.UpdateIdentity.UpdateID)
.UpdateIdentity = identity
End With
items.Add(friendlyItem)
Next
Finally
Marshal.ReleaseComObject(historyCollection)
End Try
Return New
ReadOnlyCollection(Of HistoryItem)(items)
End Function


Attached is an example project:




23 January 2009

Set default Wave Out Audio Device - VB.Net / DRVM_MAPPER_PREFERRED_SET

You can set the default audio playback device in windows 2000, Me, and XP with the DRVM_MAPPER_PREFERRED_SET message, which is sent with waveOutMessage().



It doesn't work on vista - you get MMSYSERR_NOTSUPPORTED (8), returned.

You can do it in Vista - see http://vachanger.sourceforge.net/



Anyway, the code uses the Windows Media .Net library.



Imports MultiMedia ' http://windowsmedianet.sourceforge.net/
Imports System.Runtime.InteropServices
Imports System.ComponentModel

Public Class Form1

Private DevicesComboBox As New ComboBox
Private DefaultDeviceLabel As New Label
Private WithEvents SetDefaultButton As New Button
Private Const DRVM_MAPPER_PREFERRED_GET As Integer = &H2015
Private Const DRVM_MAPPER_PREFERRED_SET As Integer = &H2016
Private WAVE_MAPPER As New IntPtr(-1)

' This just brings together a device ID and a WaveOutCaps so
' that we can store them in a combobox.
Private Structure WaveOutDevice

Private m_id As Integer
Public Property
Id() As Integer
Get
Return
m_id
End Get
Set
(ByVal value As Integer)
m_id = value
End Set
End Property

Private
m_caps As WaveOutCaps
Public Property WaveOutCaps() As WaveOutCaps
Get
Return
m_caps
End Get
Set
(ByVal value As WaveOutCaps)
m_caps = value
End Set
End Property

Sub New
(ByVal id As Integer, ByVal caps As WaveOutCaps)
m_id = id
m_caps = caps
End Sub

Public Overrides Function
ToString() As String
Return
WaveOutCaps.szPname
End Function

End Structure

Private Sub
Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' I do use the IDE for this stuff normally... (in case anyone is wondering)
Me.Controls.AddRange(New Control() {DevicesComboBox, DefaultDeviceLabel, SetDefaultButton})
DevicesComboBox.Location = New Point(5, 5)
DevicesComboBox.DropDownStyle = ComboBoxStyle.DropDownList
DevicesComboBox.Width = Me.ClientSize.Width - 10
DevicesComboBox.Anchor = AnchorStyles.Left Or AnchorStyles.Right
DefaultDeviceLabel.Location = New Point(DevicesComboBox.Left, DevicesComboBox.Bottom + 5)
DefaultDeviceLabel.AutoSize = True
SetDefaultButton.Location = New Point(DefaultDeviceLabel.Left, DefaultDeviceLabel.Bottom + 5)
SetDefaultButton.Text = "Set Default"
SetDefaultButton.AutoSize = True
RefreshInformation()
End Sub

Private Sub
RefreshInformation()
PopulateDeviceComboBox()
DisplayDefaultWaveOutDevice()
End Sub

Private Sub
PopulateDeviceComboBox()
DevicesComboBox.Items.Clear()
' How many wave out devices are there? WaveOutGetNumDevs API call.
Dim waveOutDeviceCount As Integer = waveOut.GetNumDevs()
For i As Integer = 0 To waveOutDeviceCount - 1
Dim caps As New WaveOutCaps
' Get a name - its in a WAVEOUTCAPS structure.
' The name is truncated to 31 chars by the api call. You probably have to
' dig around in the registry to get the full name.
Dim result As Integer = waveOut.GetDevCaps(i, caps, Marshal.SizeOf(caps))
If result <> MMSYSERR.NoError Then
Dim
err As MMSYSERR = DirectCast(result, MMSYSERR)
Throw New Win32Exception("GetDevCaps() error, Result: " & result.ToString("x8") & ", " & err.ToString)
End If
DevicesComboBox.Items.Add(New WaveOutDevice(i, caps))
Next
DevicesComboBox.SelectedIndex = 0
End Sub

Private Sub
DisplayDefaultWaveOutDevice()
Dim currentDefault As Integer = GetIdOfDefaultWaveOutDevice()
Dim device As WaveOutDevice = DirectCast(DevicesComboBox.Items(currentDefault), WaveOutDevice)
DefaultDeviceLabel.Text = "Defualt: " & device.WaveOutCaps.szPname
End Sub

Private Function
GetIdOfDefaultWaveOutDevice() As Integer
Dim
id As Integer = 0
Dim hId As IntPtr
Dim flags As Integer = 0
Dim hFlags As IntPtr
Dim result As Integer
Try
' It would be easier to declare a nice overload with ByRef Integers.
hId = Marshal.AllocHGlobal(4)
hFlags = Marshal.AllocHGlobal(4)
' http://msdn.microsoft.com/en-us/library/bb981557.aspx
result = waveOut.Message(WAVE_MAPPER, DRVM_MAPPER_PREFERRED_GET, hId, hFlags)
If result <> MMSYSERR.NoError Then
Dim
err As MMSYSERR = DirectCast(result, MMSYSERR)
Throw New Win32Exception("waveOutMessage() error, Result: " & result.ToString("x8") & ", " & err.ToString)
End If
id = Marshal.ReadInt32(hId)
flags = Marshal.ReadInt32(hFlags)
Finally
Marshal.FreeHGlobal(hId)
Marshal.FreeHGlobal(hFlags)
End Try
' There is only one flag, DRVM_MAPPER_PREFERRED_FLAGS_PREFERREDONLY, defined as 1
' "When the DRVM_MAPPER_PREFERRED_FLAGS_PREFERREDONLY flag bit is set, ... blah ...,
' the waveIn and waveOut APIs use only the current preferred device and do not search
' for other available devices if the preferred device is unavailable.
Return id
End Function

Private Sub
SetDefaultButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles SetDefaultButton.Click
If DevicesComboBox.Items.Count = 0 Then Return
Dim
selectedDevice As WaveOutDevice = DirectCast(DevicesComboBox.SelectedItem, WaveOutDevice)
SetDefault(selectedDevice.Id)
RefreshInformation()
End Sub

Private Sub
SetDefault(ByVal id As Integer)
Dim defaultId As Integer = GetIdOfDefaultWaveOutDevice()
If defaultId = id Then Return ' no change.
Dim result As Integer
' So here we say "change the Id of the device that has id id to 0", which makes it the default.
result = waveOut.Message(WAVE_MAPPER, DRVM_MAPPER_PREFERRED_SET, New IntPtr(id), IntPtr.Zero)
If result <> MMSYSERR.NoError Then
Dim
err As MMSYSERR = DirectCast(result, MMSYSERR)
Throw New Win32Exception("waveOutMessage() error, Result: " & result.ToString("x8") & ", " & err.ToString)
End If
End Sub

End Class










15 January 2009

Enable/Disable a device programmatically with VB.Net using the setup api.

Very quickly...

Check in device manager to see if the device has "Disable" as an option when you R click it. If so then look at the properties, and find the "class guid" and "device instance id".

1) Get a handle to a device info set using SetupDiGetClassDevs - this will get all devices in a class.
2) Get device info data for each device in the class using SetupDiEnumDeviceInfo
3) Get the device instance id for each device using the device info data from (2) and SetupDiGetDeviceInstanceId.
4) Fill in a structure to say you want a property change and call SetupDiSetClassInstallParams. This sets the property in the device info set.
5) Call SetupDiCallClassInstaller to get the installer to make the changes stick.

9 January 2009

Font choice -> dumb bug

Oh wonderful. I thought I was doing something seriously wrong whilst trying to record sound. WaveInOpen takes a flag value, I wanted to specify that it should callback a function and read it as:

#define CALLBACK_FUNCTION   0x000300001



where it is actually



#define CALLBACK_FUNCTION   0x00030000l 



Big difference eh. 1 vs L. The L specifies a C Long (32 bit integer).



I ended up sending two flags then, 0x300000 and 0x1. 0x1 tells it to just query - "can the device be opened" - without actually opening it. 0x300000 isn't defined. In testing it did call my callback function about 1 time in 3, the other 2 times it just crashed without error. So I though it was because I was doing the wrong thing in the callback. Argh.