windows-nt/Source/XPSP1/NT/inetsrv/iis/utils/metautil/metaedit/simpedit.frm

551 lines
15 KiB
Plaintext
Raw Permalink Normal View History

2020-09-26 03:20:57 -05:00
VERSION 5.00
Begin VB.Form SimpleEditForm
BorderStyle = 3 'Fixed Dialog
Caption = "Edit Metabase Data"
ClientHeight = 3585
ClientLeft = 45
ClientTop = 330
ClientWidth = 5310
Icon = "SimpEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3585
ScaleWidth = 5310
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox NameCombo
Height = 315
Left = 1320
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 17
Top = 240
Width = 2535
End
Begin VB.TextBox IdText
Height = 285
Left = 3960
TabIndex = 16
Top = 240
Width = 1215
End
Begin VB.CommandButton OkButton
Caption = "OK"
Default = -1 'True
Height = 345
Left = 2520
TabIndex = 15
Top = 3120
Width = 1260
End
Begin VB.CommandButton CancelButton
Caption = "Cancel"
Height = 345
Left = 3960
TabIndex = 14
Top = 3120
Width = 1260
End
Begin VB.CheckBox InsertPathCheck
Caption = "Insert Path"
Height = 255
Left = 2640
TabIndex = 13
Top = 1200
Width = 1215
End
Begin VB.CheckBox VolatileCheck
Caption = "Volatile"
Height = 255
Left = 1320
TabIndex = 12
Top = 1200
Width = 1215
End
Begin VB.CheckBox ReferenceCheck
Caption = "Reference"
Height = 255
Left = 3960
TabIndex = 11
Top = 720
Width = 1215
End
Begin VB.CheckBox SecureCheck
Caption = "Secure"
Height = 255
Left = 2640
TabIndex = 10
Top = 720
Width = 1215
End
Begin VB.CheckBox InheritCheck
Caption = "Inherit"
Height = 255
Left = 1320
TabIndex = 9
Top = 720
Width = 1215
End
Begin VB.ComboBox DataTypeCombo
Height = 315
Left = 1320
Style = 2 'Dropdown List
TabIndex = 8
Top = 2160
Width = 2535
End
Begin VB.TextBox UserTypeText
Enabled = 0 'False
Height = 285
Left = 3960
TabIndex = 7
Top = 1680
Width = 1215
End
Begin VB.ComboBox UserTypeCombo
Height = 315
Left = 1320
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 6
Top = 1680
Width = 2535
End
Begin VB.TextBox DataText
Height = 285
Left = 1320
TabIndex = 0
Top = 2640
Width = 3855
End
Begin VB.Label Label5
Caption = "Data:"
Height = 255
Left = 120
TabIndex = 5
Top = 2640
Width = 975
End
Begin VB.Label Label4
Caption = "Data Type:"
Height = 255
Left = 120
TabIndex = 4
Top = 2160
Width = 975
End
Begin VB.Label Label3
Caption = "User Type:"
Height = 255
Left = 120
TabIndex = 3
Top = 1680
Width = 975
End
Begin VB.Label Label2
Caption = "Atributes:"
Height = 255
Left = 120
TabIndex = 2
Top = 720
Width = 975
End
Begin VB.Label Label1
Caption = "Id:"
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 975
End
End
Attribute VB_Name = "SimpleEditForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z
'Form parameters
Public Machine As String
Public Key As String
Public Id As Long '0 = New
Public NewDataType As String 'New only
'Metabase Constants
Const METADATA_NO_ATTRIBUTES = &H0
Const METADATA_INHERIT = &H1
Const METADATA_PARTIAL_PATH = &H2
Const METADATA_SECURE = &H4
Const METADATA_REFERENCE = &H8
Const METADATA_VOLATILE = &H10
Const METADATA_ISINHERITED = &H20
Const METADATA_INSERT_PATH = &H40
Const IIS_MD_UT_SERVER = 1
Const IIS_MD_UT_FILE = 2
Const IIS_MD_UT_WAM = 100
Const ASP_MD_UT_APP = 101
Const ALL_METADATA = 0
Const DWORD_METADATA = 1
Const STRING_METADATA = 2
Const BINARY_METADATA = 3
Const EXPANDSZ_METADATA = 4
Const MULTISZ_METADATA = 5
Private Sub Form_Load()
'Init UserTypeCombo
UserTypeCombo.Clear
UserTypeCombo.AddItem "Server"
UserTypeCombo.AddItem "File"
UserTypeCombo.AddItem "WAM"
UserTypeCombo.AddItem "ASP App"
UserTypeCombo.AddItem "Other"
UserTypeCombo.Text = "Server"
'Init DataTypeCombo
DataTypeCombo.Clear
DataTypeCombo.AddItem "DWord"
DataTypeCombo.AddItem "String"
DataTypeCombo.AddItem "Binary"
DataTypeCombo.AddItem "Expand String"
DataTypeCombo.Text = "DWord"
End Sub
Private Sub LoadPropertyNames()
On Error GoTo LError
Dim NameProperty As Variant
For Each NameProperty In MainForm.MetaUtilObj.EnumProperties(Machine + "\Schema\Properties\Names")
NameCombo.AddItem NameProperty.Data
Next
LError:
End Sub
Public Sub Init()
Dim Property As Object
Dim Attributes As Long
Dim UserType As Long
Dim DataType As Long
If Id = 0 Then
'New data
'Load the Names
NameCombo.Clear
LoadPropertyNames
NameCombo.AddItem "Other"
NameCombo.Text = "Other"
NameCombo.Enabled = True
'Set Id to 0
IdText.Enabled = True
IdText.Text = "0"
'Clear all flags
InheritCheck.Value = vbUnchecked
SecureCheck.Value = vbUnchecked
ReferenceCheck.Value = vbUnchecked
VolatileCheck.Value = vbUnchecked
InsertPathCheck.Value = vbUnchecked
'Set UserType to Server
UserTypeCombo.Text = "Server"
'Set DataType
If NewDataType = DWORD_METADATA Then
DataTypeCombo.Text = "DWord"
ElseIf NewDataType = STRING_METADATA Then
DataTypeCombo.Text = "String"
ElseIf NewDataType = BINARY_METADATA Then
DataTypeCombo.Text = "Binary"
ElseIf NewDataType = EXPANDSZ_METADATA Then
DataTypeCombo.Text = "Expand String"
End If
'Set Data to empty
DataText.Text = ""
Else
'Edit existing
Set Property = MainForm.MetaUtilObj.GetProperty(Key, Id)
'Set the Name
NameCombo.Clear
If Property.Name <> "" Then
NameCombo.AddItem Property.Name
NameCombo.Text = Property.Name
Else
NameCombo.AddItem "Other"
NameCombo.Text = "Other"
End If
NameCombo.Enabled = False
'Set Id
IdText.Enabled = False
IdText.Text = Str(Property.Id)
'Set attributes
Attributes = Property.Attributes
If (Attributes And METADATA_INHERIT) = METADATA_INHERIT Then
InheritCheck.Value = vbChecked
Else
InheritCheck.Value = vbUnchecked
End If
If (Attributes And METADATA_SECURE) = METADATA_SECURE Then
SecureCheck.Value = vbChecked
Else
SecureCheck.Value = vbUnchecked
End If
If (Attributes And METADATA_REFERENCE) = METADATA_REFERENCE Then
ReferenceCheck.Value = vbChecked
Else
ReferenceCheck.Value = vbUnchecked
End If
If (Attributes And METADATA_VOLATILE) = METADATA_VOLATILE Then
VolatileCheck.Value = vbChecked
Else
VolatileCheck.Value = vbUnchecked
End If
If (Attributes And METADATA_INSERT_PATH) = METADATA_INSERT_PATH Then
InsertPathCheck.Value = vbChecked
Else
InsertPathCheck.Value = vbUnchecked
End If
'Set UserType
UserType = Property.UserType
If UserType = IIS_MD_UT_SERVER Then
UserTypeCombo.Text = "Server"
ElseIf UserType = IIS_MD_UT_FILE Then
UserTypeCombo.Text = "File"
ElseIf UserType = IIS_MD_UT_WAM Then
UserTypeCombo.Text = "WAM"
ElseIf UserType = ASP_MD_UT_APP Then
UserTypeCombo.Text = "ASP App"
Else
UserTypeCombo.Text = "Other"
UserTypeText.Text = Str(UserType)
End If
'Set DataType
DataType = Property.DataType
If DataType = DWORD_METADATA Then
DataTypeCombo.Text = "DWord"
ElseIf DataType = STRING_METADATA Then
DataTypeCombo.Text = "String"
ElseIf DataType = BINARY_METADATA Then
DataTypeCombo.Text = "Binary"
ElseIf DataType = EXPANDSZ_METADATA Then
DataTypeCombo.Text = "Expand String"
End If
'Set Data
If DataType = BINARY_METADATA Then
LoadBinaryData Property
Else
DataText.Text = CStr(Property.Data)
End If
End If
End Sub
Private Sub LoadBinaryData(Property As Object)
Dim DataStr As String
Dim DataBStr As String
Dim i As Long
Dim DataByte As Integer
'Display as a list of bytes
DataStr = ""
DataBStr = Property.Data
For i = 1 To LenB(DataBStr)
DataByte = AscB(MidB(DataBStr, i, 1))
If DataByte < 16 Then
DataStr = DataStr & "0" & Hex(AscB(MidB(DataBStr, i, 1))) & " "
Else
DataStr = DataStr & Hex(AscB(MidB(DataBStr, i, 1))) & " "
End If
Next
DataText.Text = DataStr
End Sub
Private Function HexVal(ByVal HexStr As String) As Integer
Dim Ret As Integer
Ret = 0
Do While HexStr <> ""
Ret = Ret * 16
If Right(HexStr, 1) = "1" Then
Ret = Ret + 1
ElseIf Right(HexStr, 1) = "2" Then
Ret = Ret + 2
ElseIf Right(HexStr, 1) = "3" Then
Ret = Ret + 3
ElseIf Right(HexStr, 1) = "4" Then
Ret = Ret + 4
ElseIf Right(HexStr, 1) = "5" Then
Ret = Ret + 5
ElseIf Right(HexStr, 1) = "6" Then
Ret = Ret + 6
ElseIf Right(HexStr, 1) = "7" Then
Ret = Ret + 7
ElseIf Right(HexStr, 1) = "8" Then
Ret = Ret + 8
ElseIf Right(HexStr, 1) = "9" Then
Ret = Ret + 9
ElseIf Right(HexStr, 1) = "A" Then
Ret = Ret + 10
ElseIf Right(HexStr, 1) = "B" Then
Ret = Ret + 11
ElseIf Right(HexStr, 1) = "C" Then
Ret = Ret + 12
ElseIf Right(HexStr, 1) = "D" Then
Ret = Ret + 13
ElseIf Right(HexStr, 1) = "E" Then
Ret = Ret + 14
ElseIf Right(HexStr, 1) = "F" Then
Ret = Ret + 15
End If
HexStr = Right(HexStr, Len(HexStr) - 1)
Loop
HexVal = Ret
End Function
Private Sub SaveBinaryData(Property As Object)
Dim WorkStr As String
Dim OutBStr As String
Dim i As Long
Dim CurByte As String
WorkStr = DataText.Text
OutBStr = ""
Do While WorkStr <> ""
'Skip leading spaces
Do While Left(WorkStr, 1) = " "
WorkStr = Right(WorkStr, Len(WorkStr) - 1)
Loop
'Get a byte
i = 0
CurByte = Left(WorkStr, 1)
Do While (CurByte <> "") And (CurByte <> " ")
i = i + 1
CurByte = Mid(WorkStr, i + 1, 1)
Loop
If i > 0 Then
OutBStr = OutBStr + ChrB(HexVal(Left(WorkStr, i)))
End If
WorkStr = Right(WorkStr, Len(WorkStr) - i)
Loop
Property.Data = OutBStr
End Sub
Private Sub NameCombo_Click()
If NameCombo.Text <> "Other" Then
IdText.Enabled = False
IdText.Text = Str(MainForm.MetaUtilObj.PropNameToId(Key, NameCombo.Text))
Else
IdText.Enabled = True
End If
End Sub
Private Sub UserTypeCombo_Click()
If UserTypeCombo.Text = "Other" Then
UserTypeText.Enabled = True
UserTypeText.Text = ""
UserTypeText.SetFocus
Else
UserTypeText.Enabled = False
If UserTypeCombo.Text = "Server" Then
UserTypeText.Text = Str(IIS_MD_UT_SERVER)
ElseIf UserTypeCombo.Text = "File" Then
UserTypeText.Text = Str(IIS_MD_UT_FILE)
ElseIf UserTypeCombo.Text = "WAM" Then
UserTypeText.Text = Str(IIS_MD_UT_WAM)
ElseIf UserTypeCombo.Text = "ASP App" Then
UserTypeText.Text = Str(ASP_MD_UT_APP)
Else
UserTypeText = "0"
End If
End If
End Sub
Private Sub OkButton_Click()
'On Error GoTo LError:
Dim Property As Object
Dim Attributes As Long
'Check fields
If CLng(IdText.Text) = 0 Then
MsgBox "Id must be nonzero", _
vbExclamation + vbOKOnly, "Edit Metabase Data"
Exit Sub
End If
'Write data
If Id = 0 Then
Set Property = MainForm.MetaUtilObj.CreateProperty(Key, CLng(IdText.Text))
Else
Set Property = MainForm.MetaUtilObj.GetProperty(Key, CLng(IdText.Text))
End If
Attributes = METADATA_NO_ATTRIBUTES
If InheritCheck.Value = vbChecked Then
Attributes = Attributes + METADATA_INHERIT
ElseIf SecureCheck.Value = vbChecked Then
Attributes = Attributes + METADATA_SECURE
ElseIf ReferenceCheck.Value = vbChecked Then
Attributes = Attributes + METADATA_REFERENCE
ElseIf VolatileCheck.Value = vbChecked Then
Attributes = Attributes + METADATA_VOLATILE
ElseIf InsertPathCheck.Value = vbChecked Then
Attributes = Attributes + METADATA_INSERT_PATH
End If
Property.Attributes = Attributes
Property.UserType = CLng(UserTypeText.Text)
If DataTypeCombo.Text = "DWord" Then
Property.DataType = DWORD_METADATA
Property.Data = CLng(DataText.Text)
ElseIf DataTypeCombo.Text = "String" Then
Property.DataType = STRING_METADATA
Property.Data = DataText.Text
ElseIf DataTypeCombo.Text = "Binary" Then
Property.DataType = BINARY_METADATA
SaveBinaryData Property
ElseIf DataTypeCombo.Text = "Expand String" Then
Property.DataType = EXPANDSZ_METADATA
Property.Data = DataText.Text
End If
Property.Write
'Clean up
Me.Hide
Exit Sub
LError:
MsgBox "Failure to write property: " & Err.Description, _
vbExclamation + vbOKOnly, "Edit Metabase Data"
End Sub
Private Sub CancelButton_Click()
Me.Hide
End Sub