Through the Interface

module DemandLoading.RegistryUpdate

 

open System.Reflection

open System.Resources

open Microsoft.Win32

open Autodesk.AutoCAD.DatabaseServices

open Autodesk.AutoCAD.Runtime

 

// Get the information from a custom attribute, if of the right type

 

let commandInfo (rm : ResourceManager) (attb : obj) =

  let cma = attb :?> CommandMethodAttribute

  if cma <> null then

 

    // Harvest the information about each command

 

    match cma.LocalizedNameId with

    | null -> (cma.GlobalName, cma.GlobalName, cma.GroupName)

    | _ ->

      try

        (cma.GlobalName,

        rm.GetString(cma.LocalizedNameId),

        cma.GroupName)

      with _ ->

        (cma.GlobalName, cma.GlobalName, cma.GroupName)

  else

    (null, null, null)

 

let commandsFromMethod rm (meth : MethodInfo) =

  Array.map (commandInfo rm)

    (meth.GetCustomAttributes (typeof<CommandMethodAttribute>, true))

 

let commandsFromType assem (t : System.Type) =

  let rm = new ResourceManager(t.FullName, assem)

  rm.IgnoreCase <- true

  Array.map (commandsFromMethod rm) (t.GetMethods()) |> Array.concat

 

let commandsFromModule assem (m : Module) =

  Array.map (commandsFromType assem) (m.GetTypes()) |> Array.concat

 

let commandsFromAssembly assem =

  Array.map (commandsFromModule assem) (assem.GetModules(true))

    |> Array.concat

 

let createDemandLoadingEntries name path currentUser cmds =

 

  // Choose the Registry hive according to the inputs

 

  let hive =

    if currentUser then

      Registry.CurrentUser

    else

      Registry.LocalMachine

 

  // Check whether any valid commands exist (the command-names are

  // the first two entries in the tuple contained in the command

  // information array)

 

  let hasCmds =

    Array.exists (fun (a,b,c) -> a <> null && b <> null) cmds

 

  // And the same for groups, which is the third entry

 

  let hasGrps = Array.exists (fun (a,b,c) -> c <> null) cmds

 

  // Define whether to load the module on startup (if no commands)

  // or on command invocation (if any are defined)

 

  let flags = if hasCmds then 12 else 2

 

  // Open the main AutoCAD (or vertical) and "Applications" keys

 

  use ack =

    hive.OpenSubKey

      (HostApplicationServices.Current.RegistryProductRootKey,

      true)

  use appk = ack.CreateSubKey("Applications")

 

  // Already registered? Just return

 

  if not

    (Array.exists (fun x -> x = name) (appk.GetSubKeyNames())) then

 

    // Create the our application's root key and its values

 

    use rk = appk.CreateSubKey(name)

    rk.SetValue("DESCRIPTION", name, RegistryValueKind.String)

    rk.SetValue("LOADCTRLS", flags, RegistryValueKind.DWord)

    rk.SetValue("LOADER", path, RegistryValueKind.String)

    rk.SetValue("MANAGED", 1, RegistryValueKind.DWord)

 

    // Create a subkey if there are any commands...

 

    if hasCmds then

      use ck = rk.CreateSubKey("Commands")

      let createCommand (key : RegistryKey) info =

        match info with

        | (null, _, _) -> () // Ignore any null global commands

        | (_, null, _) -> () // Ignore any null local commands

        | (glob, loc, _) ->

          key.SetValue(glob,loc,RegistryValueKind.String)

 

      Array.iter (createCommand ck) cmds |> ignore

 

    // And the command groups, if there are any

 

    if hasGrps then

      use gk = rk.CreateSubKey("Groups")

      let createGroup (key : RegistryKey) info =

        match info with

        | (_, _, null) -> ()

        | (_, _, group) ->

          key.SetValue(group, group,RegistryValueKind.String)

 

      Array.iter (createGroup gk) cmds

 

let removeDemandLoadingEntries name currentUser =

 

  // Choose the Registry hive according to the input

 

  let hive =

    if currentUser then

      Registry.CurrentUser

    else

      Registry.LocalMachine

 

  // Open the main AutoCAD (or vertical) and "Applications" keys

 

  use ack =

    hive.OpenSubKey

      (HostApplicationServices.Current.RegistryProductRootKey)

  use appk = ack.OpenSubKey("Applications", true)

 

  // Delete the key with the same name as this assembly

 

  appk.DeleteSubKeyTree(name)

 

let RegisterForDemandLoading() =

 

  // Get the current assembly

 

  let assem = Assembly.GetExecutingAssembly()

 

  // Get the command information and create Registry

  // entries from it

 

  commandsFromAssembly assem

    |> createDemandLoadingEntries

        (assem.GetName().Name) assem.Location true

 

let UnregisterForDemandLoading() =

  removeDemandLoadingEntries

    (Assembly.GetExecutingAssembly().GetName().Name) true