1

Тема: VBS: Как посмотреть все свойства объекта?

Создаю, объект со свойствами и переменными (кстати, можно ли как-нибудь без класса обойтись?)
Можно ли в VBS как-то обойти свойства объекта подобно методу js?

class MyObj
  dim p1, p2, p3
  property let prop1(value)
    p1 = value
  end property
  property get prop1
    prop1 = p1
  end property
end class

dim obj
set obj = new MyObj
obj.p1 = "123"
obj.p2 = 2
WScript.Echo obj.prop1 & " " & obj.p1 '-> "123 123"

dim elem
for each elem in obj 'Ошибка выполнения Microsoft VBScript: Объект не поддерживает это свойство или метод
  WScript.Echo elem
next

Прочтены:
VBScript: Создание пользовательского объекта
VBScript: использование собственных классов
Испробован метод с созданием объекта htmlfile и внедрением js. Работает на объектах, но не понимает массивов, так что не вариант, видимо.

'добавить к коду выше
vard obj
' Возвращает:
' (object)=><
  ' prop1 (string)=>123<
  ' p1 (string)=>123<
  ' p2 (number)=>2<
  ' p3 (undefined)=>undefined<

' dim arr(10)
' arr(0)=2
' vard arr 'Возвращает (unknown)=><

' Возвращает строку рекурсивного описания содержимого объекта oBj
function vardump (byref oBj, byval sParentName, byval nEsting)
  dim sJS
  sJS = "function vardump_js(oBj, sParentName, nEsting) {" & _
  "var nEsting_max = 20;" & _
  "var nPadding = 2;" & _
  "if (typeof (sParentName) == ""undefined"")" & _
  "  sParentName = """";" & _
  "if (typeof (nEsting) != ""number"")" & _
  "  nEsting = nEsting_max;" & _
  "var sRes = """";" & _
  "if (nEsting >= 0)" & _
  "{" & _
  "  var nGap = nPadding * (nEsting_max - nEsting);" & _
  "  for ( var i = 0; i < nGap; i++)" & _
  "    sRes += "" "";" & _
  "  sRes += sParentName + (sParentName == """" ? """" : "" "") + ""("" + typeof (oBj) + "")=>"" + oBj + ""<\r\n"";" & _
  "  if (typeof (oBj) == ""object"")" & _
  "    for ( var oEl in oBj)" & _
  "    {" & _
  "      var sObjName = sParentName;" & _
  "      if (sObjName != """")" & _
  "        sObjName += ""."";" & _
  "      sObjName += oEl;" & _
  "      sRes += arguments.callee(oBj[oEl], sObjName, nEsting - 1);" & _
  "    }" & _
  "}" & _
  "else" & _
  "  sRes = sParentName + "" ! Nesting limit !\r\n"";" & _
  "return(sRes);" & _
  "}"
  dim oDoc, oWindow
  Set oDoc = CreateObject("htmlfile")
  Set oWindow = oDoc.parentWindow
  oWindow.execScript sJS,"javascript" '
  vardump = oWindow.vardump_js(oBj, sParentName, nEsting)
end function

' Упрощенная версия с названием
sub vard2 (byref oBj, byval sParentName)
  WScript.Echo(vardump(oBj, sParentName, 20))
end sub

' Упрощенная версия
sub vard(byref oBj)
  call vard2(oBj, "")
end sub

2

Re: VBS: Как посмотреть все свойства объекта?

jite пишет:

Можно ли в VBS как-то обойти свойства объекта подобно методу js?

Насколько я знаю — нет. Для внешних объектов (в том числе и реализованных на *.wsc) можно пользоваться браузером объектов, дабы посмотреть свойства/методы объекта. А для внутренних, созданных посредством «Class…End Class» зачем сие нужно?

При реализации WMI сразу заложили подобную возможность, а именно: объект «WbemObject» обладает свойствами «.Properties_»/«.Methods_» позволяющими обращаться к свойствам/методам объекта посредством перечисления, не зная их заранее. Например:

Option Explicit

' Enum WbemCimtypeEnum
Const wbemCimTypeEmpty     = &H0000
Const wbemCimTypeSInt16    = &H0002
Const wbemCimTypeSInt32    = &H0003
Const wbemCimTypeReal32    = &H0004
Const wbemCimTypeReal64    = &H0005
Const wbemCimTypeString    = &H0008
Const wbemCimTypeBoolean   = &H000B
Const wbemCimTypeObject    = &H000D
Const wbemCimTypeSInt8     = &H0010
Const wbemCimTypeUInt8     = &H0011
Const wbemCimTypeUInt16    = &H0012
Const wbemCimTypeUInt32    = &H0013
Const wbemCimTypeSInt64    = &H0014
Const wbemCimTypeUInt64    = &H0015
Const wbemCimTypeDateTime  = &H0065
Const wbemCimTypeReference = &H0066
Const wbemCimTypeChar16    = &H0067
Const wbemCimTypeIllegal   = &H0FFF
Const wbemCimTypeFlagArray = &H2000


Dim strComputer

Dim objSWbemLocator
Dim objSWbemServicesEx
Dim collSWbemObjectSet
Dim objSWbemObjectEx
Dim objSWbemObjectEx_InParams

Dim collSWbemPropertySet
Dim objSWbemProperty

Dim collSWbemMethodSet
Dim objSWbemMethod

Dim elem

Dim dtCimType

Set dtCimType = WScript.CreateObject("Scripting.Dictionary")

dtCimType.Add wbemCimTypeEmpty,     "CimTypeEmpty"
dtCimType.Add wbemCimTypeSInt16,    "CimTypeSInt16"
dtCimType.Add wbemCimTypeSInt32,    "CimTypeSInt32"
dtCimType.Add wbemCimTypeReal32,    "CimTypeReal32"
dtCimType.Add wbemCimTypeReal64,    "CimTypeReal64"
dtCimType.Add wbemCimTypeString,    "CimTypeString"
dtCimType.Add wbemCimTypeBoolean,   "CimTypeBoolean"
dtCimType.Add wbemCimTypeObject,    "CimTypeObject"
dtCimType.Add wbemCimTypeSInt8,     "CimTypeSInt8"
dtCimType.Add wbemCimTypeUInt8,     "CimTypeUInt8"
dtCimType.Add wbemCimTypeUInt16,    "CimTypeUInt16"
dtCimType.Add wbemCimTypeUInt32,    "CimTypeUInt32"
dtCimType.Add wbemCimTypeSInt64,    "CimTypeSInt64"
dtCimType.Add wbemCimTypeUInt64,    "CimTypeUInt64"
dtCimType.Add wbemCimTypeDateTime,  "CimTypeDateTime"
dtCimType.Add wbemCimTypeReference, "CimTypeReference"
dtCimType.Add wbemCimTypeChar16,    "CimTypeChar16"
dtCimType.Add wbemCimTypeIllegal,   "CimTypeIllegal"
dtCimType.Add wbemCimTypeFlagArray, "CimTypeFlagArray"


strComputer = "."

Set objSWbemLocator    = WScript.CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServicesEx = objSWbemLocator.ConnectServer(strComputer, "root\cimv2")
Set collSWbemObjectSet = objSWbemServicesEx.ExecQuery("SELECT * FROM Win32_ComputerSystem") 'Win32_WMISetting

For Each objSWbemObjectEx In collSWbemObjectSet
    Set collSWbemPropertySet = objSWbemObjectEx.Properties_
    
    WScript.Echo "Properties"
    WScript.Echo "============================================================"
    
    For Each objSWbemProperty In collSWbemPropertySet
        WScript.Echo "Property name  :", objSWbemProperty.Name
        WScript.Echo "Property type  :", dtCimType.Item(objSWbemProperty.CIMType)
        
        If objSWbemProperty.IsArray And Not IsNull(objSWbemProperty.Value) Then
            WScript.Echo "Property values:"
            
            For Each elem In objSWbemProperty.Value
                WScript.Echo vbTab, elem
            Next
        Else
            WScript.Echo "Property value :", objSWbemProperty.Value
        End If
        
        WScript.Echo
    Next
    
    WScript.Echo "============================================================"
    WScript.Echo "Total properties:", collSWbemPropertySet.Count
    
    
    Set collSWbemMethodSet = objSWbemObjectEx.Methods_
    
    WScript.Echo "Methods"
    WScript.Echo "============================================================"
    
    For Each objSWbemMethod In collSWbemMethodSet
        WScript.Echo "Method name:", objSWbemMethod.Name
        
        For Each objSWbemProperty In objSWbemMethod.InParameters.Properties_
            WScript.Echo vbTab, "Argument name  :", objSWbemProperty.Name
            WScript.Echo vbTab, "Argument type  :", dtCimType.Item(objSWbemProperty.CIMType)
            
            WScript.Echo
        Next
    Next
    
    WScript.Echo "============================================================"
    WScript.Echo "Total methods:", collSWbemMethodSet.Count
    
    Exit For
Next

dtCimType.RemoveAll

Set dtCimType = Nothing

WScript.Quit 0

Вы, при желании, можете заложить подобную функциональность в созданный класс.

P.S. Естественно, ничто не мешает работать со свойствами/методами стандартными средствами, напрямую: Manipulating Class and Instance Information (Windows).

3 (изменено: jite, 2010-11-21 22:46:18)

Re: VBS: Как посмотреть все свойства объекта?

Функцию предполагается использовать для отладки.
У меня на компе 3 отладчика: VS2005 (долго грузится, фу), MS Script debugger (лучше бы его удалить из списка) и MS Script editor из Office (вполне информативен и быстр). Но в основном пользуюсь в JScript таким дампером - им удобней делать частые простые проверки... Теперь хочу такой же для vbs. Я что-то делаю не так?

А еще удобно вешать дампер на условную ветку возникновения непредвиденной ситуации и сливать в лог, чтобы потом - по прошествии времени - смотреть, что случалось и из-за чего. Хотя это не столь часто бывает надо, да и обычными средствами можно обойтись.

4

Re: VBS: Как посмотреть все свойства объекта?

Ясно. Я вполне себе обхожусь WScript.Echo .

5

Re: VBS: Как посмотреть все свойства объекта?

... а я таки завершил дело.

Теперь это умеет ковырять массивы, регэкспы, классы (с помощью js-кода), Dictionary.

'Возвращает строку рекурсивного описания содержимого объекта oBj. Полная версия
private function vardump (byref oBj, byval sParentName, byval nEsting)
  const nEsting_max = 20  'Максимальный уровень вложенности
  const nPaddingSpace = 2 'Структурный отступ (на него сдвигаем потомков отн. родителей), число пробелов
  const sUnknownValue = "(?)"
  if VarType(sParentName) <> 8 then 'Антиглюк: Если не строка
    on error resume next
    sParentName = CStr(sParentName)
    if Err.Number then 'Антиглюк: При неудачном преобразовании сбрасываем
      sParentName = ""
    end if
    on error goto 0
  end if
  if not IsNumeric(nEsting) then 'Проверка nEsting
    nEsting = nEsting_max
  end if
  dim sNoSpace4First, sRes

  if sParentName = "" then 'У безымянного объекта не будет пробела перед типом
    sNoSpace4First = ""
  else
    sNoSpace4First = " "
  end if
  if nEsting >= 0 then
    dim sObj, i, nArrDims, nElCount, oDi, oJRes, oEl
    nArrDims = -1
    oJRes = false 'Является ли object составным по мнению JScript
    set oDi = CreateObject("Scripting.Dictionary")
    
    if IsObject(oBj) then 'Показать сущность
      sObj = "(object)"
      if VarType(oBj) = 8 then
        dim sTmp
        ' on error resume next
        sTmp = "'" & CStr(oBj) & "'"
        if not Err then
          sObj = sObj & sTmp
        end if
        ' on error goto 0
      end if
      
      dim oSC, sJsCode
      set oSC = CreateObject("ScriptControl")
      oSC.Language = "JScript"
      sJsCode = "function GetObjectProps(oBj, oA){ var sRes=false; if (typeof(oBj)=='object') for (var oEl in oBj) " & _
        "{try {oA.Add(oEl, oBj[oEl]);} catch(e) {oA.Add(oEl, '" & sUnknownValue & "'); sRes=true}} return sRes;}"
      oSC.AddCode(sJsCode)
      oJRes = oSC.Run("GetObjectProps", oBj, oDi)
      
    elseif isArray(oBj) then 'Делаем массиву описание вида "array[2x2x3=12]"
      nArrDims = nGetArrayDims(oBj)
      sObj = "array["
      nElCount = 1
      if nArrDims > 0 then
        for i=1 to nArrDims
          nElCount = nElCount * (UBound(oBj, i) + 1)
          dim sDelim
          if nArrDims = 1 then
            sDelim = ""
          elseif i = nArrDims then
            sDelim = "="
          else
            sDelim = ","
          end if
          sObj = sObj & UBound(oBj, i) & sDelim
        next
        if nArrDims > 1 then
          sObj = sObj & nElCount
        end if
      end if
      sObj = sObj & "]"
      
    elseif IsNull(oBj) then
      sObj = "Null" 'CStr() не может обработать
      
    else 'Остальных просто в строку
      on error resume next 
      sObj = CStr(oBj)
      if Err.Number then
        sObj = sUnknownValue & " " & Err.Description
      end if
      on error goto 0
    end if 'Показать сущность
    
    dim sTab : sTab = Space(nPaddingSpace * (nEsting_max - nEsting))
    sRes = sTab & sParentName & sNoSpace4First &"{" & TypeName(oBj) & "#" & VarType(oBJ) &"}=>" & sObj & "<" & VbCrLf
    
    'Показ содержимого сущности, если оно имеется
    if IsObject(oBj) then 
      if TypeName(oBj) = "Dictionary" then
        for each oEl in oBj
          dim sEl
          if IsNumeric(oEl) then
            if VarType(oEl) = 8  then '8 это String (да, бывают одновременно и IsNumeric, и String)
              sEl = "'" & oEl & "'"
            else
              sEl = oEl
            end if
          else
            sEl = """" & oEl & """"
          end if
          sRes = sRes & vardump(oBj(oEl), sParentName & "[" & sEl & "]", nEsting-1)
        next
      elseif TypeName(oBj) = "IRegExp2" then
        sRes = sRes & sTab & Space(nPaddingSpace) & "Pattern=>" & oBj.Pattern & "<  Global=" & Abs(oBj.Global) & _
          " IgnoreCase=" & Abs(oBj.IgnoreCase) & " Multiline=" & Abs(oBj.Multiline) & VbCrLf
      elseif oJRes then
        for each oEl in oDi
          sRes = sRes & vardump(oDi(oEl), sParentName & "." & oEl , nEsting-1)
        next
      else
        on error resume next 'Пытаемся обработать объект как коллекцию
        dim sResTmp : sResTmp = ""
        for each oEl in oBj
          if not IsEmpty(oEl) then
            sResTmp = sResTmp & vardump(oEl, sParentName & "*", nEsting-1)
          end if
          if Err then 
            exit for
          end if
        next
        if not Err then sRes = sRes & sResTmp
        ' sRes = sRes & vardump(oBj.Name, sParentName & ".Name", nEsting-1) 'Угадай свойство :)
        on error goto 0
      end if
    elseif isArray(oBj) and nArrDims > 0 then  'Если массив с измерениями, выводим его элементы (рекурсией)
      for i=1 to nArrDims 'Делаем словарь счетчиков измерений
        oDi.Add i, 0
      next
      
      for each oEl in oBj 'Вывод элементов массива
        if not IsEmpty(oEl) then 'Вывод только непустых значений
          dim sObjName : sObjName = sParentName & "[" 'Составляем имя элемента "родитель[x,y,z]"
          for i=1 to nArrDims
            sObjName = sObjName & oDi.Item(i)
            if i <> nArrDims then
              sObjName = sObjName & ","
            end if
          next
          sObjName = sObjName & "]"
          sRes = sRes & vardump(oEl, sObjName, nEsting-1)
        end if
        
        oDi.Item(1) = oDi.Item(1) + 1
        if nArrDims > 1 then 'Если "разрядов" более 1, делаем составной счетчик
          for i=1 to nArrDims-1
            if oDi.Item(i) > UBound(oBj, i) then 
              oDi.Item(i) = 0
              oDi.Item(i+1) = oDi.Item(i+1) + 1
            end if
          next
        end if 'составной счетчик
      next 'Вывод элементов массива
    end if 'Если массив

  else
    sRes = sParentName & " ! Nesting limit !" & VbCrLf
  end if
  vardump = sRes
end function

' Упрощенная версия: объект, его название
sub vard2 (byref oBj, byval sParentName)
  on error resume next
  WScript.Echo(vardump(oBj, sParentName, 20))
  if Err then
    WScript.Echo "vardump() Error " & Err.Number & " " & Err.Description
  end if
end sub

' Упрощенная версия: только объект
sub vard(byref oBj)
  call vard2(oBj, "")
end sub

'Возвращает число измерений массива
function nGetArrayDims(arr)
  if not isArray(arr) then
    nGetArrayDims = -1 'Не массив - индикатор ошибки
    exit function
  end if
  dim nElCount, i, nCurElCount
  nElCount = 0
  for each i in arr 'Всего элементов в массиве
    nElCount = nElCount + 1
  next
  if nElCount = 0 then
    nGetArrayDims = 0 'Динамический, не определен
    exit function
  end if
  nGetArrayDims = 1
  nCurElCount = UBound(arr) + 1
  while nElCount > nCurElCount
    nGetArrayDims = nGetArrayDims + 1
    nCurElCount = 1
    for i = 1 to nGetArrayDims
      nCurElCount = nCurElCount * (UBound(arr, i) + 1)
    next
  wend
end function

Использование:

vard переменная
vard2 переменная, "описание переменной, например ее имя"

Отдельно прилагается объект для тестирования.

'Объект для демонстрации возможностей
class MyObj
  dim p1
  public p2
  private p3
  
  property let prop1(value)
    p1 = value
  end property
  
  property get prop1
    prop1 = p1
  end property
  
  function a 
    a = true
  end function

end class

dim obj
set obj = new MyObj
obj.p1 = "123"

dim oD : set oD = CreateObject("Scripting.Dictionary")
oD.Add "number1", 1 
oD.Add "2", "22" 
oD.Add 2.3, obj
oD.Add "Nothing", Nothing

dim oRE : set oRE = CreateObject("VBScript.RegExp")
oRE.IgnoreCase = true
oRE.Pattern = "\S+"
oRE.Global = true
oD.Add true, oRE

dim arr0()
oD.Add "пустой массив", arr0

dim arr1(2)
arr1(1) = 0.1
arr1(2) = CLng(1)
oD.Add "одномерный", arr1

dim arr2 : arr2 = Array(1, arr1, "4")
oD.Add "одномерный Array()", arr2

dim arr3(2,2,2)
arr3(1,1,1) = Null
arr3(1,2,1) = Now
oD.Add "многомерный", arr3

dim oFS : set oFS = CreateObject("Scripting.FileSystemObject")
dim oGF : set oGF= oFS.GetFile(WSH.ScriptName)

oD.Add "FileSystemObject", oFS
oD.Add "FileSystemObject Drives", oFS.Drives
oD.Add "SomeFile", oGF
oD.Add "WScript", WSH
oD.Add "Err", Err

dim oSC : set oSC = CreateObject("ScriptControl")
oSC.Language = "JScript"
oSC.AddCode("function inner(){return 22;}")
oSC.AddCode("function a2() {}")
oD.Add "ScriptControl.Procedures", oSC.Procedures

vard2 oD, "Составной объект"

' Выведет
' Составной объект {Dictionary#9}=>(object)<
  ' Составной объект["number1"] {Integer#2}=>1<
  ' Составной объект['2'] {String#8}=>22<
  ' Составной объект[2,3] {MyObj#9}=>(object)<
    ' Составной объект[2,3].prop1 {String#8}=>123<
    ' Составной объект[2,3].a {String#8}=>(?)<
    ' Составной объект[2,3].p1 {String#8}=>123<
    ' Составной объект[2,3].p2 {Empty#0}=><
  ' Составной объект["Nothing"] {Nothing#9}=>(object)<
  ' Составной объект[Истина] {IRegExp2#9}=>(object)<
    ' Pattern=>\S+<  Global=1 IgnoreCase=1 Multiline=0
  ' Составной объект["пустой массив"] {Variant()#8204}=>array[]<
  ' Составной объект["одномерный"] {Variant()#8204}=>array[2]<
    ' Составной объект["одномерный"][1] {Double#5}=>0,1<
    ' Составной объект["одномерный"][2] {Long#3}=>1<
  ' Составной объект["одномерный Array()"] {Variant()#8204}=>array[2]<
    ' Составной объект["одномерный Array()"][0] {Integer#2}=>1<
    ' Составной объект["одномерный Array()"][1] {Variant()#8204}=>array[2]<
      ' Составной объект["одномерный Array()"][1][1] {Double#5}=>0,1<
      ' Составной объект["одномерный Array()"][1][2] {Long#3}=>1<
    ' Составной объект["одномерный Array()"][2] {String#8}=>4<
  ' Составной объект["многомерный"] {Variant()#8204}=>array[2,2,2=27]<
    ' Составной объект["многомерный"][1,1,1] {Null#1}=>Null<
    ' Составной объект["многомерный"][1,2,1] {Date#7}=>02.12.2010 18:33:34<
  ' Составной объект["FileSystemObject"] {FileSystemObject#9}=>(object)<
  ' Составной объект["FileSystemObject Drives"] {Drives#9}=>(object)<
    ' Составной объект["FileSystemObject Drives"]* {Drive#8}=>(object)'C:'<
    ' Составной объект["FileSystemObject Drives"]* {Drive#8}=>(object)'D:'<
  ' Составной объект["SomeFile"] {File#8}=>(object)'D:\00\Scripts\_base\test.vbs'<
  ' Составной объект["WScript"] {Object#8}=>(object)'Сервер сценариев Windows'<
  ' Составной объект["Err"] {Object#3}=>(object)<
  ' Составной объект["ScriptControl.Procedures"] {IScriptProcedureCollection#9}=>(object)<
    ' Составной объект["ScriptControl.Procedures"]* {IScriptProcedure#8}=>(object)'inner'<
    ' Составной объект["ScriptControl.Procedures"]* {IScriptProcedure#8}=>(object)'a2'<

Замечания

Наличие в {скобках} значения как TypeName(), так и VarType(), думаю, будет не лишним: можно наблюдать, как некоторые объекты (FileSystemObject.File, WSH и т.п.) возвращают в VarType() типы своих свойств по умолчанию, как правило - строк, а не 9 объекта. Неочевидная особенность, впрочем упомянутая в документации.

Для запуска JScript вместо htmlfile используется ScriptControl. Функциональность та же, переменных и кода меньше. Плюс при ошибках во "внешнем" коде жалуется в исходный, а не молча падает как в htmlfile, что существенно облегчает отладку. А если посмотреть OLE/COM браузером в соответствующую библиотеку типов "Microsoft Script Control 1.0"... то можно открывать отдельную тему, посвященную изучению функциональности данного объекта: обработка ошибок, перечисление процедур/функций в коде, требуемых ими параметров, ограничение времени исполнения, несколько методов выполнения (Run, Eval, ExecuteStatement).

В связи с тем, что TypeName() возвращает конкретные названия "подтипов" можно и далее расширять функциональность, добавляя свойства известных объектов и коллекций (File, Files, Drive и др.) Я же остановился на классических множествах.

6 (изменено: smaharbA, 2010-12-02 22:27:56)

Re: VBS: Как посмотреть все свойства объекта?

class MyObj
  dim p1, p2, p3
  property let prop1(value)
    p1 = value
  end property
  property get prop1
    prop1 = p1
  end property
end class

dim obj
set obj = new MyObj
obj.p1 = "123"
obj.p2 = 2
set ms=createobject("msscriptcontrol.scriptcontrol")
ms.language="javascript"
ms.eval("Enum=function(x){this.x=new Array();for (i in x) {this.x[i]=i};return this.x}")
set this=ms.eval("this")
for each c in this.Enum(obj)
    msgbox c & "=" & eval("obj." & c)
next

или еже более обВасиковить

set this=ms.eval("this")
set Enums=this.Function("x","y=Array();for (i in x) {y[i]=i};return y")
for each c in Enums(obj)
Я конечно далек от мысли... (с)