5 files changed, 93 insertions, 11 deletions
diff --git a/vb/demo/Ice/async/.depend b/vb/demo/Ice/async/.depend
index b0e286eab54..64dfd1cd5bb 100644
--- a/vb/demo/Ice/async/.depend
+++ b/vb/demo/Ice/async/.depend
@@ -1 +1 @@
-Queue.vb: ./Queue.ice
+Queue.vb: ./Queue.ice $(slicedir)/Ice/BuiltinSequences.ice
diff --git a/vb/demo/Ice/async/Consumer.vb b/vb/demo/Ice/async/Consumer.vb
index d9cee083f30..1dbcc5445d1 100755
--- a/vb/demo/Ice/async/Consumer.vb
+++ b/vb/demo/Ice/async/Consumer.vb
@@ -8,6 +8,7 @@
 ' **********************************************************************
 
 Imports System
+Imports System.Collections
 Imports Demo
 
 Module AsyncC
@@ -18,13 +19,35 @@ Module AsyncC
 	Class AMI_Queue_getI
 	    Inherits AMI_Queue_get
 
+	    Public Sub New(ByVal id As String)
+	        _id = id
+
+		SyncLock _requests.SyncRoot
+		    _requests.Add(_id)
+		End SyncLock
+	    End Sub
+
 	    Public Overloads Overrides Sub ice_response(ByVal message As String)
+		SyncLock _requests.SyncRoot
+		    _requests.Remove(_id)
+		End SyncLock
+	        
 	        Console.WriteLine(message)
 	    End Sub
 
 	    Public Overloads Overrides Sub ice_exception(ByVal ex As Ice.Exception)
-	        Console.Error.WriteLine(ex)
+		SyncLock _requests.SyncRoot
+		    _requests.Remove(_id)
+		End SyncLock
+	        
+		If TypeOf ex Is RequestCanceledException Then
+	            Console.Error.WriteLine("Request canceled")
+		Else
+	            Console.Error.WriteLine(ex)
+		End If
 	    End Sub
+
+	    Dim _id As String
 	End Class
 
         Private Sub menu()
@@ -61,7 +84,8 @@ Module AsyncC
                         Exit Try
                     End If
                     If line.Equals("g") Then
-                        queue.get_async(new AMI_Queue_getI)
+		        Dim id As String = Ice.Util.generateUUID()
+                        queue.get_async(new AMI_Queue_getI(id), id)
                     ElseIf line.Equals("x") Then
                         ' Nothing to do
                     ElseIf line.Equals("?") Then
@@ -75,8 +99,20 @@ Module AsyncC
                 End Try
             Loop While Not line.Equals("x")
 
+	    SyncLock _requests.SyncRoot
+	        If not _requests.Count = 0 Then
+		    Try
+		        queue.cancel(_requests.ToArray(GetType(String)))
+		    Catch ex As System.Exception
+		        ' Ignore
+		    End Try
+		End If
+	    End SyncLock
+
             Return 0
         End Function
+
+	Dim Shared _requests As ArrayList = New ArrayList
     End Class
 
     Public Sub Main(ByVal args() As String)
diff --git a/vb/demo/Ice/async/Makefile.mak b/vb/demo/Ice/async/Makefile.mak
index 51b5bf599cb..d34f166bd3b 100644
--- a/vb/demo/Ice/async/Makefile.mak
+++ b/vb/demo/Ice/async/Makefile.mak
@@ -23,6 +23,8 @@ SDIR		= .
 
 GDIR		= generated
 
+SLICE2VBFLAGS	= -I$(slicedir) $(SLICE2VBFLAGS)
+
 !include $(top_srcdir)\config\Make.rules.mak
 
 VBCFLAGS	= $(VBCFLAGS) -target:exe
diff --git a/vb/demo/Ice/async/Queue.ice b/vb/demo/Ice/async/Queue.ice
index d275116694c..337b51a8ad6 100644
--- a/vb/demo/Ice/async/Queue.ice
+++ b/vb/demo/Ice/async/Queue.ice
@@ -10,13 +10,23 @@
 #ifndef QUEUE_ICE
 #define QUEUE_ICE
 
+#include <Ice/BuiltinSequences.ice>
+
 module Demo
 {
 
+exception RequestCanceledException
+{
+};
+
 interface Queue
 {
-    ["ami", "amd"] string get();
+    ["ami", "amd"] string get(string id)
+        throws RequestCanceledException;
+
     void add(string message);
+
+    ["amd"] void cancel(Ice::StringSeq ids);
 };
 
 };
diff --git a/vb/demo/Ice/async/QueueI.vb b/vb/demo/Ice/async/QueueI.vb
index 76b3748e087..94bf45ed332 100755
--- a/vb/demo/Ice/async/QueueI.vb
+++ b/vb/demo/Ice/async/QueueI.vb
@@ -14,17 +14,20 @@ Imports System.Collections
 Public Class QueueI
     Inherits QueueDisp_
 
-    Public Overloads Overrides Sub get_async(ByVal getCB As AMD_Queue_get, ByVal current As Ice.Current)
+    Public Overloads Overrides Sub get_async(ByVal cb As AMD_Queue_get, ByVal id As String, ByVal current As Ice.Current)
         SyncLock Me
 	    If not _messageQueue.Count = 0 Then
 	        Try
-		    getCB.ice_response(_messageQueue(0))
+		    cb.ice_response(_messageQueue(0))
 		    _messageQueue.RemoveAt(0)
 		Catch ex As Ice.Exception
 		    Console.Error.WriteLine(ex)
 		End Try
 	    Else
-	        _requestQueue.Add(getCB)
+	        Dim request As Request = New Request
+		request.id = id
+		request.cb = cb
+	        _requestQueue.Add(request)
 	    End If
 	End SyncLock
     End Sub
@@ -33,8 +36,8 @@ Public Class QueueI
         SyncLock Me
 	    If not _requestQueue.Count = 0 Then
 	        Try
-		    Dim cb As AMD_Queue_get = _requestQueue(0)
-		    cb.ice_response(message)
+		    Dim request As Request = _requestQueue(0)
+		    request.cb.ice_response(message)
 		Catch ex As Ice.Exception
 		    Console.Error.WriteLine(ex)
 		End Try
@@ -44,7 +47,38 @@ Public Class QueueI
 	    End If
 	End SyncLock
     End Sub
+    
+    Public Overloads Overrides Sub cancel_async(ByVal cb As AMD_Queue_cancel, ByVal ids As String(), ByVal current As Ice.Current)
+	cb.ice_response()
 
-    private _messageQueue As ArrayList = New ArrayList
-    private _requestQueue As ArrayList = New ArrayList
+	SyncLock Me
+	    For i As Integer = 0 To ids.Length
+	    	Dim toRemove As ArrayList = New ArrayList
+		Dim r As Request
+	        For Each r In _requestQueue
+		    If r.id.Equals(ids(i)) Then
+		        Try
+			    r.cb.ice_exception(New RequestCanceledException())
+			Catch ex As Ice.Exception
+			    ' Ignore
+			End try
+
+		        toRemove.Add(r)
+		    End If
+		Next
+
+		For Each r In toRemove
+		    _requestQueue.Remove(r)
+		Next
+	    Next
+	End SyncLock
+    End Sub
+
+    Private Class Request
+        Public id As String
+	Public cb As AMD_Queue_get
+    End Class
+
+    Private _messageQueue As ArrayList = New ArrayList
+    Private _requestQueue As ArrayList = New ArrayList
 End Class