I am trying to dynamically create COM object, call COM method and set COM properties. The COM class is a VB6 ActiveX DLL. The implementation is exactly equal to the VB6 code from this page http://msdn.microsoft.com/en-us/library/ms973800.aspx.
In short words, the project is PhysServer and the class name is Temperature which has two properties Celsius and Fahrenheit and two methods GetCelsius() and GetFahrenheit().
I have already run regsvr32 to register the ActiveX DLL to the computer. The ProgID is PhysServer.Temperature.
I have three block of codes
Code Block 1 (works)
Option Explicit Off
Option Strict Off
...
Dim objType = Type.GetTypeFromProgID("PhysServer.Temperature")
Dim comObj = Activator.CreateInstance(objType)
comObj.Celsius = 100
Dim f As Double = comObj.GetFahrenheit()
Console.WriteLine(f) ' shows 212
Code Block 2 (works)
Option Explicit On
Option Strict On
...
Dim objType = Type.GetTypeFromProgID("PhysServer.Temperature")
Dim comObj = Activator.CreateInstance(objType)
Microsoft.VisualBasic.CallByName(comObj, "Celsius", CallType.Let, 100)
Dim f As Double = CDbl(Microsoft.VisualBasic.CallByName(comObj, "GetFahrenheit", CallType.Method, Nothing))
Console.WriteLine(f) ' shows 212
Code Block 3 (doesn't work)
Option Explicit On
Option Strict On
...
Dim objType = Type.GetTypeFromProgID("PhysServer.Temperature")
Dim comObj = Activator.CreateInstance(objType)
Dim f As Double = CDbl(objType.InvokeMember("GetFahrenheit", Reflection.BindingFlags.InvokeMethod, Nothing, comObj, Nothing))
Console.WriteLine(f) ' shows the default value of GetFahrenheit '
objType.InvokeMember("Celsius", Reflection.BindingFlags.SetField Or Reflection.BindingFlags.InvokeMethod, Nothing, comObj, New Object() {100}) ' throws exception: Number of parameters specified does not match the expected number '
f = CDbl(objType.InvokeMember("GetFahrenheit", Reflection.BindingFlags.InvokeMethod, Nothing, comObj, Nothing))
Console.WriteLine(f)
I understand Code Block 1 and Code Block 2. However, how could I use set a COM object using reflection like Code Block 3? By some reasons, I cannot use Code Block 1 and Code Block 2. So the only way is Code Block 3... but it doesn't work.
Does anyone know the solution of Code Block 3? Thanks!
Try this:
objType.InvokeMember("Celsius", Reflection.BindingFlags.SetProperty Or ...
instead of SetField.
comObj is a Runtime-Callable Wrapper, and Celsius will be a Property thereof, not a field.
Its also possible you may need to specify the BindingFlags.Instance flag as well.
Related
ACADAPP = System.Runtime.InteropServices.Marshal.GetActiveObject("AutoCAD.Application")
ACADDOC = ACADAPP.Documents.ActiveDocument
second_POINT = ACADDOC.Utility.GetEntity(select_object, , "Select Object <Enter to Exit> : ")
ACADDOC.Utility.GetEntity returns an error as
type mismatch
in vb.net autocad,when I'm trying with vb6 it works fine.
What about that 2nd empty parameter - is that correct? According to the specification, it expects an object - a point.
object.GetEntity Object, PickedPoint [, Prompt]
Such as...
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Prompt, i.e. Select an object"
By the way - is that really a VB.NET? Or Visual Basic for Application (VBA)? Notice, there are significant differences in syntax and capabilities... The AutoDesk general documentation (incl. online) would be for VBA, not VB.NET.
EDIT:
Dim returnObj As AcadObject
Dim basePnt As Variant
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"
Note, that this example is for VBA, I've never worked with VB.NET and ACAD, I'm not even sure how it is supported.
Make sure you handle empty selection too...
Here's a simple function that will return a selected object.
The PromptEntityResult's ObjectId Property is the actual returned entity, which you will have to get to with a transaction.
Public Shared Function GetEntity() As PromptEntityResult
Dim retVal As PromptEntityResult = Nothing
Dim oDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
Dim oEd As Editor = oDoc.Editor
Dim oPeo As New PromptEntityOptions(Environment.NewLine & "Please select an object")
With oPeo
.SetRejectMessage(Environment.NewLine & "Cannot select that object.")
.AllowNone = False
.AllowObjectOnLockedLayer = True
End With
retVal = oEd.GetEntity(oPeo)
Return retVal
End Function
I am trying to write a ToCSV() extension in VB based on Scott Hanselman's blog. It could be that my C# to VB is not correct, but it all seems right.
I added a module with:
<System.Runtime.CompilerServices.Extension>
Public Function ToCSV(Of T)(items As IEnumerable(Of T)) As String
Try
Dim csvBuilder = New StringBuilder()
Dim properties = GetType(T).GetProperties()
For Each item As T In items
'' Test Code
Dim newline As String = ""
For Each l2 As Reflection.PropertyInfo In properties
' This works
newline &= l2.GetValue(item, Nothing)
' This works too
Dim int As Integer = 1234
Dim s As String = int.ToCSVValue()
'This works
Dim nl = l2.GetValue(item, Nothing)
' This blows up with "Public member 'ToCSVValue' on type 'Integer' not found."
' The Debugger type shows "Object {Integer}" which I assume to mean that the debugger interprets the object as an integer.
nl = nl.ToCSVValue()
Next
' Original code
Dim line As String = String.Join(",", properties.Select(Function(p) p.GetValue(item, Nothing).ToCSVValue()).ToArray())
csvBuilder.AppendLine(line)
Next
Return csvBuilder.ToString()
Catch ex As Exception
Throw
End Try
End Function
<System.Runtime.CompilerServices.Extension>
Private Function ToCSVValue(Of T)(item As T) As String
If item Is Nothing Then
Return """"""
End If
If TypeOf item Is String Then
Return String.Format("""{0}""", item.ToString().Replace("""", "\"""))
End If
Dim dummy As Double
If Double.TryParse(item.ToString(), dummy) Then
Return String.Format("{0}", item)
End If
Return String.Format("""{0}""", item)
End Function
When I call it with something like:
Dim s As String = ctx.Customers.Where(Function(x) x.CustomerID = 123456).Select(Function(x) New With {.CustomerID = x.CustomerID, .CustomerName = x.CustomerName}).ToCSV()
it gets to the function ToCSV just fine. It recognizes the items passed in. It pulls out the first item and sees that there are the 2 fields in it. All good!
The GetValue() works just fine.
If I create a static integer and call ToCSVValue on it, it works fine.
If I create a static string and call ToCSVValue on it, it works fine.
When I call ToCSVValue on the GetValue() I get:
Public member 'ToCSVValue' on type 'Integer' not found.
Likewise, if I have just strings in the dataset, I get:
Public member 'ToCSVValue' on type 'String' not found.
Ideally this would work as it is in the "Original code" section and I can kill all this other test code.
Can anyone tell me what is happening and why the "(Of T)" is not working the get GetValue() types, but it is for the directly cast types?
You need to have 'Option Infer On'.
When I use Option Infer On, it works fine.
If you don't use this, then VB is using 'Object' whenever you leave off the type.
Also, although this isn't causing your problem, the proper conversion of the ToCSV method is:
Public Function ToCSV(Of T As Class)(items As IEnumerable(Of T)) As String
The short answer is that calling it as a method ToCSVValue(p.GetValue(item, Nothing)) will work as in the C# version.
The longer answer is that you can't call extension methods on Object in VB. In VB Object is treated more like dynamic in C#. For example:
<Extension()> Function toStr(Of T)(item As T) As String
Return item.ToString
End Function
then this will result in compile-time Warning "Late bound resolution; runtime errors could occur." and a run-time Error "Public member 'toStr' on type 'Integer' not found.", but it will work in C#:
Dim i As Object = 123
Dim s = i.toStr
We have a custom class library that has been built from the ground up that performs a variety of functions that are required for the business model in place. We also use VBA to automate some data insertion from standard Microsoft packages and from SolidWorks.
To date we have basically re-written the code in the VBA application macro's, but now are moving to include the class library into the VBA references. We've registered the class library for COM interop, and made sure that it is COM visible. The file is referencable, we have added the <ClassInterface(ClassInterfaceType.AutoDual)> _ tag above each of the Public Classes, so that intellisense 'works'.
With that said, the problem now arises - when we reference the class library, for this instance let's call it Test_Object, it is picked up and seems to work just fine. So we go ahead and try a small sample to make sure it's using the public functions and returning expected values:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim test As New Test_Object.Formatting
Dim t As String
t = test.extractNumber("abc12g3y45")
Target.Value = t
End Sub
This works as expected, returning 12345 in the selected cell/s.
However, when I try a different class, following the exact same procedure, I get an error (Object variable or With block variable not set). Code is as follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim test As New Test_Object.SQLCalls
Dim t As String
t = test.SQLNumber("SELECT TOP 1 ID from testdb.dbo.TESTTABLE") 'where the string literal in the parentheses is a parameter that is passed.
Target.Value = t
End Sub
This fails on the t = test.SQLNumber line. It also fails on another function within that SQLCalls class, a function that returns the date in SQL format (so it is not anything to do with the connection to the database).
Can anyone assist in what could be causing this error? I've googled for hours to no avail, and am willing to try whatever it takes to get this working.
Cheers.
EDIT: (added in the .SQLNumber() method)
Function SQLNumber(query As String) As Double
Dim tno As Double
Try
Using SQLConnection As SqlConnection = New SqlConnection(Connection_String_Current)
SQLConnection.Open()
SQLCommand = New SqlCommand(query, SQLConnection)
tno = SQLCommand.ExecuteScalar
End Using
Catch ex As System.Exception
MsgBox(ex.Message)
End Try
Return tno
End Function
For comparison, the extractNumber() method:
Function extractNumber(extstr As String) As Double
Dim i As Integer = 1
Dim tempstr As String
Dim extno As String = ""
Do Until i > Len(extstr)
tempstr = Mid(extstr, i, 1)
If tempstr = "0" Or tempstr = "1" Or tempstr = "2" Or tempstr = "3" Or tempstr = "4" Or tempstr = "5" Or tempstr = "6" Or tempstr = "7" Or tempstr = "8" Or tempstr = "9" Or tempstr = "." Then
extno = extno & tempstr
End If
i = i + 1
Loop
If IsNumeric(extno) Then
Return CDbl(extno)
Else
Return 0
End If
End Function
With the help of vba4all, we managed to delve down right to the issue.
When I tried to create a new instance of an object using Dim x as new Test_Object.SQLCalls, I was completely oblivious to the fact that I had not re-entered this crucial line:
<ClassInterface(ClassInterfaceType.None)> _.
Prior to doing this, I had this in my object explorer which has both the ISQLCalls and SQLCalls in the Classes section
But wait, ISQLCalls isn't a class, it's an interface!
By entering the <ClassInterface(ClassInterfaceType.None)> _ back in the SQLCalls class, the object explorer looked a bit better:
And low and behold, I could now create a new instance of the class, and the methods were exposed.
tldr:
I needed to explicitly declare the interface and use <InterfaceType(ComInterfaceType.InterfaceIsDual)> on the interface and <ClassInterface(ClassInterfaceType.None)> on the class.
Many thanks to vba4all, who selflessly devoted their time to assist in this issue.
I am Compiling My string Code(I read My Code from Text File) In vb and it works fine but i have a function that returns nullable double(Double?)
when i use it like this
Dim x As Double? = Myfunc(1000) 'it returns Nothing
my x variable fills with Nothing and it's ok
But When I use it like this
Dim x = Myfunc(1000) 'it returns Nothing
my x value is 0 !!!!
How can i solve this problem
i want my users write codes like first code block
i tested all Option Explicit and Option Strict but it did not gain me anything.
please let me know how can i use Just dim x not Dim x as (type)
thank you for your helps
UPDATE :this is Myfunc Code :
Function Myfunc(parameterId As Long) As Double?
If parameterId = 1000 Then
Return Nothing
Else
Return tot(parameterId) 'it is a dictionary of values
End If
End Function
And this Is my Compile Class :
Private Shared Function Compile(ByVal vbCode As String) As CompilerResults
Dim providerOptions = New Dictionary(Of String, String)
providerOptions.Add("CompilerVersion", "v4.0")
' Create the VB.NET compiler.
Dim vbProv = New VBCodeProvider(providerOptions)
' Create parameters to pass to the compiler.
Dim vbParams = New CompilerParameters()
' Add referenced assemblies.
vbParams.ReferencedAssemblies.Add("mscorlib.dll")
vbParams.ReferencedAssemblies.Add("System.Core.dll")
vbParams.ReferencedAssemblies.Add("System.dll")
vbParams.ReferencedAssemblies.Add("System.Windows.Forms.dll")
vbParams.ReferencedAssemblies.Add("System.Data.dll")
vbParams.ReferencedAssemblies.Add("Microsoft.VisualBasic.dll")
vbParams.ReferencedAssemblies.Add("System.Xml.dll")
vbParams.ReferencedAssemblies.Add("System.Xml.Linq.dll")
vbParams.GenerateExecutable = False
' Ensure we generate an assembly in memory and not as a physical file.
vbParams.GenerateInMemory = True
' Compile the code and get the compiler results (contains errors, etc.)
Return vbProv.CompileAssemblyFromSource(vbParams, vbCode)
End Function
As discussed above, Option Infer On needs to be included to force the compiler to create the variable as the required type - in this case the Double? returned by MyFunc.
Code snippet:
Dim target As Object
' target gets properly set to something of the desired type
Dim field As FieldInfo = target.GetType.GetField("fieldName", _
BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic)
field.SetValue(target,newValue)
This snippet works perfectly IF target is set to an instance of a CLASS.
However, if target is set to an instance of a STRUCTURE, the code does not actually change the value of the field. No error, but the value remains unchanged.
And, oddly, if I'm stepping through code, watch the SetValue fail to do anything, and immediately go to the Immediate window and type exactly the same SetValue operation, that works.
Any suggestions on what's going on and how to actually change the field IN CODE?
Edit:
Per request from Jon Skeet, actual code:
Private Shared Function XmlDeserializeObject(ByVal objectType As Type, _
ByVal deserializedID As String) As Object
Dim result As Object
result = CreateObject(objectType)
mXmlR.ReadStartElement()
Do While mXmlR.IsStartElement _
AndAlso mXmlR.Name <> elementItem
Dim field As FieldInfo = result.GetType.GetField(FullName, _
BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic)
field.SetValue(result, XmlDeserialize(field.FieldType))
Loop
Return result
End Function
External variables and called routines:
* mXmlR is an XmlTextReader, and is properly initialized and positioned (else this would not work on classes)
* CreateObject works (ditto)
* XmlDeserialize mostly works, and at the point in question is handling an integer just fine. The only known problem is with structures.
As for how I'm checking the value, I'm mostly looking at the Locals window, but I've also used print statements in the Immediate window, and I'm running an NUnit test which is failing because of this problem - while the equivalent test with a class, rather than a structure, passes.
Here's the test.
<Serializable()> Private Structure SimpleStructure
Public MemberOne As Integer
End Structure
<Test()> Sub A016_SimpleStructure()
Dim input As New SimpleStructure
input.MemberOne = 3
Dim st As String = Serialize(input)
Debug.Print(st)
Dim retObject As Object = Deserialize(st)
Assert.IsNotNull(retObject)
Assert.IsInstanceOfType(GetType(SimpleStructure), retObject)
Assert.AreEqual(input.MemberOne, DirectCast(retObject, SimpleStructure).MemberOne)
End Sub
Working with your original sample, I agree that it works in C# but not in VB! If you use Reflector or ILDasm you will see that the call to Field.SetValue(target, ...) is actually compiled (in VB) as:
field.SetValue(RuntimeHelpers.GetObjectValue(target), ...)
GetObjectValue "Returns a boxed copy of obj if it is a value class; otherwise obj itself is returned." I.e. the value is being set on a copy of your struct!
This link gives the explanation (such as it is). The workaround is to declare target as System.ValueType instead of Object. I'm not sure if that actually helps in your real-life code: you may need a messy type test to be able to handle value types separately from reference types.
The problem is that VB makes a copy of the object and the setvalue instruction applies to the copy, but not to the object itself. The workaround is to restore the changes to the original object through an auxliar var and the CType function. In the following example, we want to set the country field of the champion var to Spain (champion is a *St_WorldChampion* structure). We make the changes in the x var, an then we copy them to the champion var. It works.
Public Structure St_WorldChampion
Dim sport As String
Dim country As String
End Structure
Sub UpdateWorldChampion()
Dim champion As New St_WorldChampion, x As ValueType
Dim prop As System.Reflection.FieldInfo
' Initial values: Germany was the winner in 2006
champion.country = "Germany"
champion.sport = "Football"
' Update the World Champion: Spain since 2010
x = champion
prop = x.GetType().GetField("country")
prop.SetValue(x, "Spain")
champion = CType(x, St_WorldChampion)
End Sub
Well, you haven't shown all your code - in particular, where you're setting target and how you're checking the value of the field afterwards.
Here's an example which shows it working fine in C# though:
using System;
using System.Reflection;
struct Foo
{
public int x;
}
class Test
{
static void Main()
{
FieldInfo field = typeof(Foo).GetField("x");
object foo = new Foo();
field.SetValue(foo, 10);
Console.WriteLine(((Foo) foo).x);
}
}
(I'm pretty sure the choice of language isn't relevant here, but with more code we could tell for certain.) My strong suspicion is that you're doing something like:
Foo foo = new Foo();
object target = foo;
// SetValue stuff
// What do you expect foo.x to be here?
The value of foo in the snippet above won't have changed - because on the second line, the value is copied when it's boxed. You'd need to unbox and copy again afterwards:
foo = (Foo) target;
If that's not it, please show a short but complete program which demonstrates the problem.
Hi I made this function using christian example, hope it helps.
This Function uses Properties which also are affected
''' <summary>
''' Establece el -valor- en la -propiedad- en el -objeto-
''' Sets Value in Objeto.[propertyname]
''' </summary>
''' <param name="objeto">Object where we will set this property</param>
''' <param name="Propiedad">Name of the property</param>
''' <param name="valor">New Value of the property</param>
''' <returns>Object with changed property</returns>
''' <remarks>It works on structures!</remarks>
Function Establecer_propiedad(objeto As Object, Propiedad As String, valor As Object) As Object
'Check arguments
If objeto Is Nothing Then Throw New ArgumentNullException("Objeto")
If String.IsNullOrWhiteSpace(Propiedad) Then Throw New ArgumentNullException("Propiedad")
'Get the object type
Dim t As Type = objeto.GetType
'Get the propertyInfo by its name
Dim prop As PropertyInfo = t.GetProperty(Propiedad)
'Check if the property exist
If prop Is Nothing Then Throw New InvalidOperationException("Property does not exist")
If Not prop.CanWrite Then Throw New InvalidOperationException("Property is read only")
'Determine if it is a class or a structure
If Not t.IsValueType Then ' (it is a reference value)
'Set without troubles
If prop.CanWrite Then prop.SetValue(objeto, valor)
'Return object
Return objeto
Else '(It is a structure)
'Create a box using a valuetype
'It doesnot work in object
Dim Box As ValueType
'Set item in box
Box = objeto
'Set value in box
prop.SetValue(Box, valor)
'Return box
Return Box
End If
End Function