1 people like it.

Get COM instances from Running Object Table

Type extensions for System.Activator which enable the retrieval of COM instances from the Running Object Table.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
open System
open System.Diagnostics
open System.Runtime.InteropServices
open System.Runtime.InteropServices.ComTypes

[<AutoOpen>]
module ActivatorExtension =
    [<DllImport("ole32.dll")>]  
    extern int CreateBindCtx([<In>]int reserved,  [<Out>]IBindCtx& ppbc)

    [<DllImport("ole32.dll")>]  
    extern int GetRunningObjectTable([<In>]int reserved, [<Out>]IRunningObjectTable& prot)

    type ComObject(name, instance) =
        member x.Name
            with get() = name
        member x.Instance
            with get() = instance                

    let getRunningObjects() =
        let runningObjectTable = 
            let mutable rot = null
            if GetRunningObjectTable(0, &rot) <> 0 then failwith "GetRunningObjectTable failed!"
            rot

        let getMonikers() =
            let enumerator = 
                let mutable monikerEnumerator = null
                runningObjectTable.EnumRunning(&monikerEnumerator)
                monikerEnumerator.Reset()
                monikerEnumerator

            let getNextMoniker(moniker) =
                let monikers = Array.init<ComTypes.IMoniker> 1 (fun _ -> null)
                let success = enumerator.Next(1, monikers, IntPtr.Zero) = 0
                moniker := monikers.[0]
                success
            
            seq { let moniker = ref null
                  while getNextMoniker(moniker) do yield !moniker }

        let getRunningObjectName(moniker:IMoniker) =
            let mutable runningObjectName, ctx = null, null
            if CreateBindCtx(0, &ctx) <> 0 then failwith "CreateBindCtx failed!"
            moniker.GetDisplayName(ctx, null, &runningObjectName)
            runningObjectName

        let getRunningObject(moniker:IMoniker) =
            let mutable runningObject = null
            if runningObjectTable.GetObject(moniker, &runningObject) <> 0 then failwith "IRunningObjectTable.GetObject failed!"
            runningObject

        getMonikers() |> Seq.map(fun m -> new ComObject(m |> getRunningObjectName, lazy getRunningObject(m)))

    type System.Activator with
        /// <summary>
        /// Gets running COM instances.
        /// </summary>
        /// <param name="namePredicate">A predicate function which filters the instances by name</param>
        static member GetObjects(namePredicate) =
            getRunningObjects() |> Seq.filter(fun comObj -> namePredicate(comObj.Name))

        /// <summary>
        /// Gets a running COM instance and casts it to 't.
        /// </summary>
        /// <param name="runningObjectName">The name of the com instance</param>
        static member GetObject<'t>(runningObjectName) =
            Activator.GetObjects(fun objName -> objName = runningObjectName)
            |> Seq.map(fun comObj -> comObj.Instance.Value :?> 't)
            |> Seq.nth 0

module Test =
    //This function enables the retrieval of the Visual Studio EnvDTE instance given a process id.
    let getVisualStudioInstance processId =
        let instanceName = sprintf "!VisualStudio.DTE.10.0:%i" processId
        let vsComObj = Activator.GetObjects(fun name -> name = instanceName) |> Seq.nth 0
        vsComObj.Instance.Value
namespace System
namespace System.Diagnostics
namespace System.Runtime
namespace System.Runtime.InteropServices
namespace System.Runtime.InteropServices.ComTypes
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
Multiple items
type DllImportAttribute =
  inherit Attribute
  new : dllName:string -> DllImportAttribute
  val EntryPoint : string
  val CharSet : CharSet
  val SetLastError : bool
  val ExactSpelling : bool
  val PreserveSig : bool
  val CallingConvention : CallingConvention
  val BestFitMapping : bool
  val ThrowOnUnmappableChar : bool
  member Value : string

Full name: System.Runtime.InteropServices.DllImportAttribute

--------------------
DllImportAttribute(dllName: string) : unit
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val CreateBindCtx : reserved:int * ppbc:byref<IBindCtx> -> int

Full name: Script.ActivatorExtension.CreateBindCtx
Multiple items
type InAttribute =
  inherit Attribute
  new : unit -> InAttribute

Full name: System.Runtime.InteropServices.InAttribute

--------------------
InAttribute() : unit
val reserved : int
Multiple items
type OutAttribute =
  inherit Attribute
  new : unit -> OutAttribute

Full name: System.Runtime.InteropServices.OutAttribute

--------------------
OutAttribute() : unit
type IBindCtx =
  member EnumObjectParam : ppenum:IEnumString -> unit
  member GetBindOptions : pbindopts:BIND_OPTS -> unit
  member GetObjectParam : pszKey:string * ppunk:obj -> unit
  member GetRunningObjectTable : pprot:IRunningObjectTable -> unit
  member RegisterObjectBound : punk:obj -> unit
  member RegisterObjectParam : pszKey:string * punk:obj -> unit
  member ReleaseBoundObjects : unit -> unit
  member RevokeObjectBound : punk:obj -> unit
  member RevokeObjectParam : pszKey:string -> int
  member SetBindOptions : pbindopts:BIND_OPTS -> unit

Full name: System.Runtime.InteropServices.ComTypes.IBindCtx
val ppbc : byref<IBindCtx>
val GetRunningObjectTable : reserved:int * prot:byref<IRunningObjectTable> -> int

Full name: Script.ActivatorExtension.GetRunningObjectTable
type IRunningObjectTable =
  member EnumRunning : ppenumMoniker:IEnumMoniker -> unit
  member GetObject : pmkObjectName:IMoniker * ppunkObject:obj -> int
  member GetTimeOfLastChange : pmkObjectName:IMoniker * pfiletime:FILETIME -> int
  member IsRunning : pmkObjectName:IMoniker -> int
  member NoteChangeTime : dwRegister:int * pfiletime:FILETIME -> unit
  member Register : grfFlags:int * punkObject:obj * pmkObjectName:IMoniker -> int
  member Revoke : dwRegister:int -> unit

Full name: System.Runtime.InteropServices.ComTypes.IRunningObjectTable
val prot : byref<IRunningObjectTable>
Multiple items
type ComObject =
  new : name:string * instance:Lazy<obj> -> ComObject
  member Instance : Lazy<obj>
  member Name : string

Full name: Script.ActivatorExtension.ComObject

--------------------
new : name:string * instance:Lazy<obj> -> ComObject
val name : string
val instance : Lazy<obj>
val x : ComObject
member ComObject.Name : string

Full name: Script.ActivatorExtension.ComObject.Name
member ComObject.Instance : Lazy<obj>

Full name: Script.ActivatorExtension.ComObject.Instance
val getRunningObjects : unit -> seq<ComObject>

Full name: Script.ActivatorExtension.getRunningObjects
val runningObjectTable : IRunningObjectTable
val mutable rot : IRunningObjectTable
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val getMonikers : (unit -> seq<IMoniker>)
val enumerator : IEnumMoniker
val mutable monikerEnumerator : IEnumMoniker
IRunningObjectTable.EnumRunning(ppenumMoniker: byref<IEnumMoniker>) : unit
IEnumMoniker.Reset() : unit
val getNextMoniker : (IMoniker ref -> bool)
val moniker : IMoniker ref
val monikers : IMoniker []
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val init : count:int -> initializer:(int -> 'T) -> 'T []

Full name: Microsoft.FSharp.Collections.Array.init
type IMoniker =
  member BindToObject : pbc:IBindCtx * pmkToLeft:IMoniker * riidResult:Guid * ppvResult:obj -> unit
  member BindToStorage : pbc:IBindCtx * pmkToLeft:IMoniker * riid:Guid * ppvObj:obj -> unit
  member CommonPrefixWith : pmkOther:IMoniker * ppmkPrefix:IMoniker -> unit
  member ComposeWith : pmkRight:IMoniker * fOnlyIfNotGeneric:bool * ppmkComposite:IMoniker -> unit
  member Enum : fForward:bool * ppenumMoniker:IEnumMoniker -> unit
  member GetClassID : pClassID:Guid -> unit
  member GetDisplayName : pbc:IBindCtx * pmkToLeft:IMoniker * ppszDisplayName:string -> unit
  member GetSizeMax : pcbSize:int64 -> unit
  member GetTimeOfLastChange : pbc:IBindCtx * pmkToLeft:IMoniker * pFileTime:FILETIME -> unit
  member Hash : pdwHash:int -> unit
  ...

Full name: System.Runtime.InteropServices.ComTypes.IMoniker
val success : bool
IEnumMoniker.Next(celt: int, rgelt: IMoniker [], pceltFetched: nativeint) : int
Multiple items
type IntPtr =
  struct
    new : value:int -> nativeint + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member ToInt32 : unit -> int
    member ToInt64 : unit -> int64
    member ToPointer : unit -> unit
    member ToString : unit -> string + 1 overload
    static val Zero : nativeint
    static member Add : pointer:nativeint * offset:int -> nativeint
    static member Size : int
    ...
  end

Full name: System.IntPtr

--------------------
IntPtr()
IntPtr(value: int) : unit
IntPtr(value: int64) : unit
IntPtr(value: nativeptr<unit>) : unit
field nativeint.Zero
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val getRunningObjectName : (IMoniker -> string)
val moniker : IMoniker
val mutable runningObjectName : string
val mutable ctx : IBindCtx
IMoniker.GetDisplayName(pbc: IBindCtx, pmkToLeft: IMoniker, ppszDisplayName: byref<string>) : unit
val getRunningObject : (IMoniker -> obj)
val mutable runningObject : obj
IRunningObjectTable.GetObject(pmkObjectName: IMoniker, ppunkObject: byref<obj>) : int
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val m : IMoniker
type Activator =
  static member CreateComInstanceFrom : assemblyName:string * typeName:string -> ObjectHandle + 1 overload
  static member CreateInstance<'T> : unit -> 'T + 15 overloads
  static member CreateInstanceFrom : assemblyFile:string * typeName:string -> ObjectHandle + 6 overloads
  static member GetObject : type:Type * url:string -> obj + 1 overload

Full name: System.Activator
static member Activator.GetObjects : namePredicate:(string -> bool) -> seq<ComObject>

Full name: Script.ActivatorExtension.GetObjects


 <summary>
 Gets running COM instances.
 </summary>
 <param name="namePredicate">A predicate function which filters the instances by name</param>
val namePredicate : (string -> bool)
val filter : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.filter
val comObj : ComObject
property ComObject.Name: string
static member Activator.GetObject : runningObjectName:string -> 't

Full name: Script.ActivatorExtension.GetObject


 <summary>
 Gets a running COM instance and casts it to 't.
 </summary>
 <param name="runningObjectName">The name of the com instance</param>
val runningObjectName : string
static member Activator.GetObjects : namePredicate:(string -> bool) -> seq<ComObject>


 <summary>
 Gets running COM instances.
 </summary>
 <param name="namePredicate">A predicate function which filters the instances by name</param>
val objName : string
property ComObject.Instance: Lazy<obj>
property Lazy.Value: obj
val nth : index:int -> source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.nth
module Test

from Script
val getVisualStudioInstance : processId:int -> obj

Full name: Script.Test.getVisualStudioInstance
val processId : int
val instanceName : string
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val vsComObj : ComObject
Raw view Test code New version

More information

Link:http://fssnip.net/6s
Posted:12 years ago
Author:Huw Simpson
Tags: com , interop