379 lines
10 KiB
Plaintext
379 lines
10 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmMetaData
|
|
Caption = "Edit"
|
|
ClientHeight = 4650
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 5940
|
|
LinkTopic = "Form1"
|
|
ScaleHeight = 4650
|
|
ScaleWidth = 5940
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.CommandButton Cancel
|
|
Cancel = -1 'True
|
|
Caption = "Cancel"
|
|
Height = 495
|
|
Left = 4560
|
|
TabIndex = 17
|
|
Top = 4080
|
|
Width = 1095
|
|
End
|
|
Begin VB.CommandButton OK
|
|
Caption = "OK"
|
|
Default = -1 'True
|
|
Height = 495
|
|
Left = 3120
|
|
TabIndex = 16
|
|
Top = 4080
|
|
Width = 1095
|
|
End
|
|
Begin VB.CheckBox CheckRefAttr
|
|
Caption = "By Reference"
|
|
Height = 375
|
|
Left = 2760
|
|
TabIndex = 15
|
|
Top = 1920
|
|
Width = 3255
|
|
End
|
|
Begin VB.CheckBox CheckSecureAttr
|
|
Caption = "Secure"
|
|
Height = 375
|
|
Left = 2760
|
|
TabIndex = 14
|
|
Top = 1440
|
|
Width = 3255
|
|
End
|
|
Begin VB.CheckBox CheckInheritAttr
|
|
Caption = "Inherited"
|
|
Height = 375
|
|
Left = 2760
|
|
TabIndex = 13
|
|
Top = 960
|
|
Width = 3015
|
|
End
|
|
Begin VB.TextBox UserTypeLabel
|
|
Height = 375
|
|
Left = 3600
|
|
TabIndex = 11
|
|
Text = "Text3"
|
|
Top = 360
|
|
Width = 2295
|
|
End
|
|
Begin VB.TextBox StringLabel
|
|
Height = 375
|
|
Left = 720
|
|
TabIndex = 9
|
|
Text = "Text1"
|
|
Top = 2880
|
|
Width = 5055
|
|
End
|
|
Begin VB.TextBox DwordHexLabel
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 720
|
|
TabIndex = 5
|
|
Text = "Text2"
|
|
Top = 3600
|
|
Width = 2295
|
|
End
|
|
Begin VB.TextBox DwordDecLabel
|
|
Height = 375
|
|
Left = 720
|
|
TabIndex = 4
|
|
Text = "Text1"
|
|
Top = 2880
|
|
Width = 2295
|
|
End
|
|
Begin VB.OptionButton RadioBinary
|
|
Caption = "Binary"
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 360
|
|
TabIndex = 3
|
|
Top = 2160
|
|
Width = 1935
|
|
End
|
|
Begin VB.OptionButton RadioMultiSz
|
|
Caption = "Multi-String"
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 360
|
|
TabIndex = 2
|
|
Top = 1680
|
|
Width = 1935
|
|
End
|
|
Begin VB.OptionButton RadioString
|
|
Caption = "String"
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 360
|
|
TabIndex = 1
|
|
Top = 1200
|
|
Width = 1935
|
|
End
|
|
Begin VB.OptionButton RadioDword
|
|
Caption = "DWORD"
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 360
|
|
TabIndex = 0
|
|
Top = 720
|
|
Width = 1935
|
|
End
|
|
Begin VB.Frame Frame1
|
|
Caption = "Data Type"
|
|
Height = 2415
|
|
Left = 120
|
|
TabIndex = 10
|
|
Top = 240
|
|
Width = 2415
|
|
End
|
|
Begin VB.Label LabelUserType
|
|
Caption = "User Type"
|
|
Height = 375
|
|
Left = 2760
|
|
TabIndex = 12
|
|
Top = 360
|
|
Width = 1215
|
|
End
|
|
Begin VB.Label LabelString
|
|
Caption = "String"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 8
|
|
Top = 2880
|
|
Width = 855
|
|
End
|
|
Begin VB.Label LabelHex
|
|
Caption = "Hex"
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 7
|
|
Top = 3600
|
|
Width = 615
|
|
End
|
|
Begin VB.Label LabelDecimal
|
|
Caption = "Decimal"
|
|
Height = 255
|
|
Left = 120
|
|
TabIndex = 6
|
|
Top = 2880
|
|
Width = 615
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMetaData"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Private Path As String ' Path of the item
|
|
Private ID As Long ' Metabase property ID
|
|
|
|
Option Explicit
|
|
|
|
Public Sub SetData(strPath As String, strItem As String)
|
|
Dim mb As IMSMetaBase
|
|
Set mb = CreateObject("IISAdmin.Object")
|
|
Dim key As IMSMetaKey
|
|
Dim NewHandle As Long
|
|
Dim NullPath() As Byte
|
|
Dim bytePath() As Byte
|
|
Dim MetaData As IMSMetaDataItem
|
|
Dim NewDataValue As Long
|
|
|
|
ID = Val(strItem)
|
|
Path = strPath
|
|
|
|
' Open the selected node
|
|
|
|
NullPath = StrConv("" & Chr(0), vbFromUnicode)
|
|
Debug.Print ("Showing " & strPath)
|
|
|
|
Err.Clear
|
|
bytePath = StrConv(strPath & Chr(0), vbFromUnicode)
|
|
Set key = mb.OpenKey(1, 100, bytePath)
|
|
Set MetaData = key.DataItem
|
|
|
|
If (Err.Number <> 0) Then
|
|
Debug.Print ("Open Meta Object Error Code = " & Err.Number)
|
|
Err.Clear
|
|
Exit Sub
|
|
End If
|
|
|
|
' Enumerate the properties on this node
|
|
|
|
MetaData.UserType = 0
|
|
MetaData.DataType = 0
|
|
MetaData.Attributes = 0
|
|
MetaData.Identifier = ID
|
|
|
|
key.GetData MetaData
|
|
'mb.AutoADMGetMetaData NewHandle, NullPath, MetaData
|
|
|
|
If (Err.Number <> 0) Then
|
|
MsgBox "GetMetaData Error Code = " & Err.Number & " (" & Err.Description & ")"
|
|
Err.Clear
|
|
GoTo CloseMb
|
|
End If
|
|
|
|
strItem = MetaData.Identifier
|
|
|
|
' Add the user type
|
|
|
|
If (MetaData.UserType = 1) Then
|
|
UserTypeLabel.Text = "IIS_MD_UT_SERVER"
|
|
ElseIf (MetaData.UserType = 2) Then
|
|
UserTypeLabel.Text = "IIS_MD_UT_FILE"
|
|
Else
|
|
UserTypeLabel.Text = Str(MetaData.UserType)
|
|
End If
|
|
|
|
' Do the appropriate datatype conversion
|
|
|
|
NewDataValue = MetaData.DataType
|
|
If (NewDataValue = 1) Then
|
|
RadioDword.Value = True
|
|
DwordDecLabel.Text = MetaData.Value
|
|
DwordHexLabel.Text = Hex(MetaData.Value)
|
|
|
|
' Hide the string control and move it to the back
|
|
|
|
LabelString.Visible = False
|
|
StringLabel.Visible = False
|
|
LabelString.ZOrder (1)
|
|
|
|
ElseIf (NewDataValue = 2) Then
|
|
Dim j As Long
|
|
Dim tmpStr As String
|
|
|
|
RadioString.Value = True
|
|
|
|
j = 0
|
|
tmpStr = ""
|
|
|
|
Do While (MetaData.Value(j) <> 0)
|
|
tmpStr = tmpStr & Chr(MetaData.Value(j))
|
|
j = j + 1
|
|
Loop
|
|
|
|
StringLabel.Text = tmpStr
|
|
|
|
' Hide the DWORD controls
|
|
|
|
DwordDecLabel.Visible = False
|
|
DwordDecLabel.ZOrder (1)
|
|
LabelDecimal.ZOrder (1)
|
|
DwordHexLabel.Visible = False
|
|
LabelHex.Visible = False
|
|
LabelDecimal.Visible = False
|
|
End If
|
|
|
|
' Set the attributes checkboxes
|
|
|
|
If MetaData.Attributes And 1 Then
|
|
CheckInheritAttr.Value = Checked
|
|
Else
|
|
CheckInheritAttr.Value = Unchecked
|
|
End If
|
|
|
|
If MetaData.Attributes And 4 Then
|
|
CheckSecureAttr.Value = Checked
|
|
Else
|
|
CheckSecureAttr.Value = Unchecked
|
|
End If
|
|
|
|
If MetaData.Attributes And 8 Then
|
|
CheckRefAttr.Value = Checked
|
|
Else
|
|
CheckRefAttr.Value = Unchecked
|
|
End If
|
|
|
|
CloseMb:
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Cancel_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub OK_Click()
|
|
Dim mb As MSAdmin
|
|
Set mb = CreateObject("IISAdmin.Object")
|
|
Dim key As IMSMetaKey
|
|
Dim NewHandle As Long
|
|
Dim NullPath() As Byte
|
|
Dim bytePath() As Byte
|
|
Dim MetaData As IMSMetaDataItem
|
|
Dim NewDataValue As Long
|
|
|
|
' Open the selected node
|
|
|
|
NullPath = StrConv("" & Chr(0), vbFromUnicode)
|
|
|
|
Err.Clear
|
|
bytePath = StrConv(Path & Chr(0), vbFromUnicode)
|
|
Set key = mb.OpenKey(2, , bytePath)
|
|
If (Err.Number <> 0) Then
|
|
Debug.Print ("Open Meta Object Error Code = " & Err.Number)
|
|
Err.Clear
|
|
Exit Sub
|
|
End If
|
|
|
|
Set MetaData = key.DataItem
|
|
MetaData.Identifier = ID
|
|
|
|
' Add the user type
|
|
|
|
If (UserTypeLabel.Text = "IIS_MD_UT_SERVER") Then
|
|
MetaData.UserType = 1
|
|
ElseIf UserTypeLabel.Text = "IIS_MD_UT_FILE" Then
|
|
MetaData.UserType = 2
|
|
Else
|
|
MetaData.UserType = Val(UserTypeLabel.Text)
|
|
End If
|
|
|
|
' Do the appropriate datatype conversion
|
|
Dim Value As Long
|
|
If (RadioDword.Value = True) Then
|
|
MetaData.DataType = 1
|
|
Value = Val(DwordDecLabel.Text)
|
|
MetaData.Value = Value 'Val(DwordDecLabel.Text)
|
|
ElseIf (RadioString.Value = True) Then
|
|
bytePath = StrConv(StringLabel.Text & Chr(0), vbFromUnicode)
|
|
MetaData.DataType = 2
|
|
MetaData.Value = bytePath
|
|
Else
|
|
MsgBox ("Type is not supported")
|
|
End If
|
|
|
|
' Set the attributes checkboxes
|
|
|
|
MetaData.Attributes = 0
|
|
|
|
If (CheckInheritAttr.Value = Checked) Then
|
|
MetaData.Attributes = MetaData.Attributes + 1
|
|
End If
|
|
|
|
If (CheckSecureAttr.Value = Checked) Then
|
|
MetaData.Attributes = MetaData.Attributes + 4
|
|
End If
|
|
|
|
If (CheckRefAttr.Value = Checked) Then
|
|
MetaData.Attributes = MetaData.Attributes + 8
|
|
End If
|
|
|
|
key.SetData MetaData
|
|
If (Err.Number <> 0) Then
|
|
MsgBox "GetMetaData Error Code = " & Err.Number & " (" & Err.Description & ")"
|
|
Err.Clear
|
|
GoTo CloseMb
|
|
End If
|
|
|
|
|
|
CloseMb:
|
|
Unload Me
|
|
|
|
' Refresh the listbox and dismiss the dialog
|
|
End Sub
|