Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  VBasic / vb.net / vbs / wsh
  VBA: Regestry Zugriffsproblem

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  VBA: Regestry Zugriffsproblem (1476 mal gelesen)
bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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 Explicit

Declare 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  

[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...



Sehen Sie sich das Profil von KMassler an!   Senden Sie eine Private Message an KMassler  Schreiben Sie einen Gästebucheintrag für KMassler

Beiträge: 2657
Registriert: 06.11.2000

erstellt am: 03. Aug. 2015 13:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für bk.sc 10 Unities + Antwort hilfreich

ehrlich gesagt: Mir geht's genauso 
Auch die vielen Beispiele, die das WSH verwenden, funktionieren nicht, weder schreiben noch lesen.

------------------
Klaus

www.al-ko.com | mein Gästebuch

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

HenryV
Mitglied
Konstrukteur, Engineering


Sehen Sie sich das Profil von HenryV an!   Senden Sie eine Private Message an HenryV  Schreiben Sie einen Gästebucheintrag für HenryV

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für bk.sc 10 Unities + Antwort hilfreich

Hallo Zusammen

Wie wäre es damit?

Code:
Option Explicit

Declare 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



Technischer Redakteur (m/w/d)

Krauss-Maffei Wegmann, ein Unternehmen der deutsch-französischen Wehrtechnikgruppe KNDS, ist Marktführer in Europa für hochgeschützte Rad- und Kettenfahrzeuge. An Standorten in Deutschland, Brasilien, Griechenland, Mexiko, Singapur und den USA entwickeln, fertigen und betreuen mehr als 4.000 Mitarbeiter ein umfassendes Produktportfolio. Auf die Einsatzsysteme von KMW verlassen sich weltweit die Streitkräfte von über 50 Nationen....

Anzeige ansehenTechnische Dokumentation
bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Andreas,

oh da war ich wohl schon im Urlaub daher habe ich die Antwort garnicht mitbekommen.
Super danke das funktioniert perfekt  

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  

[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 >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz