Серый форум — VBS запускается от 32-битного родительского потока, на x64. Реестр x3

Re: VBS запускается от 32-битного родительского потока, на x64. Реестр x3

null@example.com (as07) — Thu, 26 Jul 2012 09:42:08 +0000

если вдруг кому понадобиться помогла еще статья http://msdn.microsoft.com/en-us/library/windows/desktop/aa393067%28v=vs.85%29.aspx
реализовал дополнительно двумя функциями для GetStringValue и EnumKey

Rem AutoCAD Fonts
rem Option Explicit
on error resume Next
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003 'HKEY_USERS

Const ForWriting = 2
Const ForAppending=8

Const Create = True
Const Modal = True
Const TimeOut1 = "0"
Const TimeOut2 = "5"
Const OverwriteExisting = True

Const  EVENT_SUCCESS=0
Const  EVENT_ERROR=1
Const  EVENT_WARNING=2
Const  EVENT_INFORMATION=4


Rem ----------------------------------------------------------------------------------------------
' путь к логам
strLogPath = "\\server\LOGS\APP\Autodesk\Fonts\"
strValueName = "ProductName"
strAcadLocation = "Location"
dim strLogMessage 'содержит текст протокола установки
Dim objShell
dim objWMIService
dim oRegistry
dim WshNetwork
dim objFSO
dim filename
strComputer="."
strLogMessage = ""
Set objShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\CIMV2")
Set oRegistry=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
Set WshNetwork = CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Rem Проверяем наличие входного параметра
strAction = ""
Set objArgs = WScript.Arguments
If WScript.Arguments.Count > 0 Then
    strAction = UCase(Trim(WScript.Arguments(0)))
End If
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Rem Открываем лог
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
strFileLogName = strLogPath & WshNetwork.ComputerName & ".log"
Rem Выполняем поиск в реестре записи о приложении
strKeyPath = "SOFTWARE\Autodesk\AutoCAD"

Err.clear
    
    Rem ----- Проверка Есть ли раздел---------------------------
        Err.clear
    value1 = objShell.RegRead("HKLM\SOFTWARE\Autodesk\")
          if err.number <> 0 then
        rem     MSGBOX "Нет раздела HKLM\SOFTWARE\Autodesk\"    
    else
        rem     MSGBOX "Есть раздел"    
        Set objFileLog = objFSO.OpenTextFile(strFileLogName, ForAppending, True )
        rem ---    Если есть то создаем лог------ 
        if err.number<>0 then
            MSGBOX "Не удалось создать файл с протоколом " & strFileLogName & ": " & err.description
            wscript.Quit(-1)
        End If        
            writelog vbcrlf 
        writelog "********************"
        writelog Now
        writelog "********************"        
            writelog "Копирование шрифтов в AutoCAD и DWG trueview Ищем Папки"
        strWorkingDir = objShell.CurrentDirectory
        strFontPath=strWorkingDir&"\fonts"
        rem MSGBOX strWorkingDir
        writelog "Папка с шрифтами    " & strFontPath
        Check64=objShell.regread ("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\Identifier")
        writelog vbTab&"Процесор  "& Check64
        If InStr(Check64,"x86")>0 Then
             OSver=32        
        Else
             OSver=64        
        End If
        strKeyPathTru="SOFTWARE\Autodesk\AutoCAD"
         FindANDCopyFont (strKeyPathTru)
        strKeyPathTru="SOFTWARE\Autodesk\DWG TrueView"
         FindANDCopyFont (strKeyPathTru)    
     end if
Set objWMIService = Nothing
WScript.Quit
rem ================================== Основа =========================================================
sub FindANDCopyFont (strKeyPath)
 rem oRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
    arrSubKeys=ReadEnumKey(HKEY_LOCAL_MACHINE, strKeyPath , 64)
    rem +++++++++++++ Ищем Все ключи реестра в разделе ++++++++++++++++ 
      For Each subkey In arrSubKeys    
        key = strKeyPath & "\" & subkey
         arrSubKeys1=ReadEnumKey(HKEY_LOCAL_MACHINE, key , 64)
        rem oRegistry.EnumKey HKEY_LOCAL_MACHINE, key, arrSubKeys1
        For Each subkey1 In arrSubKeys1
            key1=key & "\" & subkey1
            writelog vbTab & key1
            strValueNameValue=""
            strAcadLocationeValue=""
            
            
            strValueNameValue= ReadRegStr (HKEY_LOCAL_MACHINE, key1 ,strValueName ,OSver)
            rem WScript.Echo "strValueNameValue="&strValueNameValue&"   strValueName="&strValueName&"  key1="&key1
            rem oRegistry.GetStringValue HKEY_LOCAL_MACHINE,key1,strValueName,strValueNameValue    
            strAcadLocationeValue =ReadRegStr (HKEY_LOCAL_MACHINE, key1 ,strAcadLocation ,OSver)
            rem oRegistry.GetStringValue HKEY_LOCAL_MACHINE,key1,strAcadLocation,strAcadLocationeValue
            rem определяем путь шрифтов
            if strValueNameValue <>"" then        
                strAcadLocationeValue=strAcadLocationeValue&"\Fonts"
                writelog vbTab & strValueNameValue & vbtab & strAcadLocationeValue
                Set objFolder = objFSO.GetFolder(strFontPath)
                Set colFiles = objFolder.Files
                rem ------------ Проверка есть ли в папке шрифт или нет и его копирование -------------------------------     
                For Each objFile in colFiles
                    filename=strAcadLocationeValue & "\" & objFile.Name         
                    if  (objFSO.FileExists(filename))  Then
                          writelog vbTab & objFile.Name &"  Файл  существует  в папке " & filename             
                    else              
                          writelog vbTab & "Файл не существует копируем в " & filename
                        objFSO.CopyFile (strFontPath & "\" & objFile.Name) , strAcadLocationeValue &"\" , OverwriteExisting
                    end if              
                Next
            end if    
          next          
      Next    
end sub

rem ===================================================================================================
rem -------------------------------------Чтение значения реестра учитывая разрядность------------------
Function ReadRegStr (RootKey, Key5, Value, RegType) 
    Dim oCtx, oLocator, oReg, oInParams, oOutParams 
 
    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet") 
    oCtx.Add "__ProviderArchitecture", RegType 
 
    Set oLocator = CreateObject("Wbemscripting.SWbemLocator") 
    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv") 
 
    Set oInParams = oReg.Methods_("GetStringValue").InParameters 
    oInParams.hDefKey = RootKey 
    oInParams.sSubKeyName = Key5 
    oInParams.sValueName = Value 
 
    Set oOutParams = oReg.ExecMethod_("GetStringValue", oInParams, , oCtx) 
 
    ReadRegStr = oOutParams.sValue 
End Function 
rem----------------------------------------------------------------------------------------------------
rem===============================Чтение веток реестра в массив========================================
Function ReadEnumKey (RootKey1, Key6, RegType1) 
    Dim oCtx1, oLocator1, oReg1, oInParams1, oOutParams1  
    Set oCtx1 = CreateObject("WbemScripting.SWbemNamedValueSet") 
    oCtx1.Add "__ProviderArchitecture", RegType1 
 
    Set oLocator1 = CreateObject("Wbemscripting.SWbemLocator") 
    Set oReg1 = oLocator1.ConnectServer("", "root\default", "", "", , , , oCtx1).Get("StdRegProv") 
 
    Set oInParams1 = oReg1.Methods_("EnumKey").InParameters 
    oInParams1.hDefKey = RootKey1 
    oInParams1.sSubKeyName = Key6     
 
    Set oOutParams1 = oReg1.ExecMethod_("EnumKey", oInParams1, , oCtx1) 
 
    ReadEnumKey = oOutParams1.sNames  
End Function 
rem====================================================================================================

Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Rem _____________________Запись логов__________________________________________________________________
Function writelog(byval strMessage)
    on error resume Next
'    WScript.echo strMessage
'    Exit Function
    err.clear    
    objFileLog.WriteLine strMessage
    if err.number<>0 then
        msgbox err.description
    end if
End Function
Rem ___________________Конец Запись логов______________________________________________________________
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Re: VBS запускается от 32-битного родительского потока, на x64. Реестр x3

null@example.com (Александр_) — Wed, 11 Jul 2012 11:04:57 +0000

x=CreateObject("WbemScripting.SWbemNamedValueSet")
x.Add "__ProviderArchitecture", 64

и т.д.

VBS запускается от 32-битного родительского потока, на x64. Реестр x3

null@example.com (as07) — Tue, 10 Jul 2012 04:31:23 +0000

Добрый день.
Есть скрипт. распрастраняется по Sccm, и получается что родительский поток запускается от x32, и получает значение ветки реестра x32 HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node
Нужно что бы получил доступ к ветке реестра x64 HKEY_LOCAL_MACHINE\SOFTWARE\ , т.к. в ветке HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node нет нужных значений.

Rem AutoCAD Fonts
rem Option Explicit
on error resume Next
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003 'HKEY_USERS
Const ForWriting = 2
Const ForAppending=8
Const Create = True
Const Modal = True
Const TimeOut1 = "0"
Const TimeOut2 = "5"
Const OverwriteExisting = True
Const  EVENT_SUCCESS=0
Const  EVENT_ERROR=1
Const  EVENT_WARNING=2
Const  EVENT_INFORMATION=4
Rem ----------------------------------------------------------------------------------------------
' путь к логам
strLogPath = "\\server\LOGS\APP\Autodesk\Fonts\"
strValueName = "ProductName"
strAcadLocation = "Location"
dim strLogMessage 'содержит текст протокола установки
Dim objShell
dim objWMIService
dim oRegistry
dim WshNetwork
dim objFSO
dim filename
strComputer="."
strLogMessage = ""
Set objShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\CIMV2")
Set oRegistry=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
Set WshNetwork = CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Rem Проверяем наличие входного параметра
strAction = ""
Set objArgs = WScript.Arguments
If WScript.Arguments.Count > 0 Then
    strAction = UCase(Trim(WScript.Arguments(0)))
End If
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Rem Открываем лог
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
strFileLogName = strLogPath & WshNetwork.ComputerName & ".log"
Rem Выполняем поиск в реестре записи о приложении
strKeyPath = "SOFTWARE\Autodesk\AutoCAD"

Err.clear
    Rem ----- Проверка Есть ли раздел---------------------------
        Err.clear
    value = objShell.RegRead("HKLM\SOFTWARE\Autodesk\")
          if err.number <> 0 then
        rem     MSGBOX "Нет раздела HKLM\SOFTWARE\Autodesk\"    
    else
        rem     MSGBOX "Есть раздел"    
        Set objFileLog = objFSO.OpenTextFile(strFileLogName, ForAppending, True )
        rem ---    Если есть то создаем лог------ 
        if err.number<>0 then
            MSGBOX "Не удалось создать файл с протоколом " & strFileLogName & ": " & err.description
            wscript.Quit(-1)
        End If        
            writelog vbcrlf 
        writelog "********************"
        writelog Now
        writelog "********************"        
            writelog "Копирование шрифтов в AutoCAD и DWG trueview Ищем Папки"
        strWorkingDir = objShell.CurrentDirectory
        strFontPath=strWorkingDir&"\fonts"
        rem MSGBOX strWorkingDir
        writelog "Папка с шрифтами    " & strFontPath
        strKeyPathTru="SOFTWARE\Autodesk\AutoCAD"
         FindANDCopyFont (strKeyPathTru)
        strKeyPathTru="SOFTWARE\Autodesk\DWG TrueView"
         FindANDCopyFont (strKeyPathTru)    
     end if
Set objWMIService = Nothing
WScript.Quit
rem ================================== Основа =========================================================
sub FindANDCopyFont (strKeyPath)
oRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
    rem +++++++++++++ Ищем Все ключи реестра в разделе ++++++++++++++++ 
      For Each subkey In arrSubKeys    
        key = strKeyPath & "\" & subkey
        oRegistry.EnumKey HKEY_LOCAL_MACHINE, key, arrSubKeys1
        For Each subkey1 In arrSubKeys1
            key1=key & "\" & subkey1
            writelog vbTab & key1
            strValueNameValue=""
            strAcadLocationeValue=""
            oRegistry.GetStringValue HKEY_LOCAL_MACHINE,key1,strValueName,strValueNameValue            
            oRegistry.GetStringValue HKEY_LOCAL_MACHINE,key1,strAcadLocation,strAcadLocationeValue
            rem определяем путь шрифтов
            if strValueNameValue <>"" then        
                strAcadLocationeValue=strAcadLocationeValue&"\Fonts"
                writelog vbTab & strValueNameValue & vbtab & strAcadLocationeValue
                Set objFolder = objFSO.GetFolder(strFontPath)
                Set colFiles = objFolder.Files
                rem ------------ Проверка есть ли в папке шрифт или нет и его копирование -------------------------------     
                For Each objFile in colFiles
                    filename=strAcadLocationeValue & "\" & objFile.Name         
                    if  (objFSO.FileExists(filename))  Then
                          writelog vbTab & objFile.Name &"  Файл  существует  в папке " & filename             
                    else              
                          writelog vbTab & "Файл не существует копируем в " & filename
                        objFSO.CopyFile (strFontPath & "\" & objFile.Name) , strAcadLocationeValue &"\" , OverwriteExisting
                    end if              
                Next
            end if    
          next          
      Next    
end sub

rem ===================================================================================================



Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Rem _____________________Запись логов__________________________________________________________________
Function writelog(byval strMessage)
    on error resume Next
'    WScript.echo strMessage
'    Exit Function
    err.clear    
    objFileLog.WriteLine strMessage
    if err.number<>0 then
        msgbox err.description
    end if
End Function
Rem ___________________Конец Запись логов______________________________________________________________
Rem +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++