VERSION 4.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   12300
   ClientLeft      =   1695
   ClientTop       =   1515
   ClientWidth     =   6690
   Height          =   12705
   Left            =   1635
   LinkTopic       =   "Form1"
   ScaleHeight     =   12300
   ScaleWidth      =   6690
   Top             =   1170
   Width           =   6810
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   480
      TabIndex        =   0
      Top             =   840
      Width           =   3135
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub Command1_Click()
    Dim adm As IMSMetaBase
    
    Set adm = CreateObject("ADMCOM.Object")
    Rem Set adm = GetObject("", "ADMCOM.Object")
Rem Dim NewHandle As Long
Dim dwdReturn As Long

    Dim byteConvert(4) As Byte
    Dim dwConvert As Long
    byteConvert(0) = 0
    byteConvert(1) = 1
    byteConvert(2) = 2
    byteConvert(3) = 3
    Rem adm = Null
    
    On Error Resume Next
    
    Rem Debug.Print ("Return Value = " & Err.Number)

    
Rem        adm.AutoADMTerminate (True)
             Rem Debug.Print ("Return Value = " & dwReturn)
     
Rem        adm.AutoADMTerminate (True)
        
             Rem Debug.Print ("Return Value = " & Err.Number)
             Rem Debug.Print ("Return Value = " & dwReturn)
             
Rem        adm.AutoADMTerminate (True)
Rem    If (Err.Number >= 0) Then GoTo 12
Rem         Debug.Print ("Error Code = " & Err.Number)
Rem         Err.Clear
12:


Rem    adm.AutoADMInitialize
Rem    If (Err.Number >= 0) Then GoTo 14
Rem         Debug.Print ("Error Code = " & Err.Number)
Rem         Err.Clear
14:
    Dim OpenKey1 As IMSMetaKey
    Dim DataObj As IMSMetaDataItem
Rem    Dim DataObj As Object
    
    Debug.Print ("Calling OpenKey, should succeed")

    Set OpenKey1 = adm.OpenKey(3, 30000)
    
Rem    adm.OpenKey 0, 3, 30000, NewHandle, ab
    If (Err.Number >= 0) Then GoTo 17
         Debug.Print ("Open Error Code = " & Err.Number)
         Err.Clear
         GoTo Terminate
17:
    
Rem    Debug.Print ("returned handle = " & NewHandle)
        
    Set DataObj = OpenKey1.DataItem
    
     Rem DataObj = adm.AutoADMMetaDataObject
    
Rem    adm.AutoADMMetaDataObject ppiadmadData:=DataObj
    
    If (Err.Number >= 0) Then GoTo 20
         Debug.Print ("DataItem Error Code = " & Err.Number)
         Err.Clear
         GoTo Terminate
20:
    
    Rem adm.AutoADMGetMetaDataObject (DataObj)
    
    
    Dim dw As Long
    dw = 10
    Dim ZeroArray(1) As Byte
    ZeroArray(0) = 0
    
    Dim ab() As Byte
    Dim abz() As Byte
    Dim pszPath(256) As Byte
    
    Dim s As String
    s = "ABC"
    s = s & Chr(0)
    
    ab = StrConv("" & Chr(0), vbFromUnicode)
    
Rem    adm.AutoADMOpenMetaObject hMDHandle:=0, pvaMDPath:=ab, dwMDAccessRequested:=3, dwMDTimeOut:=100, phMDNewHandle:=NewHandle
    Dim Permissions As Long
    Dim SystemChangeNumber As Long
    
    Dim NewDate As Date
    OpenKey1.GetLastChangeTime pdLastChangeTime:=NewDate, vaLocalTime:=False
        
        If (Err.Number = 0) Then GoTo 22
         Debug.Print ("GetLastChangeTime Error Code = " & Err.Number)
         Err.Clear
         GoTo 23
22:
    Debug.Print ("Returned Date, Greenwich = " & NewDate)
23:
    OpenKey1.GetLastChangeTime pdLastChangeTime:=NewDate, vaLocalTime:=True
       
        If (Err.Number = 0) Then GoTo 24
         Debug.Print ("GetLastChangeTime Error Code = " & Err.Number)
         Err.Clear
         GoTo 25
24:
    Debug.Print ("Returned Date, local = " & NewDate)
25:
    OpenKey1.GetLastChangeTime pdLastChangeTime:=NewDate
    
        If (Err.Number = 0) Then GoTo 26
         Debug.Print ("GetLastChangeTime Error Code = " & Err.Number)
         Err.Clear
         GoTo 27
26:
    Debug.Print ("Returned Date, default = " & NewDate)
27:

    NewDate = Date
    Debug.Print ("System Date = " & NewDate)
    OpenKey1.SetLastChangeTime dLastChangeTime:=NewDate, vaLocalTime:=True
    
        If (Err.Number = 0) Then GoTo 33
         Debug.Print ("SetLastChangeTime Error Code = " & Err.Number)
         Err.Clear
         GoTo 34
33:
    Debug.Print ("New Date = " & NewDate)
34:
    OpenKey1.GetLastChangeTime pdLastChangeTime:=NewDate
        If (Err.Number = 0) Then GoTo 35
         Debug.Print ("GetLastChangeTime Error Code = " & Err.Number)
         Err.Clear
         GoTo 36
35:
    Debug.Print ("New Date = " & NewDate)
36:
   
    OpenKey1.GetKeyInfo dwPermissions:=Permissions, dwSystemChangeNumber:=SystemChangeNumber
    Debug.Print ("returned system change number for handle = " & SystemChangeNumber)
    Debug.Print ("returned permissions for handle = " & Permissions)
    
Rem    dwReturn = DataObj.AutoADMDataValue(pbMDData:=)
    DataObj.DataType = 1
    DataObj.Value = 27
    Dim TestGetDWORD As Long
    TestGetDWORD = 1
    Debug.Print ("Previous TestGetDWORD = " & TestGetDWORD)
    
    TestGetDWORD = DataObj.Value
    Debug.Print ("Returned Dword Data = " & TestGetDWORD)
    Debug.Print ("Returned Data Type = " & VarType(TestGetDWORD))
    
    TestGetVarDWORD = DataObj.Value
    Debug.Print ("Returned Variant Dword Data = " & TestGetVarDWORD)
    Debug.Print ("Returned Variant Data Type = " & VarType(TestGetVarDWORD))

    DataObj.Identifier = 58
    DataObj.DataType = 2
    
    Dim StringData() As Byte
    
    StringData = StrConv("TestString2" & Chr(0), vbFromUnicode)
    s = StrConv(StringData, vbUnicode)
    Debug.Print ("Original String Data = " & s)
    
    DataObj.Value = StringData
    
    Rem Dim TestGetString() As Byte
    TestGetString = StrConv("Garbage" & Chr(0), vbFromUnicode)
    Debug.Print ("Previous TestGetString = " & StrConv(TestGetString, vbUnicode))
    
    TestGetString = DataObj.Value
    Debug.Print ("Returned String Data = " & StrConv(TestGetString, vbUnicode))
    Debug.Print ("Returned Data Type = " & VarType(TestGetString))
        
    TestGetVarString = DataObj.Value
    Debug.Print ("Returned variant string = " & StrConv(TestGetVarString, vbUnicode))
    Debug.Print ("Returned Data Type = " & VarType(TestGetVarString))
    
    TestGetAttributes = DataObj.Attributes
    Debug.Print ("Original Attributes = " & TestGetAttributes)
    
    DataObj.InheritAttribute = True
    Debug.Print ("Setting Inherit Attribute")
    Debug.Print ("Attributes = " & DataObj.InheritAttribute)
    
    DataObj.InheritAttribute = False
    Debug.Print ("Clearing Inherit Attribute")
    Debug.Print ("Attributes = " & DataObj.InheritAttribute)
    
    Debug.Print ("Setting All Attributes")
    DataObj.InheritAttribute = True
    DataObj.PartialPathAttribute = True
    DataObj.SecureAttribute = True
    DataObj.ReferenceAttribute = True
    Debug.Print ("Attributes = " & DataObj.Attributes)
    
    Debug.Print ("Clearing All Attributes")
    DataObj.InheritAttribute = False
    DataObj.PartialPathAttribute = False
    DataObj.SecureAttribute = False
    DataObj.ReferenceAttribute = False
    Debug.Print ("Attributes = " & DataObj.Attributes)
    
    
    
    
    
    
    Rem Debug.Print ("String Data Returned = " & TestGetData)
    
    OpenKey1.SetData pmdiData:=DataObj
    If (Err.Number >= 0) Then GoTo 40
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo CloseHandle
40:
    
    DataObj.AutoADMDataIdentifier = 59
        
    
    OpenKey1.SetData pmdiData:=DataObj
    Rem adm.AutoADMDeleteMetaData hMDHandle:=NewHandle, pvaMDPath:=ab, dwMDIdentifier:=59, dwMDDataType:=0
    Rem adm.AutoADMDeleteMetaData hMDHandle:=NewHandle, pvaMDPath:=ab, dwMDIdentifier:=58, dwMDDataType:=0

    Dim NewIdentifier As Long
    Dim NewAttributes As Long
    Dim NewDataType As Long
    Dim NewUserType As Long
    
   
    Dim NumDataObjects As Long
    Dim DataSetNumber As Long
    Rem Dim DataObjectArray() As IADMAUTODATA
    Debug.Print ("DataObjectArray Array Type = " & VarType(DataObjectArray))
        
        
        
    OpenKey1.GetAllData dwAttributes:=0, dwUserType:=0, dwDataType:=0, pdwDataSetNumber:=DataSetNumber, pvaDataObjectsArray:=DataObjectArray
      If (Err.Number <> 0) Then GoTo 41
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo CloseHandle
41:
    Debug.Print ("Returned Getall Buffer Type = " & VarType(DataObjectArray))
    Debug.Print ("UBound(DataObjectArray) = " & UBound(DataObjectArray))
 
   Dim GetAllDataObject As IMSMetaDataItem
   
Rem   For Each GetAllDataObjectTemp In DataObjectArray
Rem   Set GetAllDataObject = GetAllDataObjectTemp

Dim i As Long


    For i = LBound(DataObjectArray) To UBound(DataObjectArray)
    Debug.Print ("i = " & i)
    
    Set GetAllDataObject = DataObjectArray(i)
       
    NewIdentifier = GetAllDataObject.Identifier
             Debug.Print ("Getall Returned Identifier = " & NewIdentifier)
    NewAttributes = GetAllDataObject.Attributes
             Debug.Print ("Getall Returned Attributes = " & NewAttributes)
    NewDataType = GetAllDataObject.DataType
             Debug.Print ("Getall Returned DataType = " & NewDataType)
    NewUserType = GetAllDataObject.UserType
             Debug.Print ("Getall Returned UserType = " & NewUserType)
    
    NewDataValue = GetAllDataObject.Value
    
    Debug.Print ("Returned Getall Data Type = " & VarType(NewDataValue))

    If (NewDataType = 1) Then GoTo 45
    Debug.Print ("Returned Getall variant string = " & StrConv(NewDataValue, vbUnicode))
    GoTo 46
45:
    Debug.Print ("Returned Getall variant DWORD = " & NewDataValue)

46:
      
   
Rem   Next GetAllDataObjectTemp
   Next i
   
   
 Dim ReadDataObj As IMSMetaDataItem
Rem    Dim ReadDataObj As Object
    
    
    Rem DataObj = adm.AutoADMGetMetaDataObject
    
    Set ReadDataObj = OpenKey1.DataItem
    
    Rem adm.AutoADMGetMetaDataObject ppiadmadData:=ReadDataObj
    If (Err.Number >= 0) Then GoTo 50
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo CloseHandle
50:
    ReadDataObj.Identifier = 58

    OpenKey1.GetData ppmdiData:=ReadDataObj
      If (Err.Number >= 0) Then GoTo 60
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo CloseHandle
60:
    
    
    NewIdentifier = ReadDataObj.Identifier
             Debug.Print ("Returned Identifier = " & NewIdentifier)
    NewAttributes = ReadDataObj.Attributes
             Debug.Print ("Returned Attributes = " & NewAttributes)
    NewDataType = ReadDataObj.DataType
             Debug.Print ("Returned DataType = " & NewDataType)
    NewUserType = ReadDataObj.UserType
             Debug.Print ("Returned UserType = " & NewUserType)
    
Rem    NewDataValue = ReadDataObj.AutoADMDataData
    NewDataValue = ReadDataObj.Value
    Debug.Print ("Returned variant string = " & StrConv(NewDataValue, vbUnicode))
    Debug.Print ("Returned Data Type = " & VarType(NewDataValue))
    
 Dim EnumDataObj As IMSMetaDataItem
Rem Dim EnumDataObj As Object
 
    
    Rem DataObj = adm.AutoADMGetMetaDataObject
    
    Set EnumDataObj = OpenKey1.DataItem
    
    Rem adm.AutoADMGetMetaDataObject ppiadmadData:=EnumDataObj
    If (Err.Number >= 0) Then GoTo 62
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo CloseHandle
62:
    ReadDataObj.Identifier = 58

    OpenKey1.EnumData ppmdiData:=EnumDataObj, dwEnumDataIndex:=0
      If (Err.Number >= 0) Then GoTo 64
         Debug.Print ("Error Code = " & Err.Number)
         Err.Clear
         GoTo 66
64:
    
    NewIdentifier = EnumDataObj.Identifier
             Debug.Print ("Returned Enum Identifier = " & NewIdentifier)
    NewAttributes = EnumDataObj.Attributes
             Debug.Print ("Returned Enum Attributes = " & NewAttributes)
    NewDataType = EnumDataObj.DataType
             Debug.Print ("Returned Enum DataType = " & NewDataType)
    NewUserType = EnumDataObj.UserType
             Debug.Print ("Returned Enum UserType = " & NewUserType)
    
Rem    NewDataValue = ReadDataObj.AutoADMDataData
    NewDataValue = EnumDataObj.Value
    If (NewDataType = 1) Then GoTo 65
    Debug.Print ("Returned Enum variant string = " & StrConv(NewDataValue, vbUnicode))
    GoTo 66
65:
    Debug.Print ("Returned Enum variant DWORD = " & NewDataValue)

    Debug.Print ("Returned Enum Data Type = " & VarType(NewDataValue))
66:
        
    Dim NullPath() As Byte
    NullPath = StrConv("" & Chr(0), vbFromUnicode)
    OpenKey1.EnumKeys pvaName:=EnumObjectName, dwEnumObjectIndex:=0
      If (Err.Number >= 0) Then GoTo 67
         Debug.Print ("Enum Object Error Code = " & Err.Number)
         Err.Clear
         GoTo 68
67:
    Debug.Print ("Enumerated Object = " & StrConv(EnumObjectName, vbUnicode))
    Debug.Print ("Returned Enum Buffer Type = " & VarType(EnumObjectName))
    Debug.Print ("UBound(EnumObjectName) = " & UBound(EnumObjectName))

68:
        
    Rem adm.TestLong (5)
    Rem adm.TestHandle hTest:=3
    Rem adm.TestHandlePtr (dw)
    Rem adm.TestHandlePtr phTest:=dw
    
    Rem adm.TestLong dwTest:=6
    Rem adm.TestBstr (s)
           
    Rem adm.TestSafeArray saTest:=ab
           
    Rem adm.TestLongPtr (dw)
    Rem adm.TestCombo dwTest:=7, bstrTest:=s, pdwTest:=dw
    
    Rem This works
    Rem adm.ComADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s
    Rem adm.ComADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s, dwMDAccessRequested:=1, dwMDTimeOut:=100
    Rem adm.ComADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s, dwMDAccessRequested:=1
      
    Rem Set rv = adm.ComADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s, dwMDAccessRequested:=1, dwMDTimeOut:=100, phMDNewHandle:=dw
    
    Dim rv As Long
    
    Rem adm.AutoADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s, dwMDAccessRequested:=3, dwMDTimeOut:=100, phMDNewHandle:=dw
    
    Rem Debug.Print ("returned handle = " & dw)
    Rem Debug.Print ("returned value = " & rv)
    Dim BogusHandle As Long
    Dim OpenKey2 As IMSMetaKey
    OpenKey2 = OpenKey1.OpenKey(dwAccessRequested:=1)
    
    
         If (Err.Number = 0) Then GoTo 70
         Debug.Print ("OpenKey Error Code (ERROR_PATH_BUSY_EXPECTED) = " & Err.Number)
         Err.Clear
         GoTo 75
70:
    Debug.Print ("returned handle = " & BogusHandle)
75:
    
    Rem Debug.Print ("returned value = " & rv)

    Rem Dim pbData(100) As Byte


    Rem adm.AutoADMGetMetaData hMDHandle:=0, pvaMDPath:="Test Path", ppiadmadData:=DataObj
      
      
      
      
    Rem s = StrConv(pbData, vbUnicode)
    Rem Debug.Print ("Returned Data = " & s)
    

    Rem adm.ComADMOpenMetaObject hMDHandle:=0, pvaMDPath:=s, dwMDAccessRequested:=1, dwMDTimeOut:=20000, phMDNewHandle:=dw

CloseHandle:
Rem    Debug.Print ("Closing OpenKey1")
   
Rem   OpenKey1.Close
Rem   Debug.Print ("Close returns " & Err.Number)

   

Terminate:
    Debug.Print ("Finished")
        
   Rem Set excel = CreateObject("Excel.Application")
   Rem Dim xlapp As Object
   Rem GetOpenFilename(FileFilter:=, FilterIndex:=, Title:=, ButtonText:=, MultiSelect:=)
   Rem ComADMSetMetaData hMDHandle:=, pvaMDPath:=, dwMDIdentifier:=, dwMDAttributes:=, dwMDUserType:=, dwMDDataType:=, dwMDDataLen:=, pbMDData:=
   
   Rem Set xlapp = CreateObject("Excel.Application")
   Rem Set xlsheet = xlapp.Workbooks.Open("c:\jaro\sample.xls")
   Rem Set xx = xlsheet.WorkSheets(1).Range("A1")
   Rem response.write "A1 value is" + xx
   Rem xlsheet.Close
   Rem xlapp.Quit
End Sub