Autor
|
Thema: VBA: Regestry Zugriffsproblem (1512 mal gelesen)
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
![](/foren/avatars/bk.sc.gif)
![Schreiben Sie einen Gästebucheintrag für bk.sc](/foren/ubb/pmimages/gbu.gif) Beiträge: 2770 Registriert: 18.07.2012 HP Z400 Workstaion CPU: Intel Xeon 6x 3,33GHz GPU: NVIDEA Quadro 2000 RAM: 12 GB DDR3 Win 7 x64 CAD Hauptberuflich -Solid Works 2014 SP5 -Creo Elements Direct Drafting (ME10) DMS/PDM -Pro.File V8 (8.4) Simulation -Simufact Forming 11.0 CAD Nebenberuflich -Pro Engineer WF 3+4 -Creo Parametric 2.0
|
erstellt am: 31. Jul. 2015 11:19 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif)
Hallo zusammen, ich muss für eine Anwendung die CLSID ermitteln hiezu muss ich auf die Regestry zugreifen und den ensprechenden Schlüssel auslesen. Eckdaten: VBA wird aus SolidWorks (64Bit) heraus asusgeführt. BS ist Windows 7 (64Bit) CLSID von 32Bit Anwendung wird gesucht z.B. Excel 2010. Code: Option ExplicitDeclare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByRef hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As LongPtr, ByVal samDesired As Long, phkResult As LongPtr) As Long Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByRef hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As LongPtr, ByVal lpData As String, lpcbData As Long) As Long Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByRef hKey As LongPtr) As Long Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_READ As Long = &H20019 Private Const KEY_QUERY_VALUE = 1 Private Const KEY_ALL_ACCESS = &H3F Private Const KEY_WOW64_32KEY As Long = &H200 Private Const KEY_WOW64_64KEY As Long = &H100 Private Const REG_OPTION_NON_VOLATILE = &H0 Private Const REG_SZ As Long = 1 Private Const ERROR_SUCCESS = 0& Public Sub GetCLSID()
Dim hKey As LongPtr Dim RetVal As Long Dim sProgId As String Dim sCLSID As String sProgId = "Excel.Application.14" RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\" & sProgId & "\CLSID", REG_OPTION_NON_VOLATILE, KEY_READ Or KEY_WOW64_32KEY, hKey) If RetVal = 0 Then Dim n As Long RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sCLSID = Space(n) RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n) sCLSID = Left(sCLSID, n - 1) RegCloseKey hKey End If MsgBox sCLSID, vbOKOnly, "CLSID" End Sub '################################################### '################################################### Sub GetCLSID2() Dim sProgId2 As String Dim oReg As Object Dim strKeyPath As String Dim arrSubKeys As Variant Dim arrSubKeys1 As Variant Dim strValue As Variant Dim strValue1 As Variant sProgId2 = "Excel.Application.14" Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") strKeyPath = "SOFTWARE\Classes\" & sProgId2 & "\CLSID" oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys If Not IsArray(arrSubKeys) Then Exit Sub For Each strValue In arrSubKeys Debug.Print strValue oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath & "\" & strValue, arrSubKeys1 If IsArray(arrSubKeys1) Then For Each strValue1 In arrSubKeys1 Debug.Print vbTab & strValue1 Next End If Next End Sub
Diese 2 Varianten habe ich bereits im www gefunden und an diesen rumprobiert bekomme aber in Variante 1 immer den Rückgabewert RetVal = 6 (The handle is invalid) für den Regestyzugriff und bei dem zweiten bleibt das arrSubKeys leer daher springt er zum Exit Sub "If Not IsArray(arrSubKeys) Then Exit Sub". Hab bei dem Pfad auch schon "Wow6432Node" als Ergänzung versucht aber hat auch nichts gebracht. Hat hier vielleicht noch wer eine Idee, ich vermute ja dass das Problem was mit 32bit - 64bit zu tun hat aber sicher bin ich mir nicht. [EDIT]Wenn ich die VBS Varainten zu den beiden Varianten verwende funktioniert das auslesen. Gruß Bernd ------------------ --- Man muß nicht alles wissen, man muß nur wissen wo es steht --- Staatlich anerkannte Deutschniete ![](/foren/ubb/zwinker.gif) [Diese Nachricht wurde von bk.sc am 31. Jul. 2015 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KMassler Ehrenmitglied V.I.P. h.c. CAD Admin + Mädchen für Alles...
![](/foren/avatars/KMassler.gif)
![Schreiben Sie einen Gästebucheintrag für KMassler](/foren/ubb/pmimages/gbu.gif) Beiträge: 2657 Registriert: 06.11.2000
|
erstellt am: 03. Aug. 2015 13:19 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif) Nur für bk.sc
|
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
![](/foren/avatars/bk.sc.gif)
![Schreiben Sie einen Gästebucheintrag für bk.sc](/foren/ubb/pmimages/gbu.gif) Beiträge: 2770 Registriert: 18.07.2012 HP Z400 Workstaion CPU: Intel Xeon 6x 3,33GHz GPU: NVIDEA Quadro 2000 RAM: 12 GB DDR3 Win 7 x64 CAD Hauptberuflich -Solid Works 2014 SP5 -Creo Elements Direct Drafting (ME10) DMS/PDM -Pro.File V8 (8.4) Simulation -Simufact Forming 11.0 CAD Nebenberuflich -Pro Engineer WF 3+4 -Creo Parametric 2.0
|
erstellt am: 03. Aug. 2015 14:56 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif)
Hallo Klaus, wenn du da schon Probleme hast was soll ich dann erst machen . Ich werde mal weiter rumprobieren. Gruß Bernd ------------------ --- Man muß nicht alles wissen, man muß nur wissen wo es steht --- Staatlich anerkannte Deutschniete ![](/foren/ubb/zwinker.gif) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
HenryV Mitglied Konstrukteur, Engineering
![](/foren/ubb/star3.gif) ![](/foren/ubb/star3.gif) ![](/foren/ubb/star3.gif)
![Schreiben Sie einen Gästebucheintrag für HenryV](/foren/ubb/pmimages/gbu.gif) Beiträge: 778 Registriert: 18.05.2005 SolidWorks 2020 x64 SP3.0 Dell Precision 5820 Intel Xeon W-2125 4x4GHz NVIDIA Quadro P2000 5GB 32GB RAM 2x Dell U2412M, 24" TFT Windows 10 Enterprise x64 21H1 Microsoft Office 365 ProPlus Microsoft Visual Studio Enterprise 2022
|
erstellt am: 10. Aug. 2015 16:36 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif) Nur für bk.sc
Hallo Zusammen Wie wäre es damit? Code: Option ExplicitDeclare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const KEY_READ As Long = &H20019 Private Const KEY_QUERY_VALUE = 1 Private Const KEY_ALL_ACCESS = &H3F Private Const KEY_WOW64_32KEY As Long = &H200 Private Const KEY_WOW64_64KEY As Long = &H100 Private Const REG_OPTION_NON_VOLATILE = &H0 Private Const REG_SZ As Long = 1 Private Const ERROR_SUCCESS = 0& Public Sub GetCLSID()
Dim hKey As LongPtr Dim RetVal As Long Dim sProgId As String Dim sCLSID As String sProgId = "Excel.Application.14" RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\" & sProgId & "\CLSID", REG_OPTION_NON_VOLATILE, KEY_READ Or KEY_WOW64_32KEY, hKey) If RetVal = 0 Then Dim n As Long RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sCLSID = Space(n) RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n) sCLSID = Left(sCLSID, n - 1) RegCloseKey hKey End If MsgBox sCLSID, vbOKOnly, "CLSID" End Sub
Gruss Andreas
------------------ 21 ist nur die halbe Antwort. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
![](/foren/avatars/bk.sc.gif)
![Schreiben Sie einen Gästebucheintrag für bk.sc](/foren/ubb/pmimages/gbu.gif) Beiträge: 2770 Registriert: 18.07.2012 HP Z400 Workstaion CPU: Intel Xeon 6x 3,33GHz GPU: NVIDEA Quadro 2000 RAM: 12 GB DDR3 Win 7 x64 CAD Hauptberuflich -Solid Works 2014 SP5 -Creo Elements Direct Drafting (ME10) DMS/PDM -Pro.File V8 (8.4) Simulation -Simufact Forming 11.0 CAD Nebenberuflich -Pro Engineer WF 3+4 -Creo Parametric 2.0
|
erstellt am: 09. Sep. 2015 14:02 <-- editieren / zitieren --> Unities abgeben: ![1 Unity (wenig hilfreich, aber dennoch)](/foren/ubb/z1.gif) ![2 Unities](/foren/ubb/z2.gif) ![3 Unities](/foren/ubb/z3.gif) ![4 Unities](/foren/ubb/z4.gif) ![5 Unities](/foren/ubb/z5.gif) ![6 Unities](/foren/ubb/z6.gif) ![7 Unities](/foren/ubb/z7.gif) ![8 Unities](/foren/ubb/z8.gif) ![9 Unities](/foren/ubb/z9.gif)
Hallo Andreas, oh da war ich wohl schon im Urlaub daher habe ich die Antwort garnicht mitbekommen. Super danke das funktioniert perfekt ![](/foren/ubb/smile.gif) Hätte ich gewusst das ein ändern von ByRef hKey As LongPtr auf ByVal hKey As LongPtr in den PtrSafe Funktionen ausgereicht hätte... Gruß Bernd ------------------ --- Man muß nicht alles wissen, man muß nur wissen wo es steht --- Staatlich anerkannte Deutschniete ![](/foren/ubb/zwinker.gif) [Diese Nachricht wurde von bk.sc am 09. Sep. 2015 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
![](https://ww4.cad.de/books/view.php?what=zone:11101&n=s11101BB) |