Author Topic: VBScript and Holding The Current "ACAD" Support Paths in The Registry  (Read 2735 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest

OK, I am stomped:

In my VBA Module, AddFileSearchPathsandLocations,
I hold the current Support Paths with The Preferences Object
Code: [Select]
CurrPaths = Preferences.Files.SupportPath

Then to add the new paths and still maintain the current paths; in a loop I use a new variable AllPaths
AllPaths = CurrPaths + NewPaths and it works just fine.
Code: [Select]
For Pcount = 0 To 4
 If NewPath(Pcount) <> 0 Then
  AllPaths = AllPaths & ";" & CurrPaths & ";" & NewPath(Pcount)
 End If
Next Pcount

Preferences.Files.SupportPath = AllPaths

Now, here is the real fun;
In a VBScript, I am writing (at least attempting to) all of my paths directly to the registry; completely outside of ACAD.
All seems to be working well except one detail; The Value Name "ACAD" has multiple paths (Value Data) where as all of the other Values only have one path.

OK, so the question is, in the registry, using a script, how do I create a variable that is going to hold all of the current paths?

It would be something like:

Code: [Select]
Gacadvpaths = "ACAD" & "Valuedata"

But I don't know quite how to get there.

Thanks

Mark




CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Well, I thought I knew the answer, but I now see your tring to do this outside autocad
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest

Hah hah, yes welcome to my nightmare LOL   :-D

The VBA answer is addressed in my posted code.

I need the VB answer.

I am afraid that someone is going to tell me to create an object to hold the paths.

If they do, I will cry  :cry:

My head can't keep up AHHHHHHH

ML

  • Guest

CM

I just read your quote; i think it is that some people have digital photographic memory and other people like myself are still using 35mm  :-D

 :-( :-( :-( :-( :-( :-( :-( :-( :-( :-(

DaveW

  • Guest
See attached file



ML

  • Guest

Hi Dave

I can't extract a .rar file in work and they sort of frown about downloading files here, understandibily.
Anyway, you could post the could for me?
I would appreciate that

Thank you

Mark

ML

  • Guest

Dave,

I took a look at it at home.
In all due respect, I am not really looking for a whole VB Project.  :|
I simply wrote a VBScript that create the ACAD support paths in the registry; I just simply need the "1" answer to the question that I posted.

If that answer is in there, I would really appreciate it if you posted it.

Thank you again

Mark

DaveW

  • Guest
You need to pay more attention, as it is not anywhere need a whole project. Yes, there are some additional things in the code, but it does loop through all versions of acad and all the profiles under that key.

I have looked at quite a few utilities that that modify the reg for acad and found them very confusing to use. The first thing you need are the api calls and write to the reg. The code below contains stuff that should be put in its own module, not a form. Just copy and paste it and save it for future use too. Take the time to review the examples for reading and writing keys that are included in it.
Code: [Select]
'
' Created by E.Spencer (elliot@spnc.demon.co.uk) - This code is public domain.
'
Option Explicit
Global sValue As String
'Security Mask constants
Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
   KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
   KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
   KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE _
   Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' Possible registry data types
Public Enum InTypes
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum

Public Type typSrings
  Val1 As String
  Val2 As String
End Type



' Registry value type definitions
Public Const REG_NONE As Long = 0
Public Const REG_SZ As Long = 1
Public Const REG_EXPAND_SZ As Long = 2
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4
Public Const REG_LINK As Long = 6
Public Const REG_MULTI_SZ As Long = 7
Public Const REG_RESOURCE_LIST As Long = 8
' Registry section definitions
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
' Codes returned by Reg API calls
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
' Registry API functions used in this module (there are more of them)
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

' This routine allows you to get values from anywhere in the Registry, it currently
' only handles string, double word and binary values. Binary values are returned as
' hex strings.
'
' Example
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
Dim TStr1 As String, TStr2 As String
Dim i As Integer
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   If lDataTypeValue = REG_DWORD Then
      td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
      sValue = Format$(td, "000")
   End If
   If lDataTypeValue = REG_BINARY Then
       ' Return a binary field as a hex string (2 chars per byte)
       TStr2 = ""
       For i = 1 To lValueLength
          TStr1 = Hex(Asc(Mid(sValue, i, 1)))
          If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
          TStr2 = TStr2 + TStr1
       Next
       sValue = TStr2
   Else
      sValue = Left$(sValue, lValueLength - 1)
   End If
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistry = sValue
End Function

' This routine allows you to write values into the entire Registry, it currently
' only handles string and double word values.
'
' Example
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValString, "NewValueHere"
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValDWord, "31"
'
Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes, ByVal Value As Variant)
Dim lResult As Long
Dim lKeyValue As Long
Dim InLen As Long
Dim lNewVal As Long
Dim sNewVal As String
On Error Resume Next
lResult = RegCreateKey(Group, Section, lKeyValue)
If ValType = ValDWord Then
   lNewVal = CLng(Value)
   InLen = 4
   lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
Else
   ' Fixes empty string bug - spotted by Marcus Jansson
   If ValType = ValString Then Value = Value + Chr(0)
   sNewVal = Value
   InLen = Len(sNewVal)
   lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
End If
lResult = RegFlushKey(lKeyValue)
lResult = RegCloseKey(lKeyValue)
End Sub

' This routine enumerates the subkeys under any given key
' Call repeatedly until "Not Found" is returned - store values in array or something
'
' Example - this example just adds all the subkeys to a string - you will probably want to
' save then into an array or something.
'
' Dim Res, NewLine As String
' Dim i As Long
' Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
' NewLine = ""
' Do Until Res = "Not Found"
'   Text1.Text = Text1.Text & NewLine & Res
'   i = i + 1
'   Res = ReadRegistryGetSubkey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", i)
'   NewLine = Chr(13) & Chr(10)
' Loop

Public Function ReadRegistryGetSubkey(ByVal Group As Long, ByVal Section As String, Idx As Long) As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
lValueLength = Len(sValue)
lResult = RegEnumKey(lKeyValue, Idx, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   sValue = Left$(sValue, InStr(sValue, Chr(0)) - 1)
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
ReadRegistryGetSubkey = sValue
End Function

' This routine allows you to get all the values from anywhere in the Registry under any
' given subkey, it currently only returns string and double word values.
'
' Example - returns list of names/values to multiline text box
' Dim Res As Variant
' Dim i As Long
' Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Do Until Res(2) = "Not Found"
'    Text1.Text = Text1.Text & Chr(13) & Chr(10) & Res(1) & " " & Res(2)
'    i = i + 1
'    Res = ReadRegistryGetAll(HKEY_CURRENT_USER, "Software\Microsoft\Notepad", i)
' Loop
'
Public Function ReadRegistryGetAll(ByVal Group As Long, ByVal Section As String, Idx As Long) As Variant
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long
Dim lValueLength As Long, lValueNameLength As Long
Dim sValueName As String ', sValue As String
Dim td As Double
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space$(2048)
sValueName = Space$(2048)
lValueLength = Len(sValue)
lValueNameLength = Len(sValueName)
lResult = RegEnumValue(lKeyValue, Idx, sValueName, lValueNameLength, 0&, lDataTypeValue, sValue, lValueLength)
If (lResult = 0) And (Err.Number = 0) Then
   If lDataTypeValue = REG_DWORD Then
      td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
      sValue = Format$(td, "000")
   End If
   sValue = Left$(sValue, lValueLength - 1)
   sValueName = Left$(sValueName, lValueNameLength)
Else
   sValue = "Not Found"
End If
lResult = RegCloseKey(lKeyValue)
' Return the datatype, value name and value as an array
ReadRegistryGetAll = Array(lDataTypeValue, sValueName, sValue)
End Function

' This routine deletes a specified key (and all its subkeys and values if on Win95) from the registry.
' Be very careful using this function.
'
' Example
' DeleteSubkey HKEY_CURRENT_USER, "Software\My Name\My App"
'
Public Function DeleteSubkey(ByVal Group As Long, ByVal Section As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKeyEx(Group, vbNullChar, 0&, KEY_ALL_ACCESS, lKeyValue)
lResult = RegDeleteKey(lKeyValue, Section)
lResult = RegCloseKey(lKeyValue)
End Function

' This routine deletes a specified value from below a specified subkey.
' Be very careful using this function.
'
' Example
' DeleteValue HKEY_CURRENT_USER, "Software\My Name\My App", "NewSubKey"
'
Public Function DeleteValue(ByVal Group As Long, ByVal Section As String, ByVal Key As String) As String
Dim lResult As Long, lKeyValue As Long
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
lResult = RegDeleteValue(lKeyValue, Key)
lResult = RegCloseKey(lKeyValue)
End Function



ML

  • Guest

Dave it is not that I am not paying attention and that I don't appreciate it :loco: it is just that you are sending me too much info. I do appreciate it and I will review it later, it may even be incredibly useful but when I post, I hope to get to the heart of the question fairly quickly as I need to get something done.

Thank you again

Mark

DaveW

  • Guest
If you are not willing to spend the 5 minutes to load and run the project in design time then I cannot help you.

I have having terrible difficulty even posting this, as the forum keeps giving me errors. It is too big for one post and when I split it up it does not work either. I do not know why and do not have any more time today. You will have to download the project.

The part above that goes into a module you do not need to understand, AT ALL!!!!
Just look at the basic examples in it for future use, BUT put that code in a module so it is there for the code that is on the form. Put a break point in the code in the form and run it in design time and step through it at the part where it has the support paths and you will see it find and append the support path. You have to add one line of code to set a phony string, as you will not have the key it is looking for to call that string to add. It is basically looking at one reg key, pulling the string, then finding all of acad's support paths and appending them with that string. Just hard code the string you want at that part, the part where it is looking for the string at a reg, with your support path you want to add. I will try one more time to add the code below ina  few posts.
« Last Edit: July 03, 2007, 10:30:06 AM by DaveW »

ML

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #10 on: July 03, 2007, 10:19:33 AM »

OK

I will take a look

Thank you

Mark

ML

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #11 on: July 03, 2007, 10:46:58 AM »

Ok

Now we are talking

This is bascially what I was after and probably should have figured out on my own:

Code: [Select]
MyCurrntSupportPaths = ReadRegistry(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD\R15.0\" & ACADVer & "\Profiles\" & Res & "\General\", "ACAD")

With this, I will

Replace MyCurrntSupportPaths with
MyCurrntSupportPaths & newpaths

If you go up a bit (I think i posted it) there is a better way to grab the last of ACAD installed or accessed and the last accessed profile.
It is a little more dynamic

I think, that you are adressing all porfiles in this code as well?

I would like to expand my script to prompt the user with all created profiles and ask them which ones to update or select ALL for all profiles

Mark

DaveW

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #12 on: July 03, 2007, 11:28:21 AM »
I think, that you are addressing all profiles in this code as well?

Yes, I am. That is why there are so many loops


I would like to expand my script to prompt the user with all created profiles and ask them which ones to update or select ALL for all profiles

That is a good idea.


Not sure of your code above, as this works outside of ACAD. With the preferences mentioned above, it appeared to me that this was a variable that ACAD was returning to you. I am not sure what you are doing as I have never used that. Perhaps there is also so code missing that explains it. Not a big deal, just so long as you have what you need.
« Last Edit: July 03, 2007, 11:32:07 AM by DaveW »

ML

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #13 on: July 03, 2007, 11:58:42 AM »

Yes, the above code was done in VBA
I only recently started getting into VBScript and realizing the power of it for things such as setting the paths with a double click made a whole lot more sense (from an admin point of view) then to load and run a vba macro on each machine.

Unfortunately, I tend to read books from the back to the front, and no, I don't read Hebrew LOL

Having said that, I started in VBA, I am now learning some scripting, then eventually I would like to dive into VB.net

How is that for backwards? However, it is all relevant.

Well, if you are interested, I would be glad to share the whole VBA Code or my VBScript with you.
Let me know

Thanks again

Mark

ML

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #14 on: July 03, 2007, 12:00:17 PM »

Yes, above I was comparing a small (the relevant) portion of what I did in ACAD-VBA to what I wanted to so in VBScript

Mark

ML

  • Guest
Re: VBScript and Holding The Current "ACAD" Support Paths in The Registry
« Reply #15 on: July 11, 2007, 09:25:26 AM »

Dave

THat line still did not give me the result I was looking for, however, I am sure it is close.
Tough times require tough measures.
So, what I am going to do is say SCREW IT!  :-D

 :| :| :|